type-of-html 1.4.0.0 → 1.4.0.1
raw patch · 20 files changed
+191/−383 lines, 20 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- Readme.md +9/−0
- bench/Alloc.hs +15/−15
- bench/Big.hs +0/−88
- bench/Blaze.hs +51/−61
- bench/Compilation/X0.hs +0/−1
- bench/Compilation/X1.hs +0/−1
- bench/Compilation/X128.hs +0/−1
- bench/Compilation/X16.hs +0/−1
- bench/Compilation/X2.hs +0/−1
- bench/Compilation/X32.hs +0/−1
- bench/Compilation/X4.hs +0/−1
- bench/Compilation/X64.hs +0/−1
- bench/Compilation/X8.hs +0/−1
- bench/Medium.hs +16/−156
- bench/Perf.hs +36/−36
- bench/Reduction.hs +25/−0
- bench/Small.hs +5/−15
- src/Html/Type/Internal.hs +20/−2
- type-of-html.cabal +10/−1
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for type-of-html +## 1.4.0.1 -- 2018-05-26++* reduction of reduction depth+ ## 1.4.0.0 -- 2018-05-01 * add fixity for >
Readme.md view
@@ -305,6 +305,15 @@ resulting html as bytestring in the binary and is therefore the fastest possible output. +Please consider as well using the packages+[https://hackage.haskell.org/package/type-of-html-static](type-of-html-static)+which provides helper TH functions to optimize even more at compile+time. It was put in a seperate package to avoid a dependency on TH+(which would've been handy for the functions in `Html.Element`). You+can achieve more or less 5x faster rendering when applying these+optimizations. The actual performance gain depends a lot on the+structure of your document.+ ## Comparision to lucid and blaze-html Advantages of `type-of-html`:
bench/Alloc.hs view
@@ -71,30 +71,30 @@ f "helloWorld" 1264 (renderByteString . M.helloWorld) () f "page" 1256 (renderByteString . M.page) () f "table" 1664 (renderByteString . M.table) (2,2)- f "AttrShort" 3352 (renderByteString . M.attrShort) ()+ f "AttrShort" 3232 (renderByteString . M.attrShort) () f "pageA" 2320 (renderByteString . M.pageA) ()- f "AttrLong" 2608 (renderByteString . M.attrLong) ()+ f "AttrLong" 3232 (renderByteString . M.attrLong) () f "Big table" 19968 (renderByteString . M.table) (15,15)- f "Big page" 25064 (renderByteString . B.page) ()+ f "Big page" 24960 (renderByteString . B.page) () - let libAlloc n = allocsError (101 + n) 7+ let libAlloc n = allocsError (104 + n) 7 validateAction "Compile Library" (compile tmp) "Html" $ libAlloc 0- validateAction "Compile Small.hs" (compile tmp) "Small" $ libAlloc 4- validateAction "Compile Medium.hs" (compile tmp) "Medium" $ libAlloc 77- validateAction "Compile Big.hs" (compile tmp) "Big" $ libAlloc 145- validateAction "Compile Alloc.hs" (compile tmp) "bench/Alloc.hs" $ libAlloc 151- validateAction "Compile Perf.hs" (compile tmp) "bench/Perf.hs" $ libAlloc 299+ validateAction "Compile Small.hs" (compile tmp) "Small" $ libAlloc 2+ validateAction "Compile Medium.hs" (compile tmp) "Medium" $ libAlloc 39+ validateAction "Compile Big.hs" (compile tmp) "Big" $ libAlloc 73+ validateAction "Compile Alloc.hs" (compile tmp) "bench/Alloc.hs" $ libAlloc 76+ validateAction "Compile Perf.hs" (compile tmp) "bench/Perf.hs" $ libAlloc 181 - validateAction "Compile X0.hs" (compile tmp) "bench/Compilation/X0.hs" $ libAlloc 5+ validateAction "Compile X0.hs" (compile tmp) "bench/Compilation/X0.hs" $ libAlloc 4 validateAction "Compile X1.hs" (compile tmp) "bench/Compilation/X1.hs" $ libAlloc 5- validateAction "Compile X2.hs" (compile tmp) "bench/Compilation/X2.hs" $ libAlloc 6- validateAction "Compile X4.hs" (compile tmp) "bench/Compilation/X4.hs" $ libAlloc 8- validateAction "Compile X8.hs" (compile tmp) "bench/Compilation/X8.hs" $ libAlloc 13- validateAction "Compile X16.hs" (compile tmp) "bench/Compilation/X16.hs" $ libAlloc 26+ validateAction "Compile X2.hs" (compile tmp) "bench/Compilation/X2.hs" $ libAlloc 5+ validateAction "Compile X4.hs" (compile tmp) "bench/Compilation/X4.hs" $ libAlloc 7+ validateAction "Compile X8.hs" (compile tmp) "bench/Compilation/X8.hs" $ libAlloc 12+ validateAction "Compile X16.hs" (compile tmp) "bench/Compilation/X16.hs" $ libAlloc 25 validateAction "Compile X32.hs" (compile tmp) "bench/Compilation/X32.hs" $ libAlloc 66 validateAction "Compile X64.hs" (compile tmp) "bench/Compilation/X64.hs" $ libAlloc 205- validateAction "Compile X128.hs" (compile tmp) "bench/Compilation/X128.hs" $ libAlloc 716+ validateAction "Compile X128.hs" (compile tmp) "bench/Compilation/X128.hs" $ libAlloc 717 compile :: String -> String -> IO () compile out m =
bench/Big.hs view
@@ -96,91 +96,3 @@ ) ) )--page' = \x ->- html_- ( body_- ( h1_A (A.id_ "a")- ( img_- # strong_A (A.class_ "b") (0 :: Int)- )- # div_- ( div_A (A.id_ "c") (1 :: Int)- )- # attrShort ""- # attrLong ""- # table (3,3)- # div_- ( form_A (A.class_ "d")- ( fieldset_- ( div_A (A.id_ "e")- ( div_- ( label_A (A.class_ "f") "g"- # select_- ( option_A (A.id_ "h") "i"- # option_ "j"- )- # div_A (A.class_ "k") "l"- )- # i_ x- )- # button_A (A.id_ "m") (i_ "n")- )- )- )- # div_- ( form_A (A.class_ "o")- ( fieldset_- ( div_A (A.id_ "p")- ( div_- ( label_A (A.class_ "q") "r"- # select_- ( option_A (A.id_ "s") "4"- # option_ "u"- )- # div_A (A.class_ "v") "w"- )- # i_ x- )- # button_A (A.id_ "x") (i_ "y")- )- )- )- # div_- ( form_A (A.class_ "z")- ( fieldset_- ( div_A (A.id_ "A")- ( div_- ( label_A (A.class_ "B") "C"- # select_- ( option_A (A.id_ "D") "E"- # option_ "F"- )- # div_A (A.class_ "G") "H"- )- # i_ x- )- # button_A (A.id_ "I") (i_ "J")- )- )- )- # div_- ( form_A (A.class_ "K")- ( fieldset_- ( div_A (A.id_ "L")- ( div_- ( label_A (A.class_ "M") "N"- # select_- ( option_A (A.id_ "O") "P"- # option_ "Q"- )- # div_A (A.class_ "R") "S"- )- # i_ x- )- # button_A (A.id_ "T") (i_ "U")- )- )- )- )- )
bench/Blaze.hs view
@@ -1,21 +1,13 @@+{-# LANGUAGE OverloadedStrings #-}+ module Blaze where -import Data.String import Control.Monad import Text.Blaze.Html5 ((!))-import System.IO.Unsafe -import System.Random--import qualified Data.Text as T- import qualified Text.Blaze.Html5 as B import qualified Text.Blaze.Html5.Attributes as BA -{-# NOINLINE randomText #-}-randomText :: T.Text-randomText = unsafePerformIO $ T.pack . take 250 . randoms <$> newStdGen- blazeMinimal :: B.Html -> B.Html blazeMinimal = B.div @@ -25,7 +17,7 @@ B.head $ do B.title x B.body $ do- B.p $ fromString "Hello World!"+ B.p "Hello World!" blazePage :: B.Html -> B.Html blazePage x =@@ -33,84 +25,82 @@ B.body $ do B.h1 $ do B.img- B.strong $ fromString "0"+ B.strong (B.toHtml (0 :: Int)) B.div $ do- B.div $ fromString "1"+ B.div (B.toHtml (1 :: Int)) B.div $ do B.form $ do B.fieldset $ do B.div $ do B.div $ do- B.label $ fromString "a"+ B.label "a" B.select $ do- B.option $ fromString "b"- B.option $ fromString "c"- B.div $ fromString "d"+ B.option "b"+ B.option "c"+ B.div "d" B.i x- B.button . B.i $ fromString "e"+ B.button $ B.i "e" -blazeAttrShort :: B.Html -> B.Html+blazeAttrShort :: B.AttributeValue -> B.Html blazeAttrShort x- = B.i ! BA.accesskey (fromString "a")- $ B.i ! BA.class_ (fromString "b")- $ B.i ! BA.contenteditable (fromString "c")- $ B.i ! BA.contextmenu (fromString "d")- $ B.i ! BA.dir (fromString "e")- $ B.i ! BA.draggable (fromString "f")- $ B.i ! BA.hidden (fromString "g")- $ B.i ! BA.id (fromString "h")- $ B.i ! BA.itemprop (fromString "i")- $ B.i ! BA.lang (fromString "j")- $ B.i ! BA.spellcheck (fromString "k")- $ B.i ! BA.style (fromString "l")- $ B.i ! BA.tabindex (fromString "m")- $ B.i ! BA.title (fromString "n")- $ x+ = B.i ! BA.accesskey "a"+ $ B.i ! BA.class_ "b"+ $ B.i ! BA.contenteditable "c"+ $ B.i ! BA.contextmenu "d"+ $ B.i ! BA.dir "e"+ $ B.i ! BA.draggable "f"+ $ B.i ! BA.hidden mempty+ $ B.i ! BA.id "h"+ $ B.i ! BA.itemprop "i"+ $ B.i ! BA.lang "j"+ $ B.i ! BA.spellcheck "k"+ $ B.i ! BA.style "l"+ $ B.i ! BA.title x+ $ "m" -blazeAttrLong :: B.Html -> B.Html+blazeAttrLong :: B.AttributeValue -> B.Html blazeAttrLong x- = B.i ! BA.accesskey (fromString "a")- ! BA.class_ (fromString "b")- ! BA.contenteditable (fromString "c")- ! BA.contextmenu (fromString "d")- ! BA.dir (fromString "e")- ! BA.draggable (fromString "f")- ! BA.hidden (fromString "g")- ! BA.id (fromString "h")- ! BA.itemprop (fromString "i")- ! BA.lang (fromString "j")- ! BA.spellcheck (fromString "k")- ! BA.style (fromString "l")- ! BA.tabindex (fromString "m")- ! BA.title (fromString "n")- $ x+ = B.i ! BA.accesskey "a"+ ! BA.class_ "b"+ ! BA.contenteditable "c"+ ! BA.contextmenu "d"+ ! BA.dir "e"+ ! BA.draggable "f"+ ! BA.hidden mempty+ ! BA.id "h"+ ! BA.itemprop "i"+ ! BA.lang "j"+ ! BA.spellcheck "k"+ ! BA.style "l"+ ! BA.title x+ $ "m" blazePageA :: B.Html -> B.Html blazePageA x = B.html $ do B.body $ do- B.h1 ! BA.id (fromString "a") $ do+ B.h1 ! BA.id "a" $ do B.img- B.strong ! BA.class_ (fromString "b") $ fromString "0"+ B.strong ! BA.class_ "b" $ (B.toHtml (0 :: Int)) B.div $ do- B.div ! BA.id (fromString "c") $ fromString "1"+ B.div ! BA.id "c" $ (B.toHtml (1 :: Int)) B.div $ do- B.form ! BA.class_ (fromString "d") $ do+ B.form ! BA.class_ "d" $ do B.fieldset $ do- B.div ! BA.id (fromString "e") $ do+ B.div ! BA.id "e" $ do B.div $ do- B.label ! BA.class_ (fromString "f") $ fromString "a"+ B.label ! BA.class_ "f" $ "a" B.select $ do- B.option ! BA.id (fromString "g") $ fromString "b"- B.option (fromString "c")- B.div ! BA.class_ (fromString "h") $ fromString "d"+ B.option ! BA.id "g" $ "b"+ B.option "c"+ B.div ! BA.class_ "h" $ "d" B.i x- B.button ! BA.id (fromString "i") $ B.i $ fromString "e"+ B.button ! BA.id "i" $ B.i "e" blazeTable :: (Int, Int) -> B.Html blazeTable (n, m) = B.table . replicateM_ n . B.tr- $ mapM_ (B.td . fromString . show) [1..m]+ $ mapM_ (B.td . B.toHtml) [1..m]
bench/Compilation/X0.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X0 (run) where
bench/Compilation/X1.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X1 (run) where
bench/Compilation/X128.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X128 (run) where
bench/Compilation/X16.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X16 (run) where
bench/Compilation/X2.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X2 (run) where
bench/Compilation/X32.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X32 (run) where
bench/Compilation/X4.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X4 (run) where
bench/Compilation/X64.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X64 (run) where
bench/Compilation/X8.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -freduction-depth=0 #-} {-# LANGUAGE DataKinds #-} module Compilation.X8 (run) where
bench/Medium.hs view
@@ -17,20 +17,8 @@ ) ) -helloWorld' = \x ->- html_- ( head_- ( title_ x- )- # body_- ( p_ "Hello World!"- )- )- table (n, m) = table_ . replicate n . tr_ $ map td_ [(1::Int)..m] -table' = \(n,m) -> table_ . replicate n . tr_ $ map td_ [(1::Int)..m]- page x = html_ ( body_@@ -62,85 +50,20 @@ ) ) -page' = \x ->- html_- ( body_- ( h1_- ( img_- # strong_ (0 :: Int)- )- # div_- ( div_ (1 :: Int)- )- # div_- ( form_- ( fieldset_- ( div_- ( div_- ( label_ "a"- # select_- ( option_ "b"- # option_ "c"- )- # div_ "d"- )- # i_ x- )- # button_ (i_ "e")- )- )- )- )- )---attrShort x- = i_A (A.accesskey_ "a")- . i_A (A.class_ "b")- . i_A (A.contenteditable_ "c")- . i_A (A.contextmenu_ "d")- . i_A (A.dir_ "e")- . i_A (A.draggable_ "f")- . i_A A.hidden_- . i_A (A.id_ "h")- . i_A (A.itemprop_ "i")- . i_A (A.lang_ "j")- . i_A (A.spellcheck_ "k")- . i_A (A.style_ "l")- . i_A (A.title_ "m")- $ x--attrShort'- = i_A (A.accesskey_ "a")- . i_A (A.class_ "b")- . i_A (A.contenteditable_ "c")- . i_A (A.contextmenu_ "d")- . i_A (A.dir_ "e")- . i_A (A.draggable_ "f")- . i_A A.hidden_- . i_A (A.id_ "h")- . i_A (A.itemprop_ "i")- . i_A (A.lang_ "j")- . i_A (A.spellcheck_ "k")- . i_A (A.style_ "l")- . i_A (A.title_ "m")--attrShort''- = \x ->- i_A (A.accesskey_ "a")- . i_A (A.class_ "b")- . i_A (A.contenteditable_ "c")- . i_A (A.contextmenu_ "d")- . i_A (A.dir_ "e")- . i_A (A.draggable_ "f")- . i_A A.hidden_- . i_A (A.id_ "h")- . i_A (A.itemprop_ "i")- . i_A (A.lang_ "j")- . i_A (A.spellcheck_ "k")- . i_A (A.style_ "l")- . i_A (A.title_ "m")- $ x+attrShort x =+ i_A (A.accesskey_ "a")+ ( i_A (A.class_ "b")+ ( i_A (A.contenteditable_ "c")+ ( i_A (A.contextmenu_ "d")+ ( i_A (A.dir_ "e")+ ( i_A (A.draggable_ "f")+ ( i_A A.hidden_+ ( i_A (A.id_ "h")+ ( i_A (A.itemprop_ "i")+ ( i_A (A.lang_ "j")+ ( i_A (A.spellcheck_ "k")+ ( i_A (A.style_ "l")+ ( i_A (A.title_ x) "m")))))))))))) attrLong x = i_A ( A.accesskey_ "a"@@ -155,40 +78,8 @@ # A.lang_ "j" # A.spellcheck_ "k" # A.style_ "l"- # A.title_ "n"- ) x--attrLong' =- i_A ( A.accesskey_ "a"- # A.class_ "b"- # A.contenteditable_ "c"- # A.contextmenu_ "d"- # A.dir_ "e"- # A.draggable_ "f"- # A.hidden_- # A.id_ "h"- # A.itemprop_ "i"- # A.lang_ "j"- # A.spellcheck_ "k"- # A.style_ "l"- # A.title_ "m"- )--attrLong'' = \x ->- i_A ( A.accesskey_ "a"- # A.class_ "b"- # A.contenteditable_ "c"- # A.contextmenu_ "d"- # A.dir_ "e"- # A.draggable_ "f"- # A.hidden_- # A.id_ "h"- # A.itemprop_ "i"- # A.lang_ "j"- # A.spellcheck_ "k"- # A.style_ "l"- # A.title_ "m"- ) x+ # A.title_ x+ ) "m" pageA x = html_@@ -215,37 +106,6 @@ # i_ x ) # button_A (A.id_ "n") (i_ "o")- )- )- )- )- )--pageA' = \x ->- html_- ( body_- ( h1_A (A.id_ "a")- ( img_- # strong_A (A.class_ "b") (0 :: Int)- )- # div_- ( div_A (A.id_ "c") (1 :: Int)- )- # div_- ( form_A (A.class_ "d")- ( fieldset_- ( div_A (A.id_ "e")- ( div_- ( label_A (A.class_ "f") "g"- # select_- ( option_A (A.id_ "h") "i"- # option_ "j"- )- # div_A (A.class_ "k") "l"- )- # i_ x- )- # button_A (A.id_ "m") (i_ "n") ) ) )
bench/Perf.hs view
@@ -13,6 +13,7 @@ import Criterion.Main import Data.String import System.Random+import System.IO.Unsafe import Data.Proxy import Text.Blaze.Html.Renderer.Utf8 import qualified Text.Blaze.Html5 as BL@@ -30,17 +31,9 @@ small :: Benchmark small = bgroup "Small" [ bench "oneElement" $ nf (renderByteString . S.oneElement) ""- , bench "oneElement'" $ nf (renderByteString . S.oneElement') ""- , bench "oneElement''" $ nf (renderByteString . S.oneElement'') "" , bench "nestedElement" $ nf (renderByteString . S.nestedElement) ""- , bench "nestedElement'" $ nf (renderByteString . S.nestedElement') ""- , bench "nestedElement''" $ nf (renderByteString . S.nestedElement'') "" , bench "parallelElement" $ nf (renderByteString . S.parallelElement) ""- , bench "parallelElement'" $ nf (renderByteString . S.parallelElement') ""- , bench "parallelElement''" $ nf (renderByteString . S.parallelElement'') "" , bench "listElement" $ nf (renderByteString . S.listElement) ""- , bench "listElement'" $ nf (renderByteString . S.listElement') ""- , bench "listElement''" $ nf (renderByteString . S.listElement'') "" , bench "Int" $ nf renderByteString (123456789 :: Int) , bench "Integer" $ nf renderByteString (123456789 :: Integer) , bench "Double" $ nf renderByteString (123456789 :: Double)@@ -64,47 +57,54 @@ medium :: Benchmark medium = bgroup "Medium" [ bench "helloWorld" $ nf (renderByteString . M.helloWorld) "medium"- , bench "helloWorld'" $ nf (renderByteString . M.helloWorld') "medium"- , bench "randomString" $ nfIO randomString- , bench "randomStringRaw" $ nfIO randomStringRaw- , bench "randomStrictText" $ nfIO randomStrictText- , bench "randomStrictTextRaw" $ nfIO randomStrictTextRaw- , bench "randomLazyText" $ nfIO randomLazyText- , bench "randomLazyTextRaw" $ nfIO randomLazyTextRaw+ , bench "randomString" $ nf renderByteString randomString+ , bench "randomStringRaw" $ nf renderByteString randomStringRaw+ , bench "randomStrictText" $ nf renderByteString randomStrictText+ , bench "randomStrictTextRaw" $ nf renderByteString randomStrictTextRaw+ , bench "randomLazyText" $ nf renderByteString randomLazyText+ , bench "randomLazyTextRaw" $ nf renderByteString randomLazyTextRaw , bench "table" $ nf (renderByteString . M.table) (2,2)- , bench "table'" $ nf (renderByteString . M.table') (2,2) , bench "page" $ nf (renderByteString . M.page) "medium"- , bench "page'" $ nf (renderByteString . M.page') "medium" , bench "pageA" $ nf (renderByteString . M.pageA) "medium"- , bench "pageA'" $ nf (renderByteString . M.pageA') "medium" , bench "attrShort" $ nf (renderByteString . M.attrShort) "medium"- , bench "attrShort'" $ nf (renderByteString . M.attrShort') "medium"- , bench "attrShort''" $ nf (renderByteString . M.attrShort'') "medium" , bench "attrLong" $ nf (renderByteString . M.attrLong) "medium"- , bench "attrLong'" $ nf (renderByteString . M.attrLong') "medium"- , bench "attrLong''" $ nf (renderByteString . M.attrLong'') "medium"- ] where+ ] - randomString = renderByteString . div_ . take 5 . randoms @Char <$> newStdGen- randomStringRaw = renderByteString . div_ . Raw . take 5 . randoms @Char <$> newStdGen- randomStrictText = renderByteString . div_ . T.pack . take 5 . randoms <$> newStdGen- randomStrictTextRaw = renderByteString . div_ . Raw . T.pack . take 5 . randoms <$> newStdGen- randomLazyText = renderByteString . div_ . LT.pack . take 5 . randoms <$> newStdGen- randomLazyTextRaw = renderByteString . div_ . Raw . LT.pack . take 5 . randoms <$> newStdGen+{-# NOINLINE randomString #-}+randomString :: String+randomString = unsafePerformIO $ take 250 . randoms <$> newStdGen +{-# NOINLINE randomStringRaw #-}+randomStringRaw :: Raw String+randomStringRaw = unsafePerformIO $ Raw . take 250 . randoms <$> newStdGen++{-# NOINLINE randomStrictText #-}+randomStrictText :: T.Text+randomStrictText = unsafePerformIO $ T.pack . take 250 . randoms <$> newStdGen++{-# NOINLINE randomStrictTextRaw #-}+randomStrictTextRaw :: Raw T.Text+randomStrictTextRaw = unsafePerformIO $ Raw . T.pack . take 250 . randoms <$> newStdGen++{-# NOINLINE randomLazyText #-}+randomLazyText :: LT.Text+randomLazyText = unsafePerformIO $ LT.pack . take 250 . randoms <$> newStdGen++{-# NOINLINE randomLazyTextRaw #-}+randomLazyTextRaw :: Raw LT.Text+randomLazyTextRaw = unsafePerformIO $ Raw . LT.pack . take 250 . randoms <$> newStdGen+ big :: Benchmark big = bgroup "Big" [ bench "table" $ nf (renderByteString . M.table) (15,15)- , bench "table'" $ nf (renderByteString . M.table') (15,15) , bench "page" $ nf (renderByteString . B.page) "big"- , bench "page'" $ nf (renderByteString . B.page') "big" ] blaze :: Benchmark blaze = bgroup "Blaze" [ bgroup "minimal"- [ bench "blaze-html" $ nf (renderHtml . BL.blazeMinimal) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . S.oneElement) "TEST"+ [ bench "blaze-html" $ nf (renderHtml . BL.blazeMinimal) (fromString "")+ , bench "type-of-html" $ nf (renderByteString . S.oneElement) "" ] , bgroup "hello world" [ bench "blaze-html" $ nf (renderHtml . BL.blazeHelloWorld) (fromString "TEST")@@ -130,8 +130,8 @@ [ bench "blaze-html" $ nf (renderHtml . BL.blazeTable) (4,4) , bench "type-of-html" $ nf (renderByteString . M.table) (4,4) ]- , bgroup "encode strict text"- [ bench "blaze-html" $ nf (renderHtml . BL.div . BL.toHtml) BL.randomText- , bench "type-of-html" $ nf (renderByteString . div_) BL.randomText+ , bgroup "encode random string"+ [ bench "blaze-html" $ nf (renderHtml . BL.div . BL.toHtml) randomString+ , bench "type-of-html" $ nf (renderByteString . div_) randomString ] ]
+ bench/Reduction.hs view
@@ -0,0 +1,25 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -freduction-depth=29 -fsimpl-tick-factor=42 #-}+module Main where++import Html+import qualified Html.Attribute as A++main = print p9++p1 = div_A (A.id_ 'a') 'b'++p2 = div_ (p1 # p1)++p3 = div_ (p2 # p2)++p4 = div_ (p3 # p3)++p5 = div_ (p4 # p4)++p6 = div_ (p5 # p5)++p7 = div_ (p6 # p6)++p8 = div_ (p7 # p7)++p9 = div_ (p8 # p8)
bench/Small.hs view
@@ -5,33 +5,23 @@ import Html -import Control.Arrow--oneElement, oneElement', oneElement''+oneElement :: ('Div ?> a) => a -> 'Div > a-oneElement x = div_ x-oneElement' = div_-oneElement'' = \x -> div_ x+oneElement = div_ -nestedElement, nestedElement', nestedElement''+nestedElement :: ('Span ?> a) => a -> 'Div > ('Span > a) nestedElement x = div_ (span_ x)-nestedElement' = div_ . span_-nestedElement'' = \x -> div_ (span_ x) -parallelElement, parallelElement', parallelElement''+parallelElement :: ('Span ?> a, 'Div ?> a) => a -> ('Div > a) # ('Span > a) parallelElement x = div_ x # span_ x-parallelElement' = uncurry (#) . (div_ &&& span_)-parallelElement'' = \x -> div_ x # span_ x -listElement, listElement', listElement''+listElement :: ('Div ?> a) => a -> ['Div > a] listElement x = [div_ x]-listElement' = pure . div_-listElement'' = \x -> [div_ x]
src/Html/Type/Internal.hs view
@@ -9,6 +9,8 @@ {-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE CPP #-} -- Compatibility with ghc8.2+ module Html.Type.Internal where import GHC.TypeLits@@ -444,6 +446,12 @@ -- a big html page get bigger if you try to refactor. type family Append xs ys :: [k] where + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': xs) ys+ = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': Append xs ys++ Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': xs) ys+ = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': Append xs ys+ Append (x1 ': x2 ': x3 ': x4 ': xs) ys = x1 ': x2 ': x3 ': x4 ': Append xs ys @@ -465,9 +473,14 @@ Drop 0 xs = xs Drop 1 (_ ': xs) = xs Drop 2 (_ ': _ ': xs) = xs- Drop 3 (_ ': _ ': _ ': xs) = xs Drop 4 (_ ': _ ': _ ': _ ': xs) = xs+#if __GLASGOW_HASKELL__ >= 804+ Drop 8 (_ ': _ ': _ ': _ ': _ ': _ ': _ ': _ ': xs) = xs+ Drop n xs = Drop (n - 2^Log2 n) (Drop (2^(Log2 n-1)) (Drop (2^(Log2 n-1)) xs))+#else+ Drop 3 (_ ': _ ': _ ': xs) = xs Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs+#endif -- | Type level take. --@@ -480,7 +493,12 @@ Take 2 (x1 ': x2 ': _) = '[x1, x2] Take 3 (x1 ': x2 ': x3 ': _) = '[x1, x2, x3] Take 4 (x1 ': x2 ': x3 ': x4 ': _) = '[x1, x2, x3, x4]- Take n (x1 ': x2 ': x3 ': x4 ': x5 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': Take (n-5) xs+ Take 5 (x1 ': x2 ': x3 ': x4 ': x5 ': _) = '[x1, x2, x3, x4, x5]+ Take 6 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': _) = '[x1, x2, x3, x4, x5, x6]+ Take 7 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': _) = '[x1, x2, x3, x4, x5, x6, x7]+ Take 8 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8]+ Take 9 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8, x9]+ Take n (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': Take (n-10) xs -- | Type of type level information about tags. data EInfo
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 1.4.0.0+version: 1.4.0.1 synopsis: High performance type driven html generation. description: This library makes most invalid html documents compile time errors and uses advanced type level features to realise compile time computations. license: BSD3@@ -56,6 +56,15 @@ ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4.9 && < 5++benchmark reduction+ type: exitcode-stdio-1.0+ main-is: Reduction.hs+ hs-source-dirs: bench+ ghc-options: -Wall -O2+ default-language: Haskell2010+ build-depends: base >= 4.9 && < 5+ , type-of-html benchmark alloc type: exitcode-stdio-1.0