aboutsummaryrefslogtreecommitdiffhomepage
path: root/src/Benchmarks/BlazeTBenchmarks.hs
diff options
context:
space:
mode:
authorJohannes Gerer <oss@johannesgerer.com>2016-10-26 02:07:02 +0200
committerJohannes Gerer <oss@johannesgerer.com>2016-10-26 02:07:02 +0200
commit675085c2e0b0b851378da08b7d73024766107c87 (patch)
tree5a927de4a9576aef7e6129b96e74aa5c96f9ffb6 /src/Benchmarks/BlazeTBenchmarks.hs
downloadblazeT-675085c2e0b0b851378da08b7d73024766107c87.tar.gz
blazeT-675085c2e0b0b851378da08b7d73024766107c87.tar.zst
blazeT-675085c2e0b0b851378da08b7d73024766107c87.zip
Initial
Diffstat (limited to 'src/Benchmarks/BlazeTBenchmarks.hs')
-rw-r--r--src/Benchmarks/BlazeTBenchmarks.hs133
1 files changed, 133 insertions, 0 deletions
diff --git a/src/Benchmarks/BlazeTBenchmarks.hs b/src/Benchmarks/BlazeTBenchmarks.hs
new file mode 100644
index 0000000..83a38ad
--- /dev/null
+++ b/src/Benchmarks/BlazeTBenchmarks.hs
@@ -0,0 +1,133 @@
1-- | This is a collection of HTML benchmarks for BlazeMarkup.
2--
3{-# LANGUAGE OverloadedStrings, ExistentialQuantification, RankNTypes #-}
4{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
5module Benchmarks.BlazeTBenchmarks where
6
7import Data.Monoid (Monoid, mempty, mconcat, mappend)
8import Prelude hiding (div, id,map)
9import qualified Prelude as P
10
11import Text.BlazeT
12import Text.BlazeT.Html5
13import qualified Text.BlazeT.Html5 as H
14import qualified Text.BlazeT.Html5.Attributes as A
15
16-- | Description of an HTML benchmark
17--
18data HtmlBenchmark = forall a. HtmlBenchmark
19 String -- ^ Name.
20 (a -> Html) -- ^ Rendering function.
21 a -- ^ Data.
22 Html -- ^ Longer description.
23
24-- | List containing all benchmarks.
25--
26benchmarks :: [HtmlBenchmark]
27benchmarks =
28 [ HtmlBenchmark "bigTable" bigTable bigTableData $
29 let h = toHtml $ length bigTableData
30 w = toHtml $ length $ P.head bigTableData
31 in (string "Rendering of a big (") >> h >> (string "x") >> w >> ") HTML table"
32 , HtmlBenchmark "basic" basic basicData
33 "A simple, small basic template with a few holes to fill in"
34 , HtmlBenchmark "wideTree" wideTree wideTreeData $
35 (string "A very wide tree (") >> toHtml (length wideTreeData) >> " elements)"
36 , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do
37 (string "A very wide tree (") >> toHtml (length wideTreeData) >> (string " elements)")
38 " with lots of escaping"
39 , HtmlBenchmark "deepTree" deepTree deepTreeData $ do
40 (string "A really deep tree (") >> toHtml deepTreeData >> " nested templates)"
41 , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do
42 (string "A single element with ") >> toHtml (length manyAttributesData)
43 " attributes."
44 , HtmlBenchmark "customAttribute" customAttributes customAttributesData $
45 "Creating custom attributes"
46 ]
47
48rows :: Int
49rows = 1000
50
51bigTableData :: [[Int]]
52bigTableData = replicate rows [1..10]
53{-# NOINLINE bigTableData #-}
54
55basicData :: (String, String, [String])
56basicData = ("Just a test", "joe", items)
57{-# NOINLINE basicData #-}
58
59items :: [String]
60items = fmap (("Number " `mappend`) . show) [1 :: Int .. 14]
61{-# NOINLINE items #-}
62
63wideTreeData :: [String]
64wideTreeData = take 5000 $
65 cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]
66{-# NOINLINE wideTreeData #-}
67
68wideTreeEscapingData :: [String]
69wideTreeEscapingData = take 1000 $
70 cycle ["<><>", "\"lol\"", "<&>", "'>>'"]
71{-# NOINLINE wideTreeEscapingData #-}
72
73deepTreeData :: Int
74deepTreeData = 1000
75{-# NOINLINE deepTreeData #-}
76
77manyAttributesData :: [String]
78manyAttributesData = wideTreeData
79
80customAttributesData :: [(String, String)]
81customAttributesData = zip wideTreeData wideTreeData
82
83-- | Render the argument matrix as an HTML table.
84--
85bigTable :: [[Int]] -- ^ Matrix.
86 -> Html -- ^ Result.
87bigTable t = table $ mconcat $ fmap row t
88 where
89 row r = tr $ mconcat $ fmap (td . toHtml) r
90
91-- | Render a simple HTML page with some data.
92--
93basic :: (String, String, [String]) -- ^ (Title, User, Items)
94 -> Html -- ^ Result.
95basic (title', user, items') = html $ do
96 H.head $ title $ toHtml title'
97 body $ do
98 div ! A.id "header" $ (h1 $ toHtml title')
99 p $ "Hello, " `mappend` toHtml user `mappend` "!"
100 p $ "Hello, me!"
101 p $ "Hello, world!"
102 h2 $ "loop"
103 ol $ mconcat $ fmap (li . toHtml) items'
104 div ! A.id "footer" $ mempty
105
106-- | A benchmark producing a very wide but very shallow tree.
107--
108wideTree :: [String] -- ^ Text to create a tree from.
109 -> Html -- ^ Result.
110wideTree = div . mapM_ ((p ! A.id "foo") . toHtml)
111
112-- | Create a very deep tree.
113--
114deepTree :: Int -- ^ Depth of the tree.
115 -> Html -- ^ Result.
116deepTree 0 = "foo"
117deepTree n = p $ table $ tr $ td $ div $ deepTree (n - 1)
118
119-- | Create an element with many attributes.
120--
121manyAttributes :: [String] -- ^ List of attribute values.
122 -> Html -- ^ Result.
123manyAttributes = foldl setAttribute img
124 where
125 setAttribute html' value' = html' ! A.id (toValue value')
126 {-# INLINE setAttribute #-}
127
128customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs
129 -> Html -- ^ Result
130customAttributes = foldl setAttribute img
131 where
132 setAttribute html' (name, value') =
133 html' ! customAttribute (stringTag name) (toValue value')