type-of-html 1.3.3.1 → 1.3.3.2
raw patch · 7 files changed
+386/−320 lines, 7 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- bench/Alloc.hs +29/−29
- src/Html.hs +1/−1
- test/Main.hs +0/−287
- test/Type.hs +51/−0
- test/Value.hs +287/−0
- type-of-html.cabal +14/−3
ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for type-of-html +## 1.3.3.2 -- 2018-03-25++* reduce allocations for smaller pages+ ## 1.3.3.0 -- 2018-02-07 * fix the 'input' element
bench/Alloc.hs view
@@ -30,32 +30,32 @@ -- nixpkgs: 1b27260 -- ghc: 8.4.1 - f "()" 4256 renderByteString ()- f "Int" 4328 renderByteString (123456789 :: Int)- f "Word" 4328 renderByteString (123456789 :: Word)- f "Char" 4344 renderByteString 'a'- f "Integer" 4360 renderByteString (123456789 :: Integer)- f "Proxy" 4392 renderByteString (Proxy :: Proxy "a")- f "oneElement Proxy" 4392 (renderByteString . S.oneElement) (Proxy :: Proxy "b")- f "oneElement ()" 4392 (renderByteString . S.oneElement) ()- f "oneAttribute ()" 4392 (renderByteString . A.class_) ()- f "oneAttribute Proxy" 4392 (renderByteString . A.class_) (Proxy :: Proxy "c")- f "listElement" 4488 (renderByteString . S.listElement) ()- f "Double" 4472 renderByteString (123456789 :: Double)- f "oneElement" 4480 (renderByteString . S.oneElement) ""- f "nestedElement" 4480 (renderByteString . S.nestedElement) ""- f "listOfAttributes" 4464 (\x -> renderByteString [A.class_ x, A.class_ x]) ()- f "Float" 4512 renderByteString (123456789 :: Float)- f "oneAttribute" 4520 (renderByteString . A.class_) ""- f "parallelElement" 4632 (renderByteString . S.parallelElement) ""- f "parallelAttribute" 4696 (\x -> renderByteString $ A.class_ x # A.id_ x) ""- f "elementWithAttribute" 4696 (\x -> renderByteString $ div_A (A.class_ x) x) ""- f "listOfListOf" 4744 (\x -> renderByteString $ div_ [i_ [span_ x]]) ()- f "helloWorld" 5344 (renderByteString . M.helloWorld) ()- f "page" 5624 (renderByteString . M.page) ()- f "table" 5776 (renderByteString . M.table) (2,2)- f "AttrShort" 6720 (renderByteString . M.attrShort) ()- f "pageA" 7072 (renderByteString . M.pageA) ()- f "AttrLong" 7272 (renderByteString . M.attrLong) ()- f "Big table" 19712 (renderByteString . M.table) (15,15)- f "Big page" 24704 (renderByteString . B.page) ()+ f "()" 144 renderByteString ()+ f "Int" 216 renderByteString (123456789 :: Int)+ f "Word" 216 renderByteString (123456789 :: Word)+ f "Char" 232 renderByteString 'a'+ f "Integer" 248 renderByteString (123456789 :: Integer)+ f "Proxy" 280 renderByteString (Proxy :: Proxy "a")+ f "oneElement Proxy" 280 (renderByteString . S.oneElement) (Proxy :: Proxy "b")+ f "oneElement ()" 280 (renderByteString . S.oneElement) ()+ f "oneAttribute ()" 280 (renderByteString . A.class_) ()+ f "oneAttribute Proxy" 280 (renderByteString . A.class_) (Proxy :: Proxy "c")+ f "listElement" 376 (renderByteString . S.listElement) ()+ f "Double" 360 renderByteString (123456789 :: Double)+ f "oneElement" 368 (renderByteString . S.oneElement) ""+ f "nestedElement" 368 (renderByteString . S.nestedElement) ""+ f "listOfAttributes" 352 (\x -> renderByteString [A.class_ x, A.class_ x]) ()+ f "Float" 400 renderByteString (123456789 :: Float)+ f "oneAttribute" 408 (renderByteString . A.class_) ""+ f "parallelElement" 520 (renderByteString . S.parallelElement) ""+ f "parallelAttribute" 584 (\x -> renderByteString $ A.class_ x # A.id_ x) ""+ f "elementWithAttribute" 584 (\x -> renderByteString $ div_A (A.class_ x) x) ""+ f "listOfListOf" 632 (\x -> renderByteString $ div_ [i_ [span_ x]]) ()+ f "helloWorld" 1232 (renderByteString . M.helloWorld) ()+ f "page" 1512 (renderByteString . M.page) ()+ f "table" 1664 (renderByteString . M.table) (2,2)+ f "AttrShort" 2608 (renderByteString . M.attrShort) ()+ f "pageA" 2960 (renderByteString . M.pageA) ()+ f "AttrLong" 3160 (renderByteString . M.attrLong) ()+ f "Big table" 19968 (renderByteString . M.table) (15,15)+ f "Big page" 25064 (renderByteString . B.page) ()
src/Html.hs view
@@ -53,8 +53,8 @@ renderByteString :: Document a => a -> B.ByteString renderByteString = BE.toLazyByteStringWith ( BE.untrimmedStrategy+ 1024 BE.smallChunkSize- BE.defaultChunkSize ) B.empty . renderBuilder -- | Orphan show instance to faciliate ghci development.
− test/Main.hs
@@ -1,287 +0,0 @@-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-}--module Main where--import Html--import qualified Html.Attribute as A--import Data.Proxy-import Test.Hspec-import Test.QuickCheck--main :: IO ()-main = hspec spec--spec :: Spec-spec = parallel $ do-- describe "render" $ do-- it "is id on strings without escaping" $ do-- property $ \x ->- renderString (Raw x)- ===- x-- it "handles single elements" $ do-- property $ \x ->- renderString (div_ (Raw x))- ===- "<div>" ++ x ++ "</div>"-- it "handles nested elements" $ do-- property $ \x ->- renderString (div_ (div_ (Raw x)))- ===- "<div><div>" ++ x ++ "</div></div>"-- it "handles parallel elements" $ do-- 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-- renderString area_- `shouldBe`- "<area>"-- renderString base_- `shouldBe`- "<base>"-- renderString br_- `shouldBe`- "<br>"-- renderString col_- `shouldBe`- "<col>"-- renderString embed_- `shouldBe`- "<embed>"-- renderString hr_- `shouldBe`- "<hr>"-- renderString iframe_- `shouldBe`- "<iframe>"-- renderString img_- `shouldBe`- "<img>"-- renderString link_- `shouldBe`- "<link>"-- renderString menuitem_- `shouldBe`- "<menuitem>"-- renderString meta_- `shouldBe`- "<meta>"-- renderString param_- `shouldBe`- "<param>"-- renderString source_- `shouldBe`- "<source>"-- renderString track_- `shouldBe`- "<track>"-- renderString wbr_- `shouldBe`- "<wbr>"-- it "handles trailing text" $ do-- property $ \x y ->- renderString (td_ (Raw x) # (Raw y))- ===- "<td>" ++ x ++ "</td>" ++ y-- it "handles a single compile time text" $ do-- renderString (Proxy :: Proxy "a")- `shouldBe`- "a"-- it "handles trailing compile time text" $ do-- renderString (div_ "a" # (Proxy :: Proxy "b"))- `shouldBe`- "<div>a</div>b"-- it "handles nested compile time text" $ do-- renderString (div_ (Proxy :: Proxy "a"))- `shouldBe`- "<div>a</div>"-- it "handles an empty list" $ do-- renderString (tail [td_ "a"])- `shouldBe`- ""-- it "handles a list with a single element" $ do-- renderString [td_ "a"]- `shouldBe`- "<td>a</td>"-- it "handles tags in a list with parallel elements" $ do-- renderString [div_ "a" # i_ "b"]- `shouldBe`- "<div>a</div><i>b</i>"-- it "handles nested lists" $ do-- renderString (div_ [div_ [div_ (4 :: Int)]])- `shouldBe`- "<div><div><div>4</div></div></div>"-- it "handles utf8 correctly" $ do-- renderString (div_ "a ä € 𝄞")- `shouldBe`- "<div>a ä € 𝄞</div>"-- 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 maybes" $ do-- renderString (div_ (Just (div_ "a")))- `shouldBe`- "<div><div>a</div></div>"-- renderString (Just (42 :: Int))- `shouldBe`- "42"-- renderString (div_A (Just (A.id_ "a")) "b")- `shouldBe`- "<div id=\"a\">b</div>"-- renderString (div_ (if True then Nothing else Just (div_ "a")))- `shouldBe`- "<div></div>"-- it "handles eithers" $ do-- renderString (div_ (if True then Left (div_ "a") else Right "b"))- `shouldBe`- "<div><div>a</div></div>"-- renderString (div_A (if True then Right (A.id_ "a") else Left (A.class_ "a")) "b")- `shouldBe`- "<div id=\"a\">b</div>"-- it "handles attributes" $ do-- renderString (div_A (A.id_ "a") "b" # "c")- `shouldBe`- "<div id=\"a\">b</div>c"-- renderString (div_A (A.id_ ()) "a")- `shouldBe`- "<div id=\"\">a</div>"-- renderString (div_A A.hidden_ "a")- `shouldBe`- "<div hidden=\"\">a</div>"-- renderString (div_A A.hidden_ ())- `shouldBe`- "<div hidden=\"\"></div>"-- renderString (div_A A.hidden_ () # "a")- `shouldBe`- "<div hidden=\"\"></div>a"-- renderString (div_A A.hidden_ () # img_)- `shouldBe`- "<div hidden=\"\"></div><img>"-- it "handles Ints" $ do-- property $ \x ->- renderString (div_ (x :: Int))- ===- renderString (div_ (show x))-- it "handles complex compile time documents" $ do-- renderString (div_ () # i_ ())- `shouldBe`- "<div></div><i></i>"-- renderString (div_ () # "a")- `shouldBe`- "<div></div>a"-- renderString ("a" # i_ ())- `shouldBe`- "a<i></i>"-- renderString (div_ () # i_ (Proxy @"a"))- `shouldBe`- "<div></div><i>a</i>"-- renderString (div_ (Proxy @"a") # i_ ())- `shouldBe`- "<div>a</div><i></i>"-- renderString (Proxy @"1" # "2")- `shouldBe`- "12"-- renderString ("1" # Proxy @"2")- `shouldBe`- "12"-- 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>"-- it "handles list of convertibles" $ do-- renderString (div_ [1..5 :: Int])- `shouldBe`- "<div>12345</div>"-- renderString [1..5 :: Int]- `shouldBe`- "12345"-- renderString (div_ ["abc"])- `shouldBe`- "<div>abc</div>"
+ test/Type.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE CPP #-}++module Main where++#if __GLASGOW_HASKELL__ >= 802+import GHC.TypeLits+import Html.Type.Internal+import Data.Proxy++main :: IO ()+main = pure ()++ where _x_ = undefined :: Test++type Test =+ ( ToList ()+ == Empty+ , ToList Int+ == Split+ , ToList (Proxy "a")+ == 'FingerTree '[] "a"+ , ToList ('A > Char)+ == 'FingerTree '["<a>"] "</a>"+ , ToList ('A > Char # 'Div > Int)+ == 'FingerTree '["<a>", "</a><div>"] "</div>"+ , ToList (('Div :@: ('ClassA := Int)) Int)+ == 'FingerTree '["<div class=\"","\">"] "</div>"+ , ToList (('Div :@: ('ClassA := ())) Int)+ == 'FingerTree '["<div class=\"\">"] "</div>"+ , ToList (('Div :@: ('ClassA := ())) ())+ == 'FingerTree '[] "<div class=\"\"></div>"+ , ToList (('Div :@: ('ClassA := () # 'IdA := ())) ())+ == 'FingerTree '[] "<div class=\"\" id=\"\"></div>"+ , ToList (('Div :@: ('ClassA := () # 'IdA := Proxy "ab")) ())+ == 'FingerTree '[] "<div class=\"\" id=\"ab\"></div>"+ )++type family a == b where+ a == a = ()+ a == b = TypeError ('Text "Unequal types:" ':$$: 'ShowType a ':$$: 'ShowType b)++#else+main :: IO ()+main = pure ()+#endif
+ test/Value.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}++module Main where++import Html++import qualified Html.Attribute as A++import Data.Proxy+import Test.Hspec+import Test.QuickCheck++main :: IO ()+main = hspec spec++spec :: Spec+spec = parallel $ do++ describe "render" $ do++ it "is id on strings without escaping" $ do++ property $ \x ->+ renderString (Raw x)+ ===+ x++ it "handles single elements" $ do++ property $ \x ->+ renderString (div_ (Raw x))+ ===+ "<div>" ++ x ++ "</div>"++ it "handles nested elements" $ do++ property $ \x ->+ renderString (div_ (div_ (Raw x)))+ ===+ "<div><div>" ++ x ++ "</div></div>"++ it "handles parallel elements" $ do++ 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++ renderString area_+ `shouldBe`+ "<area>"++ renderString base_+ `shouldBe`+ "<base>"++ renderString br_+ `shouldBe`+ "<br>"++ renderString col_+ `shouldBe`+ "<col>"++ renderString embed_+ `shouldBe`+ "<embed>"++ renderString hr_+ `shouldBe`+ "<hr>"++ renderString iframe_+ `shouldBe`+ "<iframe>"++ renderString img_+ `shouldBe`+ "<img>"++ renderString link_+ `shouldBe`+ "<link>"++ renderString menuitem_+ `shouldBe`+ "<menuitem>"++ renderString meta_+ `shouldBe`+ "<meta>"++ renderString param_+ `shouldBe`+ "<param>"++ renderString source_+ `shouldBe`+ "<source>"++ renderString track_+ `shouldBe`+ "<track>"++ renderString wbr_+ `shouldBe`+ "<wbr>"++ it "handles trailing text" $ do++ property $ \x y ->+ renderString (td_ (Raw x) # (Raw y))+ ===+ "<td>" ++ x ++ "</td>" ++ y++ it "handles a single compile time text" $ do++ renderString (Proxy :: Proxy "a")+ `shouldBe`+ "a"++ it "handles trailing compile time text" $ do++ renderString (div_ "a" # (Proxy :: Proxy "b"))+ `shouldBe`+ "<div>a</div>b"++ it "handles nested compile time text" $ do++ renderString (div_ (Proxy :: Proxy "a"))+ `shouldBe`+ "<div>a</div>"++ it "handles an empty list" $ do++ renderString (tail [td_ "a"])+ `shouldBe`+ ""++ it "handles a list with a single element" $ do++ renderString [td_ "a"]+ `shouldBe`+ "<td>a</td>"++ it "handles tags in a list with parallel elements" $ do++ renderString [div_ "a" # i_ "b"]+ `shouldBe`+ "<div>a</div><i>b</i>"++ it "handles nested lists" $ do++ renderString (div_ [div_ [div_ (4 :: Int)]])+ `shouldBe`+ "<div><div><div>4</div></div></div>"++ it "handles utf8 correctly" $ do++ renderString (div_ "a ä € 𝄞")+ `shouldBe`+ "<div>a ä € 𝄞</div>"++ 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 maybes" $ do++ renderString (div_ (Just (div_ "a")))+ `shouldBe`+ "<div><div>a</div></div>"++ renderString (Just (42 :: Int))+ `shouldBe`+ "42"++ renderString (div_A (Just (A.id_ "a")) "b")+ `shouldBe`+ "<div id=\"a\">b</div>"++ renderString (div_ (if True then Nothing else Just (div_ "a")))+ `shouldBe`+ "<div></div>"++ it "handles eithers" $ do++ renderString (div_ (if True then Left (div_ "a") else Right "b"))+ `shouldBe`+ "<div><div>a</div></div>"++ renderString (div_A (if True then Right (A.id_ "a") else Left (A.class_ "a")) "b")+ `shouldBe`+ "<div id=\"a\">b</div>"++ it "handles attributes" $ do++ renderString (div_A (A.id_ "a") "b" # "c")+ `shouldBe`+ "<div id=\"a\">b</div>c"++ renderString (div_A (A.id_ ()) "a")+ `shouldBe`+ "<div id=\"\">a</div>"++ renderString (div_A A.hidden_ "a")+ `shouldBe`+ "<div hidden=\"\">a</div>"++ renderString (div_A A.hidden_ ())+ `shouldBe`+ "<div hidden=\"\"></div>"++ renderString (div_A A.hidden_ () # "a")+ `shouldBe`+ "<div hidden=\"\"></div>a"++ renderString (div_A A.hidden_ () # img_)+ `shouldBe`+ "<div hidden=\"\"></div><img>"++ it "handles Ints" $ do++ property $ \x ->+ renderString (div_ (x :: Int))+ ===+ renderString (div_ (show x))++ it "handles complex compile time documents" $ do++ renderString (div_ () # i_ ())+ `shouldBe`+ "<div></div><i></i>"++ renderString (div_ () # "a")+ `shouldBe`+ "<div></div>a"++ renderString ("a" # i_ ())+ `shouldBe`+ "a<i></i>"++ renderString (div_ () # i_ (Proxy @"a"))+ `shouldBe`+ "<div></div><i>a</i>"++ renderString (div_ (Proxy @"a") # i_ ())+ `shouldBe`+ "<div>a</div><i></i>"++ renderString (Proxy @"1" # "2")+ `shouldBe`+ "12"++ renderString ("1" # Proxy @"2")+ `shouldBe`+ "12"++ 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>"++ it "handles list of convertibles" $ do++ renderString (div_ [1..5 :: Int])+ `shouldBe`+ "<div>12345</div>"++ renderString [1..5 :: Int]+ `shouldBe`+ "12345"++ renderString (div_ ["abc"])+ `shouldBe`+ "<div>abc</div>"
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 1.3.3.1+version: 1.3.3.2 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@@ -38,9 +38,9 @@ , ghc-prim , double-conversion -test-suite test+test-suite value type: exitcode-stdio-1.0- main-is: Main.hs+ main-is: Value.hs hs-source-dirs: test ghc-options: -Wall -O0 default-language: Haskell2010@@ -48,6 +48,17 @@ , type-of-html , QuickCheck , hspec++test-suite type+ type: exitcode-stdio-1.0+ main-is: Type.hs+ hs-source-dirs: test+ , src+ other-modules: Html.CPP+ , Html.Type.Internal+ ghc-options: -Wall+ default-language: Haskell2010+ build-depends: base >= 4.9 && < 5 benchmark alloc type: exitcode-stdio-1.0