1 -- | This is a collection of HTML benchmarks for BlazeMarkup.
3 {-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}
4 {-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
5 module Benchmarks.HtmlBenchmarks where
7 import Data.Monoid (Monoid, mempty, mconcat, mappend)
8 import Prelude hiding (div, id)
9 import qualified Prelude as P
11 import Benchmarks.BenchmarkUtils
13 import qualified Benchmarks.BenchmarkUtils as H
15 -- | Description of an HTML benchmark
17 data HtmlBenchmark = forall a. HtmlBenchmark
18 { hName :: String -- ^ Name.
19 , hR :: (a -> Html) -- ^ Rendering function.
21 , hH :: Html } -- ^ Longer description.
23 -- | List containing all benchmarks.
25 benchmarks :: [HtmlBenchmark]
27 [ HtmlBenchmark "bigTable" bigTable bigTableData $
28 let h = toHtml $ length bigTableData
29 w = toHtml $ length $ P.head bigTableData
30 in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table"
31 , HtmlBenchmark "basic" basic basicData
32 "A simple, small basic template with a few holes to fill in"
33 , HtmlBenchmark "wideTree" wideTree wideTreeData $
34 "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)"
35 , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do
36 "A very wide tree (" >> toHtml (length wideTreeData) >> " elements)"
37 " with lots of escaping"
38 , HtmlBenchmark "deepTree" deepTree deepTreeData $ do
39 "A really deep tree (" >> toHtml deepTreeData >> " nested templates)"
40 , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do
41 "A single element with " >> toHtml (length manyAttributesData)
43 , HtmlBenchmark "customAttribute" customAttributes customAttributesData $
44 "Creating custom attributes"
50 bigTableData :: [[Int]]
51 bigTableData = replicate rows [1..10]
52 {-# NOINLINE bigTableData #-}
54 basicData :: (String, String, [String])
55 basicData = ("Just a test", "joe", items)
56 {-# NOINLINE basicData #-}
59 items = map (("Number " `mappend`) . show) [1 :: Int .. 14]
60 {-# NOINLINE items #-}
62 wideTreeData :: [String]
63 wideTreeData = take 5000 $
64 cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]
65 {-# NOINLINE wideTreeData #-}
67 wideTreeEscapingData :: [String]
68 wideTreeEscapingData = take 1000 $
69 cycle ["<><>", "\"lol\"", "<&>", "'>>'"]
70 {-# NOINLINE wideTreeEscapingData #-}
74 {-# NOINLINE deepTreeData #-}
76 manyAttributesData :: [String]
77 manyAttributesData = wideTreeData
79 customAttributesData :: [(String, String)]
80 customAttributesData = zip wideTreeData wideTreeData
82 -- | Render the argument matrix as an HTML table.
84 bigTable :: [[Int]] -- ^ Matrix.
86 bigTable t = table $ mconcat $ map row t
88 row r = tr $ mconcat $ map (td . toHtml) r
90 -- | Render a simple HTML page with some data.
92 basic :: (String, String, [String]) -- ^ (Title, User, Items)
94 basic (title', user, items') = html $ do
95 H.head $ title $ toHtml title'
97 div ! id "header" $ (h1 $ toHtml title')
98 p $ "Hello, " `mappend` toHtml user `mappend` "!"
102 ol $ mconcat $ map (li . toHtml) items'
103 div ! id "footer" $ mempty
105 -- | A benchmark producing a very wide but very shallow tree.
107 wideTree :: [String] -- ^ Text to create a tree from.
109 wideTree = div . mapM_ ((p ! id "foo") . toHtml)
111 -- | Create a very deep tree.
113 deepTree :: Int -- ^ Depth of the tree.
116 deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1)
118 -- | Create an element with many attributes.
120 manyAttributes :: [String] -- ^ List of attribute values.
122 manyAttributes = foldl setAttribute img
124 setAttribute html' value' = html' ! id (toValue value')
125 {-# INLINE setAttribute #-}
127 customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs
129 customAttributes = foldl setAttribute img
131 setAttribute html' (name, value') =
132 html' ! customAttribute (stringTag name) (toValue value')