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