1-- | This is a collection of HTML benchmarks for BlazeMarkup.
2
3--
4{-# LANGUAGE ExtendedDefaultRules #-}
5{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}
6{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}
7module HtmlBenchmarks where
8
9import           Data.Monoid (Monoid,mappend,mempty)
10import qualified Data.Text as T
11-- import qualified Data.Text.Lazy.Builder as B
12
13import qualified Prelude as P
14import           Prelude hiding (div, id)
15import           Data.String
16
17-- import BenchmarkUtils
18import           Lucid
19import           Lucid.Base
20-- import qualified BenchmarkUtils as H
21
22-- | Description of an HTML benchmark
23--
24data HtmlBenchmark = forall a. HtmlBenchmark
25    String       -- ^ Name.
26    (a -> Html ())  -- ^ Rendering function.
27    a            -- ^ Data.
28    (Html ())         -- ^ Longer description.
29
30-- | List containing all benchmarks.
31--
32benchmarks :: [HtmlBenchmark]
33benchmarks =
34    [ HtmlBenchmark "bigTable" bigTable bigTableData $
35        let h = toHtml $ show $ length bigTableData
36            w = toHtml $ show $ length $ P.head bigTableData
37        in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table"
38    , HtmlBenchmark "basic" basic basicData
39        "A simple, small basic template with a few holes to fill in"
40    , HtmlBenchmark "wideTree" wideTree wideTreeData $
41        "A very wide tree (" >> toHtml (show (length wideTreeData)) >> " elements)"
42    , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do
43        "A very wide tree (" >> toHtml (show (length wideTreeData)) >> " elements)"
44        " with lots of escaping"
45    , HtmlBenchmark "deepTree" deepTree deepTreeData $ do
46        "A really deep tree (" >> toHtml (show deepTreeData) >> " nested templates)"
47    , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do
48        "A single element with " >> toHtml (show (length manyAttributesData))
49        " attributes."
50    , HtmlBenchmark "customAttribute" customAttributes customAttributesData $
51        "Creating custom attributes"
52    ]
53
54rows :: Int
55rows = 1000
56
57bigTableData :: [[Int]]
58bigTableData = replicate rows [1..10]
59{-# NOINLINE bigTableData #-}
60
61basicData :: (String, String, [String])
62basicData = ("Just a test", "joe", items)
63{-# NOINLINE basicData #-}
64
65items :: [String]
66items = map (("Number " `mappend`) . show) [1 :: Int .. 14]
67{-# NOINLINE items #-}
68
69wideTreeData :: [String]
70wideTreeData = take 5000 $
71    cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]
72{-# NOINLINE wideTreeData #-}
73
74wideTreeEscapingData :: [String]
75wideTreeEscapingData = take 1000 $
76    cycle ["<><>", "\"lol\"", "<&>", "'>>'"]
77{-# NOINLINE wideTreeEscapingData #-}
78
79deepTreeData :: Int
80deepTreeData = 1000
81{-# NOINLINE deepTreeData #-}
82
83manyAttributesData :: [String]
84manyAttributesData = wideTreeData
85
86customAttributesData :: [(String, String)]
87customAttributesData = zip wideTreeData wideTreeData
88
89-- | Render the argument matrix as an HTML table.
90--
91bigTable :: [[Int]]  -- ^ Matrix.
92         -> Html ()     -- ^ Result.
93bigTable t = table_ (mapM_ row t)
94
95row :: [Int] -> Html ()
96row r = tr_ (mapM_ (td_ . toHtml . show) r)
97
98-- | Render a simple HTML page with some data.
99--
100basic :: (String, String, [String])  -- ^ (Title, User, Items)
101      -> Html ()                        -- ^ Result.
102basic (title', user, items') = html_ $ do
103    head_ $ title_ $ toHtml title'
104    body_ $ do
105        with div_ [id_ "header"] $ (h1_ $ toHtml title')
106        p_ $ do "Hello, "; toHtml user; "!"
107        p_ $ "Hello, me!"
108        p_ $ "Hello, world!"
109        h2_ $ "loop"
110        ol_ $ mapM_ (li_ . toHtml) items'
111        with div_ [id_ "footer"] mempty
112
113-- | A benchmark producing a very wide but very shallow tree.
114--
115wideTree :: [String]  -- ^ Text to create a tree from.
116         -> Html ()      -- ^ Result.
117wideTree = div_ . mapM_ ((with p_ [id_ "foo"]) . toHtml)
118
119-- | Create a very deep tree.
120--
121deepTree :: Int   -- ^ Depth of the tree.
122         -> Html ()  -- ^ Result.
123deepTree 0 = "foo"
124deepTree n = p_ $ table_ $ tr_ $ td_ $ div_ $ deepTree (n - 1)
125
126-- | Create an element with many attributes.
127--
128manyAttributes :: [String]  -- ^ List of attribute values.
129               -> Html ()      -- ^ Result.
130manyAttributes as = img_ (map (id_ . T.pack) as)
131
132customAttributes :: [(String, String)]  -- ^ List of attribute name, value pairs
133                 -> Html ()                -- ^ Result
134customAttributes xs =
135  img_ (map (\(key,val) -> makeAttribute (fromString key) (T.pack val)) xs)
136