type-of-html 1.0.0.0 → 1.0.1.0
raw patch · 12 files changed
+1010/−467 lines, 12 filesdep +double-conversionPVP ok
version bump matches the API change (PVP)
Dependencies added: double-conversion
API changes (from Hackage documentation)
+ Html: type Document a = Document' a
Files
- ChangeLog.md +5/−0
- bench/Big.hs +200/−0
- bench/Blaze.hs +159/−0
- bench/Main.hs +8/−257
- bench/Medium.hs +314/−0
- bench/Small.hs +92/−0
- src/Html.hs +1/−0
- src/Html/Convert.hs +10/−8
- src/Html/Reify.hs +5/−2
- src/Html/Type.hs +108/−110
- test/Main.hs +101/−88
- type-of-html.cabal +7/−2
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for type-of-html +## 1.0.1.0 -- 2017-10-29++* export Document+* use double conversion+ ## 1.0.0.0 -- 2017-09-18 * perf increase
+ bench/Big.hs view
@@ -0,0 +1,200 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE FlexibleContexts #-}++module Big where++import Html+import Medium (attrShort, attrLong)++import Criterion.Main+import qualified Html.Attribute as A++big :: Benchmark+big = bgroup "Big"+ [ bench "table" $ r table (15,15)+ , bench "table'" $ r table' (15,15)+ , bench "page" $ r page "big"+ , bench "page'" $ r page' "big"+ ]+ where r f x = nf (renderByteString . f) x++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_+ ( 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")+ )+ )+ )+ )+ )++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
@@ -0,0 +1,159 @@+module Blaze where++import Html+import Small+import Medium++import Data.String+import Criterion.Main+import Control.Monad+import Text.Blaze.Html5 ((!))+import Text.Blaze.Html.Renderer.Utf8+import System.IO.Unsafe+import Test.QuickCheck++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 $ do+ s <- take 250 <$> generate infiniteList :: IO String+ return $ T.pack s++blaze :: Benchmark+blaze = bgroup "Blaze"+ [ bgroup "minimal"+ [ bench "blaze-html" $ nf (renderHtml . blazeMinimal) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . oneElement) "TEST"+ ]+ , bgroup "hello world"+ [ bench "blaze-html" $ nf (renderHtml . blazeHelloWorld) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . helloWorld) "TEST"+ ]+ , bgroup "attributes long"+ [ bench "blaze-html" $ nf (renderHtml . blazeAttrLong) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . attrLong) "TEST"+ ]+ , bgroup "attributes short"+ [ bench "blaze-html" $ nf (renderHtml . blazeAttrShort) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . attrShort) "TEST"+ ]+ , bgroup "page"+ [ bench "blaze-html" $ nf (renderHtml . blazePage) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . page) "TEST"+ ]+ , bgroup "page with attributes"+ [ bench "blaze-html" $ nf (renderHtml . blazePageA) (fromString "TEST")+ , bench "type-of-html" $ nf (renderByteString . pageA) "TEST"+ ]+ , bgroup "table"+ [ bench "blaze-html" $ nf (renderHtml . blazeTable) (4,4)+ , bench "type-of-html" $ nf (renderByteString . table) (4,4)+ ]+ , bgroup "encode strict text"+ [ bench "blaze-html" $ nf (renderHtml . B.div . B.toHtml) randomText+ , bench "type-of-html" $ nf (renderByteString . div_) randomText+ ]+ ]++blazeMinimal :: B.Html -> B.Html+blazeMinimal = B.div++blazeHelloWorld :: B.Html -> B.Html+blazeHelloWorld x =+ B.html $ do+ B.head $ do+ B.title x+ B.body $ do+ B.p $ fromString "Hello World!"++blazePage :: B.Html -> B.Html+blazePage x =+ B.html $ do+ B.body $ do+ B.h1 $ do+ B.img+ B.strong $ fromString "0"+ B.div $ do+ B.div $ fromString "1"+ B.div $ do+ B.form $ do+ B.fieldset $ do+ B.div $ do+ B.div $ do+ B.label $ fromString "a"+ B.select $ do+ B.option $ fromString "b"+ B.option $ fromString "c"+ B.div $ fromString "d"+ B.i x+ B.button . B.i $ fromString "e"++blazeAttrShort :: B.Html -> 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++blazeAttrLong :: B.Html -> 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++blazePageA :: B.Html -> B.Html+blazePageA x =+ B.html $ do+ B.body $ do+ B.h1 ! BA.id (fromString "a") $ do+ B.img+ B.strong ! BA.class_ (fromString "b") $ fromString "0"+ B.div $ do+ B.div ! BA.id (fromString "c") $ fromString "1"+ B.div $ do+ B.form ! BA.class_ (fromString "d") $ do+ B.fieldset $ do+ B.div ! BA.id (fromString "e") $ do+ B.div $ do+ B.label ! BA.class_ (fromString "f") $ fromString "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.i x+ B.button ! BA.id (fromString "i") $ B.i $ fromString "e"++blazeTable :: (Int, Int) -> B.Html+blazeTable (n, m)+ = B.table+ . replicateM_ n+ . B.tr+ $ mapM_ (B.td . fromString . show) [1..m]+
bench/Main.hs view
@@ -1,265 +1,16 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}--{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-}- module Main where -import Html-import qualified Html.Attribute as A+import Blaze+import Small+import Medium+import Big -import Data.String-import Control.Monad import Criterion.Main -import Text.Blaze.Html5 ((!))-import Text.Blaze.Html.Renderer.Utf8--import qualified Text.Blaze.Html5 as B-import qualified Text.Blaze.Html5.Attributes as BA- main :: IO () main = defaultMain- [ bgroup "minimal"- [ bench "blaze-html" $ nf (renderHtml . blazeMinimal) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . minimal) "TEST"- ]- , bgroup "hello world"- [ bench "blaze-html" $ nf (renderHtml . blazeHelloWorld) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . helloWorld) "TEST"- ]- , bgroup "attributes long"- [ bench "blaze-html" $ nf (renderHtml . blazeAttrLong) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . attrLong) "TEST"- ]- , bgroup "attributes short"- [ bench "blaze-html" $ nf (renderHtml . blazeAttrShort) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . attrShort) "TEST"- ]- , bgroup "big page"- [ bench "blaze-html" $ nf (renderHtml . blazeBigPage) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . bigPage) "TEST"- ]- , bgroup "big page with attributes"- [ bench "blaze-html" $ nf (renderHtml . blazeBigPageA) (fromString "TEST")- , bench "type-of-html" $ nf (renderByteString . bigPageA) "TEST"- ]- , bgroup "big table"- [ bench "blaze-html" $ nf (renderHtml . blazeBigTable) (4,4)- , bench "type-of-html" $ nf (renderByteString . bigTable) (4,4)- ]+ [ small+ , medium+ , big+ , blaze ]---- Blaze based functions--blazeMinimal :: B.Html -> B.Html-blazeMinimal = B.div--blazeHelloWorld :: B.Html -> B.Html-blazeHelloWorld x =- B.html $ do- B.head $ do- B.title x- B.body $ do- B.p $ fromString "Hello World!"--blazeBigPage :: B.Html -> B.Html-blazeBigPage x =- B.html $ do- B.body $ do- B.h1 $ do- B.img- B.strong $ fromString "0"- B.div $ do- B.div $ fromString "1"- B.div $ do- B.form $ do- B.fieldset $ do- B.div $ do- B.div $ do- B.label $ fromString "a"- B.select $ do- B.option $ fromString "b"- B.option $ fromString "c"- B.div $ fromString "d"- B.i x- B.button . B.i $ fromString "e"--blazeAttrShort :: B.Html -> 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--blazeAttrLong :: B.Html -> 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--blazeBigPageA :: B.Html -> B.Html-blazeBigPageA x =- B.html $ do- B.body $ do- B.h1 ! BA.id (fromString "a") $ do- B.img- B.strong ! BA.class_ (fromString "b") $ fromString "0"- B.div $ do- B.div ! BA.id (fromString "c") $ fromString "1"- B.div $ do- B.form ! BA.class_ (fromString "d") $ do- B.fieldset $ do- B.div ! BA.id (fromString "e") $ do- B.div $ do- B.label ! BA.class_ (fromString "f") $ fromString "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.i x- B.button ! BA.id (fromString "i") $ B.i $ fromString "e"--blazeBigTable :: (Int, Int) -> B.Html-blazeBigTable (n, m)- = B.table- . replicateM_ n- . B.tr- $ mapM_ (B.td . fromString . show) [1..m]---- Type of Html based functions--minimal = div_--helloWorld x =- html_- ( head_- ( title_ x- )- # body_- ( p_ "Hello World!"- )- )--bigPage 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_ "g")- . 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.tabindex_ "m")- . i_A (A.title_ "n")- $ x--attrLong x =- i_A ( A.accesskey_ "a"- # A.class_ "b"- # A.contenteditable_ "c"- # A.contextmenu_ "d"- # A.dir_ "e"- # A.draggable_ "f"- # A.hidden_ "g"- # A.id_ "h"- # A.itemprop_ "i"- # A.lang_ "j"- # A.spellcheck_ "k"- # A.style_ "l"- # A.tabindex_ "m"- # A.title_ "n"- ) x--bigPageA 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") "a"- # select_- ( option_A (A.id_ "g") "b"- # option_ "c"- )- # div_A (A.class_ "h") "d"- )- # i_ x- )- # button_A (A.id_ "i") (i_ "e")- )- )- )- )- )--bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [(1::Int)..m]
+ bench/Medium.hs view
@@ -0,0 +1,314 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}++{-# LANGUAGE FlexibleContexts #-}++module Medium where++import Html++import Test.QuickCheck+import Criterion.Main++import qualified Html.Attribute as A+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT++medium :: Benchmark+medium = bgroup "Medium"+ [ bench "helloWorld" $ r helloWorld "medium"+ , bench "helloWorld'" $ r 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 "table" $ r table (2,2)+ , bench "table'" $ r table' (2,2)+ , bench "page" $ r page "medium"+ , bench "page'" $ r page' "medium"+ , bench "pageA" $ r pageA "medium"+ , bench "pageA'" $ r pageA' "medium"+ , bench "attrShort" $ r attrShort "medium"+ , bench "attrShort'" $ r attrShort' "medium"+ , bench "attrShort''" $ r attrShort'' "medium"+ , bench "attrLong" $ r attrLong "medium"+ , bench "attrLong'" $ r attrLong' "medium"+ , bench "attrLong''" $ r attrLong'' "medium"+ ]+ where r f x = nf (renderByteString . f) x++randomString = do+ a <- generate (resize 5 arbitrary) :: IO String+ return . renderByteString $ div_ a++randomStringRaw = do+ a <- generate (resize 5 arbitrary) :: IO String+ return . renderByteString $ div_ (Raw a)++randomStrictText = do+ a <- T.pack <$> generate (resize 5 arbitrary) :: IO T.Text+ return . renderByteString $ div_ a++randomStrictTextRaw = do+ a <- T.pack <$> generate (resize 5 arbitrary) :: IO T.Text+ return . renderByteString $ div_ (Raw a)++randomLazyText = do+ a <- LT.pack <$> generate (resize 5 arbitrary) :: IO LT.Text+ return . renderByteString $ div_ a++randomLazyTextRaw = do+ a <- LT.pack <$> generate (resize 5 arbitrary) :: IO LT.Text+ return . renderByteString $ div_ (Raw a)++helloWorld x =+ html_+ ( head_+ ( title_ x+ )+ # body_+ ( p_ "Hello World!"+ )+ )++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_+ ( 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")+ )+ )+ )+ )+ )++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_ "g")+ . 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.tabindex_ "m")+ . i_A (A.title_ "n")+ $ 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_ "g")+ . 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.tabindex_ "m")+ . i_A (A.title_ "n")++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_ "g")+ . 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.tabindex_ "m")+ . i_A (A.title_ "n")+ $ x++attrLong x =+ i_A ( A.accesskey_ "a"+ # A.class_ "b"+ # A.contenteditable_ "c"+ # A.contextmenu_ "d"+ # A.dir_ "e"+ # A.draggable_ "f"+ # A.hidden_ "g"+ # A.id_ "h"+ # A.itemprop_ "i"+ # A.lang_ "j"+ # A.spellcheck_ "k"+ # A.style_ "l"+ # A.tabindex_ "m"+ # 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_ "g"+ # A.id_ "h"+ # A.itemprop_ "i"+ # A.lang_ "j"+ # A.spellcheck_ "k"+ # A.style_ "l"+ # A.tabindex_ "m"+ # A.title_ "n"+ )++attrLong'' = \x ->+ i_A ( A.accesskey_ "a"+ # A.class_ "b"+ # A.contenteditable_ "c"+ # A.contextmenu_ "d"+ # A.dir_ "e"+ # A.draggable_ "f"+ # A.hidden_ "g"+ # A.id_ "h"+ # A.itemprop_ "i"+ # A.lang_ "j"+ # A.spellcheck_ "k"+ # A.style_ "l"+ # A.tabindex_ "m"+ # A.title_ "n"+ ) x++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") "h"+ # select_+ ( option_A (A.id_ "i") "j"+ # option_ "k"+ )+ # div_A (A.class_ "l") "m"+ )+ # 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/Small.hs view
@@ -0,0 +1,92 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}++module Small where++import Html+import qualified Html.Attribute as A++import Data.Proxy+import qualified Data.Text as T+import qualified Data.Text.Lazy as LT++import Criterion.Main+import Control.Arrow++small :: Benchmark+small = bgroup "Small"+ [ bench "oneElement" $ r oneElement ""+ , bench "oneElement'" $ r oneElement' ""+ , bench "oneElement''" $ r oneElement'' ""+ , bench "nestedElement" $ r nestedElement ""+ , bench "nestedElement'" $ r nestedElement' ""+ , bench "nestedElement''" $ r nestedElement'' ""+ , bench "parallelElement" $ r parallelElement ""+ , bench "parallelElement'" $ r parallelElement' ""+ , bench "parallelElement''" $ r parallelElement'' ""+ , bench "listElement" $ r listElement ""+ , bench "listElement'" $ r listElement' ""+ , bench "listElement''" $ r listElement'' ""+ , bench "Int" $ r id (123456789 :: Int)+ , bench "Integer" $ r id (123456789 :: Integer)+ , bench "Double" $ r id (123456789 :: Double)+ , bench "Float" $ r id (123456789 :: Float)+ , bench "Word" $ r id (123456789 :: Word)+ , bench "Proxy" $ r id (Proxy :: Proxy "abc")+ , bench "Char" $ r id 'a'+ , bench "oneElement Proxy" $ r oneElement (Proxy :: Proxy "abc")+ , bench "()" $ r id ()+ , bench "oneElement ()" $ r oneElement ()+ , bench "oneAttribute" $ r A.class_ ""+ , bench "oneAttribute ()" $ r A.class_ ()+ , bench "oneAttribute Proxy" $ r A.class_ (Proxy :: Proxy "abc")+ , bench "parallelAttribute" $ r (\x -> A.class_ x # A.id_ x) ""+ , bench "elementWithAttribute" $ r (\x -> div_A (A.class_ x) x) ""+ , bench "elementWithParallelAttribute" $ r (\x -> div_A (A.class_ x # A.id_ x) x) ""+ , bench "listOfAttributes" $ r (\x -> [A.class_ x, A.class_ x]) ""+ , bench "Runtime String" $ r id runtimeTxt+ , bench "String" $ r id "abcdefghijklmnopqrstuvwxyz<>&;"+ , bench "Runtime Raw String" $ r id (Raw runtimeTxt)+ , bench "Raw String" $ r id (Raw "abcdefghijklmnopqrstuvwxyz<>&;")+ , bench "Runtime strict Text" $ r id (T.pack runtimeTxt)+ , bench "strict Text" $ r id (T.pack "abcdefghijklmnopqrstuvwxyz<>&;")+ , bench "Runtime Raw strict Text" $ r id (Raw (T.pack runtimeTxt))+ , bench "Raw strict Text" $ r id (Raw (T.pack "abcdefghijklmnopqrstuvwxyz<>&;"))+ , bench "Runtime lazy Text" $ r id (LT.pack runtimeTxt)+ , bench "lazy Text" $ r id (LT.pack "abcdefghijklmnopqrstuvwxyz<>&;")+ , bench "Runtime Raw lazy Text" $ r id (Raw (LT.pack runtimeTxt))+ , bench "Raw lazy Text" $ r id (Raw (LT.pack "abcdefghijklmnopqrstuvwxyz<>&;"))+ , bench "listOfListOf" $ r (\x -> div_ [i_ [span_ x]]) ""+ ]+ where r f x = nf (renderByteString . f) x+ runtimeTxt = reverse "abcdefghijklmnopqrstuvwxyz<>&;"++oneElement, oneElement', oneElement''+ :: ('Div ?> a)+ => a -> 'Div > a+oneElement x = div_ x+oneElement' = div_+oneElement'' = \x -> div_ x++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''+ :: ('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''+ :: ('Div ?> a)+ => a -> ['Div > a]+listElement x = [div_ x]+listElement' = pure . div_+listElement'' = \x -> [div_ x]+
src/Html.hs view
@@ -18,6 +18,7 @@ , type (?>) , type (??>) , type (:=)(..)+ , Document , Raw(..) , Convert(..) , Converted
src/Html/Convert.hs view
@@ -17,6 +17,8 @@ import Data.Char (ord) +import Data.Double.Conversion.ByteString+ import qualified GHC.CString as GHC import qualified Data.Monoid as M import qualified Data.Semigroup as S@@ -31,7 +33,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -{-# INLINE escapeUtf8 #-} escapeUtf8 :: BP.BoundedPrim Char escapeUtf8 = BP.condB (> '>' ) BP.charUtf8 $@@ -50,7 +51,6 @@ fixed5 x = BP.liftFixedToBounded $ const x BP.>$< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 -{-# INLINE escape #-} escape :: BP.BoundedPrim Word8 escape = BP.condB (> c2w '>' ) (BP.liftFixedToBounded BP.word8) $@@ -63,9 +63,11 @@ where c2w = fromIntegral . ord + {-# INLINE fixed4 #-} fixed4 x = BP.liftFixedToBounded $ const x BP.>$< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 + {-# INLINE fixed5 #-} fixed5 x = BP.liftFixedToBounded $ const x BP.>$< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 @@ -153,10 +155,10 @@ convert = Converted . B.integerDec instance Convert Float where {-# INLINE convert #-}- convert = Converted . B.floatDec+ convert = Converted . U.byteStringCopy . toShortest . realToFrac instance Convert Double where {-# INLINE convert #-}- convert = Converted . B.doubleDec+ convert = Converted . U.byteStringCopy . toShortest instance Convert Word where {-# INLINE convert #-} convert = Converted . B.wordDec@@ -165,8 +167,8 @@ convert = Converted . U.byteStringCopy . fromString . symbolVal {-# INLINE builderCString# #-}-builderCString# :: Addr# -> Converted-builderCString# addr = Converted $ BP.primUnfoldrBounded escape go 0+builderCString# :: BP.BoundedPrim Word8 -> Addr# -> Converted+builderCString# bp addr = Converted $ BP.primUnfoldrBounded bp go 0 where go !i | b /= 0 = Just (fromIntegral b, i+1) | otherwise = Nothing@@ -184,11 +186,11 @@ {-# RULES "CONVERTED literal" forall a. stringConv (GHC.unpackCString# a)- = builderCString# a #-}+ = builderCString# escape a #-} {-# RULES "CONVERTED literal raw" forall a. stringConvRaw (GHC.unpackCString# a)- = Converted (U.byteStringCopy (fromString (GHC.unpackCString# a))) #-}+ = builderCString# (BP.liftFixedToBounded BP.word8) a #-} {-# RULES "CONVERTED literal utf8" forall a. stringConv (GHC.unpackCStringUtf8# a)
src/Html/Reify.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}@@ -46,8 +47,10 @@ renderByteString :: Document a => a -> B.ByteString renderByteString = B.toLazyByteString . renderBuilder -class Renderchunks (Tagged (ToTypeList a) a) => Document a where-instance Renderchunks (Tagged (ToTypeList a) a) => Document a+-- | Constraint synonym of html documents.+type Document a = Document' a++type Document' a = Renderchunks (Tagged (ToTypeList a) a) class Renderchunks a where renderchunks :: a -> B.Builder
src/Html/Type.hs view
@@ -368,9 +368,13 @@ infixr 8 > -- | Decorate an element with attributes and descend to a valid child.+-- It is recommended to use the predefined elements. ----- >>> WithAttributes (A.class_ "bar") "a" :: 'Div :> String+-- >>> WithAttributes (A.class_ "bar") "a" :: ('Div :@: ('ClassA := String)) String -- <div class="bar">a</div>+--+-- >>> div_A (A.class_ "bar") "a"+-- <div class="bar">a</div> data (:@:) (a :: Element) b c where WithAttributes :: (a ??> b, a ?> c) => b -> c -> (a :@: b) c infixr 8 :@:@@ -650,16 +654,16 @@ ShowAttribute WrapA = " wrap=\"" type family OpenTag e where- OpenTag e = AppendSymbol (AppendSymbol "<" (ShowElement e)) ">"+ OpenTag e = AppendSymbol "<" (AppendSymbol (ShowElement e) ">") type family CloseTag e where- CloseTag e = AppendSymbol (AppendSymbol "</" (ShowElement e)) ">"+ CloseTag e = AppendSymbol "</" (AppendSymbol (ShowElement e) ">") type family CountContent c where CountContent (a # b) = CountContent a + CountContent b CountContent (_ > b) = CountContent b CountContent ((_ :@: b) c) = CountContent b + CountContent c- CountContent (a := b) = CountContent b+ CountContent (_ := b) = CountContent b CountContent () = 0 CountContent (Proxy _) = 0 CountContent _ = 1@@ -781,12 +785,6 @@ | SectioningContent | HeadingContent | PhrasingContent- | EmbeddedContent- | InteractiveContent- | FormAssociatedContent- | TransparentContent- | PalpableContent- | SectioningRoot | (:|:) ContentCategory ContentCategory | (:&:) ContentCategory ContentCategory | NOT ContentCategory@@ -935,35 +933,35 @@ NoContent GetInfo A = ElementInfo- [ FlowContent, PhrasingContent, InteractiveContent, PalpableContent ]- (TransparentContent :|: FlowContent :&: NOT InteractiveContent :|: PhrasingContent)+ '[ FlowContent, PhrasingContent ]+ (FlowContent :&: NOT (SingleElement Details) :|: PhrasingContent) GetInfo Abbr = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Address = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :&: NOT (HeadingContent :|: SectioningContent :|: SingleElement Address :|: SingleElement Header :|: SingleElement Footer)) GetInfo Area = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo Article = ElementInfo- [ FlowContent, SectioningContent, PalpableContent ]+ '[ FlowContent, SectioningContent ] FlowContent GetInfo Aside = ElementInfo- [ FlowContent, SectioningContent, PalpableContent ]+ '[ FlowContent, SectioningContent ] FlowContent GetInfo Audio = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]- (SingleElement Source :|: SingleElement Track :|: TransparentContent :&: NOT (SingleElement Audio :|: SingleElement Video))+ '[ FlowContent, PhrasingContent ]+ (SingleElement Source :|: SingleElement Track) GetInfo B = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Base = ElementInfo@@ -971,43 +969,43 @@ NoContent GetInfo Bdi = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Bdo = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Blockquote = ElementInfo- [ FlowContent, SectioningRoot, PalpableContent ]+ '[ FlowContent ] FlowContent GetInfo Body = ElementInfo- '[ SectioningRoot ]+ '[] FlowContent GetInfo Br = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo Button = ElementInfo- [ FlowContent, PhrasingContent, InteractiveContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Canvas = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent ]- (TransparentContent :&: NOT InteractiveContent :|: SingleElement A :|: SingleElement Button :|: SingleElement Input)+ '[ FlowContent, PhrasingContent ]+ (SingleElement A :|: SingleElement Button :|: SingleElement Input) GetInfo Caption = ElementInfo '[] FlowContent GetInfo Cite = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Code = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Col = ElementInfo@@ -1019,11 +1017,11 @@ (SingleElement Col) GetInfo Data = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Datalist = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] (PhrasingContent :|: SingleElement Option) GetInfo Dd = ElementInfo@@ -1031,27 +1029,27 @@ FlowContent GetInfo Del = ElementInfo- [ FlowContent, PhrasingContent ]- TransparentContent+ '[ FlowContent, PhrasingContent ]+ OnlyText GetInfo Details = ElementInfo- [ FlowContent, SectioningRoot, InteractiveContent, PalpableContent ]- ( SingleElement Summary :|: FlowContent)+ '[ FlowContent ]+ ( FlowContent :|: SingleElement Summary) GetInfo Dfn = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Dfn)) GetInfo Dialog = ElementInfo- [ FlowContent, SectioningRoot ]+ '[ FlowContent ] FlowContent GetInfo Div = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :|: SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template) GetInfo Dl = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template :|: SingleElement Div) GetInfo Dt = ElementInfo@@ -1059,67 +1057,67 @@ (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent)) GetInfo Em = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Embed = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo Fieldset = ElementInfo- [ FlowContent, SectioningRoot, FormAssociatedContent, PalpableContent ]- (SingleElement Legend :|: FlowContent)+ '[ FlowContent ]+ (FlowContent :|: SingleElement Legend) GetInfo Figcaption = ElementInfo '[] FlowContent GetInfo Figure = ElementInfo- [ FlowContent, SectioningRoot, PalpableContent ]- (SingleElement Figcaption :|: FlowContent)+ '[ FlowContent ]+ (FlowContent :|: SingleElement Figcaption) GetInfo Footer = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :&: NOT (SingleElement Footer :|: SingleElement Header)) GetInfo Form = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :&: NOT (SingleElement Form)) GetInfo H1 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo H2 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo H3 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo H4 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo H5 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo H6 = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] PhrasingContent GetInfo Head = ElementInfo '[]- (MetadataContent :|: SingleElement Title)+ MetadataContent GetInfo Header = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer)) GetInfo Hgroup = ElementInfo- [ FlowContent, HeadingContent, PalpableContent ]+ '[ FlowContent, HeadingContent ] (SingleElement H1 :|: SingleElement H2 :|: SingleElement H3 :|: SingleElement H4 :|: SingleElement H5 :|: SingleElement H6) GetInfo Hr = ElementInfo@@ -1131,27 +1129,27 @@ (SingleElement Head :|: SingleElement Body) GetInfo I = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Iframe = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo Img = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent, InteractiveContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo Ins = ElementInfo- [ FlowContent, PhrasingContent ]- TransparentContent+ '[ FlowContent, PhrasingContent ]+ OnlyText GetInfo Kbd = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Label = ElementInfo- [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Label)) GetInfo Legend = ElementInfo@@ -1163,23 +1161,23 @@ FlowContent GetInfo Link = ElementInfo- [ MetadataContent, FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent, MetadataContent ] NoContent GetInfo Main = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] FlowContent GetInfo Map = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]- TransparentContent+ '[ FlowContent, PhrasingContent ]+ OnlyText GetInfo Mark = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Menu = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (FlowContent :|: SingleElement Li :|: SingleElement Script :|: SingleElement Template :|: SingleElement Menu :|: SingleElement Menuitem :|: SingleElement Hr) GetInfo Menuitem = ElementInfo@@ -1187,27 +1185,27 @@ NoContent GetInfo Meta = ElementInfo- [ MetadataContent, FlowContent, PhrasingContent ]+ '[ FlowContent, MetadataContent, PhrasingContent ] NoContent GetInfo Meter = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Meter)) GetInfo Nav = ElementInfo- [ FlowContent, SectioningContent, PalpableContent ]+ '[ FlowContent, SectioningContent ] FlowContent GetInfo Noscript = ElementInfo- [ MetadataContent, FlowContent, PhrasingContent ]- (SingleElement Link :|: SingleElement Style :|: SingleElement Meta :|: TransparentContent :&: NOT (SingleElement Noscript) :|: FlowContent :|: PhrasingContent)+ '[ FlowContent, MetadataContent, PhrasingContent ]+ (FlowContent :|: PhrasingContent :|: SingleElement Link :|: SingleElement Style :|: SingleElement Meta) GetInfo Object = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent, InteractiveContent, FormAssociatedContent ]- (SingleElement Param :|: TransparentContent)+ '[ FlowContent, PhrasingContent ]+ (SingleElement Param) GetInfo Ol = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (SingleElement Li) GetInfo Optgroup = ElementInfo@@ -1219,11 +1217,11 @@ OnlyText GetInfo Output = ElementInfo- [ FlowContent, PhrasingContent, FormAssociatedContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo P = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] PhrasingContent GetInfo Param = ElementInfo@@ -1231,19 +1229,19 @@ NoContent GetInfo Picture = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent ]+ '[ FlowContent, PhrasingContent ] (SingleElement Source :|: SingleElement Img) GetInfo Pre = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] PhrasingContent GetInfo Progress = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Progress)) GetInfo Q = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Rp = ElementInfo@@ -1259,35 +1257,35 @@ (PhrasingContent :|: SingleElement Rt) GetInfo Ruby = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo S = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Samp = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Script = ElementInfo- [ MetadataContent, FlowContent, PhrasingContent ]+ '[ FlowContent, MetadataContent, PhrasingContent ] OnlyText GetInfo Section = ElementInfo- [ FlowContent, SectioningContent, PalpableContent ]+ '[ FlowContent, SectioningContent ] FlowContent GetInfo Select = ElementInfo- [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent ]+ '[ FlowContent, PhrasingContent ] (SingleElement Option :|: SingleElement Optgroup) GetInfo Slot = ElementInfo- [ FlowContent, PhrasingContent ]- TransparentContent+ '[ FlowContent, PhrasingContent ]+ OnlyText GetInfo Small = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Source = ElementInfo@@ -1295,19 +1293,19 @@ NoContent GetInfo Span = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Strong = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Style = ElementInfo- [ MetadataContent, FlowContent ]+ '[ FlowContent, MetadataContent ] OnlyText GetInfo Sub = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Summary = ElementInfo@@ -1315,7 +1313,7 @@ (PhrasingContent :|: HeadingContent) GetInfo Sup = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Table = ElementInfo@@ -1331,11 +1329,11 @@ FlowContent GetInfo Template = ElementInfo- [ MetadataContent, FlowContent, PhrasingContent ]- (MetadataContent :|: FlowContent)+ '[ FlowContent, MetadataContent, PhrasingContent ]+ (FlowContent :|: MetadataContent) GetInfo Textarea = ElementInfo- [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent ]+ '[ FlowContent, PhrasingContent ] OnlyText GetInfo Tfoot = ElementInfo@@ -1351,7 +1349,7 @@ (SingleElement Tr) GetInfo Time = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Title = ElementInfo@@ -1367,25 +1365,25 @@ NoContent GetInfo U = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Ul = ElementInfo- [ FlowContent, PalpableContent ]+ '[ FlowContent ] (SingleElement Li) GetInfo Var = ElementInfo- [ FlowContent, PhrasingContent, PalpableContent ]+ '[ FlowContent, PhrasingContent ] PhrasingContent GetInfo Video = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]- (SingleElement Track :|: TransparentContent :&: NOT (SingleElement Audio :|: SingleElement Video) :|: SingleElement Source)+ '[ FlowContent, PhrasingContent ]+ (SingleElement Track :|: SingleElement Source) GetInfo Wbr = ElementInfo- [ FlowContent, PhrasingContent ]+ '[ FlowContent, PhrasingContent ] NoContent GetInfo _ = ElementInfo- [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]- (FlowContent :|: PhrasingContent :|: EmbeddedContent :|: InteractiveContent :|: PalpableContent)+ '[ FlowContent, PhrasingContent ]+ (FlowContent :|: PhrasingContent)
test/Main.hs view
@@ -6,201 +6,214 @@ module Main where import Html+ import qualified Html.Attribute as A import Data.Proxy import Test.Hspec import Test.QuickCheck -import Data.Text.Lazy.Encoding--import qualified Data.Text.Lazy as T--newtype Escaped = Escaped String deriving Show--instance Arbitrary Escaped where- arbitrary = Escaped <$> arbitrary `suchThat` (\x -> all (`notElem` x) "<>&\"'")- main :: IO () main = hspec spec spec :: Spec-spec = let allT a b c = b (renderString a, T.unpack $ renderText a, T.unpack . decodeUtf8 $ renderByteString a)- (c, c, c)-- in parallel $ do+spec = parallel $ do describe "render" $ do - it "is id on strings without escaping chars" $ do+ it "is id on strings without escaping" $ do - property $ \(Escaped x) -> allT x (==) x+ property $ \x ->+ renderString (Raw x)+ ===+ x it "handles single elements" $ do - property $ \(Escaped x) -> allT (div_ x) (==) ("<div>" ++ x ++ "</div>")+ property $ \x ->+ renderString (div_ (Raw x))+ ===+ "<div>" ++ x ++ "</div>" it "handles nested elements" $ do - property $ \(Escaped x) -> allT (div_ (div_ x)) (==)- ("<div><div>" ++ x ++ "</div></div>")+ property $ \x ->+ renderString (div_ (div_ (Raw x)))+ ===+ "<div><div>" ++ x ++ "</div></div>" it "handles parallel elements" $ do - property $ \(Escaped x) (Escaped y) -> allT (div_ x # div_ y)- (==)- ("<div>" ++ x ++ "</div><div>" ++ y ++ "</div>")+ property $ \x y ->+ renderString (div_ (Raw x) # div_ (Raw y))+ ===+ "<div>" ++ x ++ "</div><div>" ++ y ++ "</div>" it "doesn't use closing tags for empty elements" $ do - allT area_- shouldBe+ renderString area_+ `shouldBe` "<area>" - allT base_- shouldBe+ renderString base_+ `shouldBe` "<base>" - allT br_- shouldBe+ renderString br_+ `shouldBe` "<br>" - allT col_- shouldBe+ renderString col_+ `shouldBe` "<col>" - allT embed_- shouldBe+ renderString embed_+ `shouldBe` "<embed>" - allT hr_- shouldBe+ renderString hr_+ `shouldBe` "<hr>" - allT iframe_- shouldBe+ renderString iframe_+ `shouldBe` "<iframe>" - allT img_- shouldBe+ renderString img_+ `shouldBe` "<img>" - allT link_- shouldBe+ renderString link_+ `shouldBe` "<link>" - allT menuitem_- shouldBe+ renderString menuitem_+ `shouldBe` "<menuitem>" - allT meta_- shouldBe+ renderString meta_+ `shouldBe` "<meta>" - allT param_- shouldBe+ renderString param_+ `shouldBe` "<param>" - allT source_- shouldBe+ renderString source_+ `shouldBe` "<source>" - allT track_- shouldBe+ renderString track_+ `shouldBe` "<track>" - allT wbr_- shouldBe+ renderString wbr_+ `shouldBe` "<wbr>" it "handles trailing text" $ do - property $ \(Escaped x) (Escaped y) -> allT (td_ x # y)- (==)- ("<td>" ++ x ++ "</td>" ++ y)+ property $ \x y ->+ renderString (td_ (Raw x) # (Raw y))+ ===+ "<td>" ++ x ++ "</td>" ++ y it "handles a single compile time text" $ do - allT (Proxy :: Proxy "a")- shouldBe+ renderString (Proxy :: Proxy "a")+ `shouldBe` "a" it "handles trailing compile time text" $ do - allT (div_ "a" # (Proxy :: Proxy "b"))- shouldBe+ renderString (div_ "a" # (Proxy :: Proxy "b"))+ `shouldBe` "<div>a</div>b" it "handles nested compile time text" $ do - allT (div_ (Proxy :: Proxy "a"))- shouldBe+ renderString (div_ (Proxy :: Proxy "a"))+ `shouldBe` "<div>a</div>" it "handles an empty list" $ do - allT (tail [td_ "a"])- shouldBe+ renderString (tail [td_ "a"])+ `shouldBe` "" it "handles a list with a single element" $ do - allT [td_ "a"]- shouldBe+ renderString [td_ "a"]+ `shouldBe` "<td>a</td>" it "handles tags in a list with parallel elements" $ do - allT [div_ "a" # i_ "b"]- shouldBe+ renderString [div_ "a" # i_ "b"]+ `shouldBe` "<div>a</div><i>b</i>" it "handles nested lists" $ do - allT (div_ [div_ [div_ (4 :: Int)]])- shouldBe+ renderString (div_ [div_ [div_ (4 :: Int)]])+ `shouldBe` "<div><div><div>4</div></div></div>" it "handles utf8 correctly" $ do - allT (div_ "a ä € 𝄞")- shouldBe+ renderString (div_ "a ä € 𝄞")+ `shouldBe` "<div>a ä € 𝄞</div>" - allT (img_A (A.id_ "a ä € 𝄞"))- shouldBe+ renderString (img_A (A.id_ "a ä € 𝄞"))+ `shouldBe` "<img id=\"a ä € 𝄞\">" + it "handles Chars" $ do++ property $ \x ->+ renderString (div_ [x :: Char])+ ===+ renderString (div_ x)++ it "handles Ints" $ do++ property $ \x ->+ renderString (div_ (x :: Int))+ ===+ renderString (div_ (show x))+ it "handles complex compile time documents" $ do - allT (div_ () # i_ ())- shouldBe+ renderString (div_ () # i_ ())+ `shouldBe` "<div></div><i></i>" - allT (div_ () # "a")- shouldBe+ renderString (div_ () # "a")+ `shouldBe` "<div></div>a" - allT ("a" # i_ ())- shouldBe+ renderString ("a" # i_ ())+ `shouldBe` "a<i></i>" - allT (div_ () # i_ (Proxy @"a"))- shouldBe+ renderString (div_ () # i_ (Proxy @"a"))+ `shouldBe` "<div></div><i>a</i>" - allT (div_ (Proxy @"a") # i_ ())- shouldBe+ renderString (div_ (Proxy @"a") # i_ ())+ `shouldBe` "<div>a</div><i></i>" - allT (Proxy @"1" # "2")- shouldBe+ renderString (Proxy @"1" # "2")+ `shouldBe` "12" - allT ("1" # Proxy @"2")- shouldBe+ renderString ("1" # Proxy @"2")+ `shouldBe` "12" - allT (div_ () # td_ (Proxy @"1" # "2" # div_ () # i_A (A.id_ (Proxy @"3")) "4"))- shouldBe+ renderString (div_ () # td_ (Proxy @"1" # "2" # div_ () # i_A (A.id_ (Proxy @"3")) "4"))+ `shouldBe` "<div></div><td>12<div></div><i id=\"3\">4</i></td>"
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 1.0.0.0+version: 1.0.1.0 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@@ -32,6 +32,7 @@ , text , bytestring , ghc-prim+ , double-conversion test-suite test type: exitcode-stdio-1.0@@ -43,11 +44,14 @@ , type-of-html , QuickCheck , hspec- , text benchmark bench type: exitcode-stdio-1.0 main-is: Main.hs+ other-modules: Small+ , Medium+ , Big+ , Blaze hs-source-dirs: bench ghc-options: -Wall -O2 default-language: Haskell2010@@ -57,3 +61,4 @@ , bytestring , blaze-html , criterion+ , QuickCheck