type-of-html 1.2.0.0 → 1.3.0.0

raw patch · 10 files changed

+284/−256 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Readme.md +30/−38
• bench/Medium.hs +11/−17
• src/Html.hs +32/−4
• src/Html/Attribute.hs +18/−18
• src/Html/Convert.hs +43/−63
• src/Html/Reify.hs +87/−92
• src/Html/Type/Internal.hs +27/−23
• test/Main.hs +28/−0
• type-of-html.cabal +1/−1

@@ -1,5 +1,12 @@ # Revision history for type-of-html +## 1.3.0.0  -- 2017-12-12++* add Either+* add Maybe+* internal refactor+* cleaner api of the Convert class+ ## 1.2.0.0  -- 2017-11-28  * remove argument from boolean attributes

@@ -135,6 +135,30 @@ <i></i><script></script><i></i> ``` +## Controlflow++You can use Either and Maybe in your documents:++```haskell+>>> div_ (Just (div_ "a"))+<div><div>a</div></div>++>>> div_ (if True then Nothing else div_ "b")+<div></div>++>>> div_ (if True then Left (div_ "a") else Right "b")+<div><div>a</div></div>++>>> div_A (if True then Right (A.id_ "a") else Left (A.class_ "a")) "b"+<div id="a">b</div>+```++If you use Either, both possible outcomes are typechecked if they are valid children.++You can combine Either, Maybe and Lists in any way you want.  The+types will get jolly complicated, but if you don't write the types,+you'll be good.+ ## Performance  `type-of-html` is a lot faster than `blaze-html` or than `lucid`.@@ -243,7 +267,7 @@ don't need to escape.  ```haskell-div_ (Raw "a")+div_ (Raw "abc") ```  If you've got numeric attributes or contents, don't convert it to a@@ -294,7 +318,7 @@ - a bit noisy syntax (don't write types!) - sometimes unusual type error messages - compile times (30sec for a medium sized page, with `-O0` only ~2sec)-- needs at least ghc 8.2+- needs at least ghc 8  I'd generally recommend that you put your documents into an extra module to avoid frequent recompilations.  Additionally you can use@@ -382,44 +406,12 @@ ```html <div   ><div-    >Hello World!<-  /div><-/div>-```--Or--```html-<-div-  ><-  div-    >Hello World!<-  /div-  ><-/div->-```--Or--```html-<-div        ><-  div      >Hello <-    i      >World!<-    /i     ><-  /div     ><-/div+    >Hello World!</div+  ></div > ``` ---These styles would be semantically correct, but would they be pretty?-Personally, I think the third style is quite interesting, it seperates-structure from content with a table layout and indicates explicitly-the lack of content.+This would be semantically correct, but would this be pretty?  I recommend, that if you want to debug html, use mozilla fire bug, so you can as well fold trees and look at the rendering.@@ -453,4 +445,4 @@ At the moment, string literals are handled well, but not optimal.  The escaping of string literals is done everytime when rendering the html document, ideally we convince GHC to float the escaped string literal-to top level.  I guess, that would make things a lot faster.+to top level.  I guess, that would make things a bit faster.

@@ -156,14 +156,13 @@   . i_A (A.contextmenu_     "d")   . i_A (A.dir_             "e")   . i_A (A.draggable_       "f")-  . i_A (A.hidden_          "g")+  . 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.tabindex_        "m")-  . i_A (A.title_           "n")+  . i_A (A.title_           "m")   $ x  attrShort'@@ -173,14 +172,13 @@   . i_A (A.contextmenu_     "d")   . i_A (A.dir_             "e")   . i_A (A.draggable_       "f")-  . i_A (A.hidden_          "g")+  . 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.tabindex_        "m")-  . i_A (A.title_           "n")+  . i_A (A.title_           "m")  attrShort''   = \x ->@@ -190,14 +188,13 @@   . i_A (A.contextmenu_     "d")   . i_A (A.dir_             "e")   . i_A (A.draggable_       "f")-  . i_A (A.hidden_          "g")+  . 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.tabindex_        "m")-  . i_A (A.title_           "n")+  . i_A (A.title_           "m")   $ x  attrLong x =@@ -207,13 +204,12 @@       # A.contextmenu_     "d"       # A.dir_             "e"       # A.draggable_       "f"-      # A.hidden_          "g"+      # A.hidden_       # A.id_              "h"       # A.itemprop_        "i"       # A.lang_            "j"       # A.spellcheck_      "k"       # A.style_           "l"-      # A.tabindex_        "m"       # A.title_           "n"       ) x @@ -224,14 +220,13 @@       # A.contextmenu_     "d"       # A.dir_             "e"       # A.draggable_       "f"-      # A.hidden_          "g"+      # A.hidden_       # A.id_              "h"       # A.itemprop_        "i"       # A.lang_            "j"       # A.spellcheck_      "k"       # A.style_           "l"-      # A.tabindex_        "m"-      # A.title_           "n"+      # A.title_           "m"       )  attrLong'' = \x ->@@ -241,14 +236,13 @@       # A.contextmenu_     "d"       # A.dir_             "e"       # A.draggable_       "f"-      # A.hidden_          "g"+      # A.hidden_       # A.id_              "h"       # A.itemprop_        "i"       # A.lang_            "j"       # A.spellcheck_      "k"       # A.style_           "l"-      # A.tabindex_        "m"-      # A.title_           "n"+      # A.title_           "m"       ) x  pageA x =

@@ -2,7 +2,8 @@  {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE MonoLocalBinds       #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE ConstraintKinds      #-} {-# LANGUAGE TypeOperators        #-}  module Html@@ -17,12 +18,39 @@   ) where  import Html.Reify- import Html.Convert- import Html.Element- import Html.Type+import Html.Type.Internal++import qualified Data.ByteString.Lazy    as B+import qualified Data.ByteString.Builder as B+import qualified Data.Text.Lazy          as T+import qualified Data.Text.Lazy.Encoding as T++-- | Constraint synonym of html documents.+type Document  a = Document' a+type Document' a = R (T (ToList a) a)++-- | Render a html document to a Builder.+{-# INLINE renderBuilder #-}+renderBuilder :: Document a => a -> B.Builder+renderBuilder = unConv . render . (T :: a -> T (ToList a) a)++-- | Render a html document to a String.+{-# INLINE renderString #-}+renderString :: Document a => a -> String+renderString = T.unpack . renderText++-- | Render a html document to a lazy Text.+{-# INLINE renderText #-}+renderText :: Document a => a -> T.Text+renderText = T.decodeUtf8 . renderByteString++-- | Render a html document to a lazy ByteString.+{-# INLINE renderByteString #-}+renderByteString :: Document a => a -> B.ByteString+renderByteString = B.toLazyByteString . renderBuilder  -- | Orphan show instances to faciliate ghci development. instance                     Document ((a :@: b) c) => Show ((a :@: b) c) where show = renderString

@@ -77,10 +77,10 @@ color_ :: a -> 'ColorA := a color_ = AT -cols_ :: a -> 'ColsA := a+cols_ :: Integral a => a -> 'ColsA := a cols_ = AT -colspan_ :: a -> 'ColspanA := a+colspan_ :: Integral a => a -> 'ColspanA := a colspan_ = AT  content_ :: a -> 'ContentA := a@@ -158,13 +158,13 @@ headers_ :: a -> 'HeadersA := a headers_ = AT -height_ :: a -> 'HeightA := a+height_ :: Integral a => a -> 'HeightA := a height_ = AT  hidden_ :: 'HiddenA := () hidden_ = AT () -high_ :: a -> 'HighA := a+high_ :: Num a => a -> 'HighA := a high_ = AT  href_ :: a -> 'HrefA := a@@ -215,28 +215,28 @@ loop_ :: 'LoopA := () loop_ = AT () -low_ :: a -> 'LowA := a+low_ :: Num a => a -> 'LowA := a low_ = AT  manifest_ :: a -> 'ManifestA := a manifest_ = AT -max_ :: a -> 'MaxA := a+max_ :: Num a => a -> 'MaxA := a max_ = AT -maxlength_ :: a -> 'MaxlengthA := a+maxlength_ :: Integral a => a -> 'MaxlengthA := a maxlength_ = AT  minlength_ :: a -> 'MinlengthA := a minlength_ = AT -media_ :: a -> 'MediaA := a+media_ :: Integral a => a -> 'MediaA := a media_ = AT  method_ :: a -> 'MethodA := a method_ = AT -min_ :: a -> 'MinA := a+min_ :: Num a => a -> 'MinA := a min_ = AT  multiple_ :: 'MultipleA := ()@@ -257,7 +257,7 @@ open_ :: 'OpenA := () open_ = AT () -optimum_ :: a -> 'OptimumA := a+optimum_ :: Num a => a -> 'OptimumA := a optimum_ = AT  pattern_ :: a -> 'PatternA := a@@ -296,10 +296,10 @@ reversed_ :: 'ReversedA := () reversed_ = AT () -rows_ :: a -> 'RowsA := a+rows_ :: Integral a => a -> 'RowsA := a rows_ = AT -rowspan_ :: a -> 'RowspanA := a+rowspan_ :: Integral a => a -> 'RowspanA := a rowspan_ = AT  sandbox_ :: a -> 'SandboxA := a@@ -320,7 +320,7 @@ shape_ :: a -> 'ShapeA := a shape_ = AT -size_ :: a -> 'SizeA := a+size_ :: Integral a => a -> 'SizeA := a size_ = AT  sizes_ :: a -> 'SizesA := a@@ -329,7 +329,7 @@ slot_ :: a -> 'SlotA := a slot_ = AT -span_ :: a -> 'SpanA := a+span_ :: Integral a => a -> 'SpanA := a span_ = AT  spellcheck_ :: a -> 'SpellcheckA := a@@ -347,10 +347,10 @@ srcset_ :: a -> 'SrcsetA := a srcset_ = AT -start_ :: a -> 'StartA := a+start_ :: Integral a => a -> 'StartA := a start_ = AT -step_ :: a -> 'StepA := a+step_ :: Num a => a -> 'StepA := a step_ = AT  style_ :: a -> 'StyleA := a@@ -359,7 +359,7 @@ summary_ :: a -> 'SummaryA := a summary_ = AT -tabindex_ :: a -> 'TabindexA := a+tabindex_ :: Integral a => a -> 'TabindexA := a tabindex_ = AT  target_ :: a -> 'TargetA := a@@ -383,7 +383,7 @@ value_ :: a -> 'ValueA := a value_ = AT -width_ :: a -> 'WidthA := a+width_ :: Integral a => a -> 'WidthA := a width_ = AT  wrap_ :: a -> 'WrapA := a

@@ -1,12 +1,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE FlexibleInstances          #-}-{-# LANGUAGE FlexibleContexts           #-}-{-# LANGUAGE KindSignatures             #-}-{-# LANGUAGE TypeOperators              #-} {-# LANGUAGE BangPatterns               #-} {-# LANGUAGE MagicHash                  #-}-{-# LANGUAGE DataKinds                  #-}  module Html.Convert   ( Converted(..)@@ -20,6 +15,7 @@ import Data.String import Data.Char (ord) import Data.Double.Conversion.ByteString+import Numeric.Natural import GHC.TypeLits import GHC.Types import GHC.Prim (Addr#, ord#, indexCharOffAddr#)@@ -35,48 +31,8 @@ import qualified Data.Text.Lazy                   as TL import qualified Data.Text.Lazy.Encoding          as TL -escapeUtf8 :: BP.BoundedPrim Char-escapeUtf8 =-    BP.condB (>  '>' ) BP.charUtf8 $-    BP.condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $-    BP.condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $-    BP.condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $-    BP.condB (== '"' ) (fixed5 ('&',('#',('3',('4',';'))))) $-    BP.condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $-    BP.liftFixedToBounded BP.char7-  where-    {-# INLINE fixed4 #-}-    fixed4 x = BP.liftFixedToBounded $ const x BP.>$<-      BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7--    {-# INLINE fixed5 #-}-    fixed5 x = BP.liftFixedToBounded $ const x BP.>$<-      BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7--escape :: BP.BoundedPrim Word8-escape =-    BP.condB (>  c2w '>' ) (BP.liftFixedToBounded BP.word8) $-    BP.condB (== c2w '<' ) (fixed4 (c2w '&',(c2w 'l',(c2w 't',c2w ';')))) $-    BP.condB (== c2w '>' ) (fixed4 (c2w '&',(c2w 'g',(c2w 't',c2w ';')))) $-    BP.condB (== c2w '&' ) (fixed5 (c2w '&',(c2w 'a',(c2w 'm',(c2w 'p',c2w ';'))))) $-    BP.condB (== c2w '"' ) (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '4',c2w ';'))))) $-    BP.condB (== c2w '\'') (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '9',c2w ';'))))) $-    BP.liftFixedToBounded BP.word8-  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- newtype Converted = Converted {unConv :: B.Builder} deriving (M.Monoid,S.Semigroup)--instance IsString Converted where-  fromString = convert+instance IsString Converted where fromString = convert  {-| Convert a type efficienctly to different string like types.  Add   instances if you want use custom types in your document.@@ -122,9 +78,6 @@ instance Convert () where   {-# INLINE convert #-}   convert _ = mempty-instance Convert b => Convert (a := b) where-  {-# INLINE convert #-}-  convert (AT x) = convert x instance Convert (Raw Char) where   {-# INLINE convert #-}   convert (Raw c) = Converted (B.charUtf8 c)@@ -158,6 +111,9 @@ instance Convert Integer where   {-# INLINE convert #-}   convert = Converted . B.integerDec+instance Convert Natural where+  {-# INLINE convert #-}+  convert = Converted . B.integerDec . fromIntegral instance Convert Float where   {-# INLINE convert #-}   convert = Converted . U.byteStringCopy . toShortest . realToFrac@@ -170,21 +126,7 @@ instance KnownSymbol a => Convert (Proxy a) where   {-# INLINE convert #-}   convert = Converted . U.byteStringCopy . fromString . symbolVal-instance ConcatSymbol xs => Convert (Proxy (xs :: [Symbol])) where-  {-# INLINE convert #-}-  convert = Converted . U.byteStringCopy . fromString . concatSymbol -class ConcatSymbol (xs :: [Symbol]) where-  concatSymbol :: Proxy xs -> String--instance (KnownSymbol x, ConcatSymbol xs) => ConcatSymbol (x ': xs) where-  {-# INLINE concatSymbol #-}-  concatSymbol _ = symbolVal (Proxy :: Proxy x) ++ concatSymbol (Proxy :: Proxy xs)--instance ConcatSymbol '[] where-  {-# INLINE concatSymbol #-}-  concatSymbol _ = mempty- {-# INLINE builderCString# #-} builderCString# :: BP.BoundedPrim Word8 -> Addr# -> Converted builderCString# bp addr = Converted $ BP.primUnfoldrBounded bp go 0@@ -202,6 +144,44 @@ {-# INLINE [0] stringConvRaw #-} stringConvRaw :: String -> Converted stringConvRaw = Converted . B.stringUtf8++escapeUtf8 :: BP.BoundedPrim Char+escapeUtf8 =+    BP.condB (>  '>' ) BP.charUtf8 $+    BP.condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $+    BP.condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $+    BP.condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $+    BP.condB (== '"' ) (fixed5 ('&',('#',('3',('4',';'))))) $+    BP.condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $+    BP.liftFixedToBounded BP.char7+  where+    {-# INLINE fixed4 #-}+    fixed4 x = BP.liftFixedToBounded $ const x BP.>$<+      BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7++    {-# INLINE fixed5 #-}+    fixed5 x = BP.liftFixedToBounded $ const x BP.>$<+      BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7++escape :: BP.BoundedPrim Word8+escape =+    BP.condB (>  c2w '>' ) (BP.liftFixedToBounded BP.word8) $+    BP.condB (== c2w '<' ) (fixed4 (c2w '&',(c2w 'l',(c2w 't',c2w ';')))) $+    BP.condB (== c2w '>' ) (fixed4 (c2w '&',(c2w 'g',(c2w 't',c2w ';')))) $+    BP.condB (== c2w '&' ) (fixed5 (c2w '&',(c2w 'a',(c2w 'm',(c2w 'p',c2w ';'))))) $+    BP.condB (== c2w '"' ) (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '4',c2w ';'))))) $+    BP.condB (== c2w '\'') (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '9',c2w ';'))))) $+    BP.liftFixedToBounded BP.word8+  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  {-# RULES "CONVERTED literal" forall a.     stringConv (unpackCString# a)

@@ -1,10 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE FlexibleContexts     #-} {-# LANGUAGE TypeApplications     #-}-{-# LANGUAGE ConstraintKinds      #-}-{-# LANGUAGE MonoLocalBinds       #-} {-# LANGUAGE TypeOperators        #-} {-# LANGUAGE DataKinds            #-} {-# LANGUAGE PolyKinds            #-}@@ -19,111 +16,109 @@ import Data.Proxy import Data.Semigroup ((<>)) -import qualified Data.Text.Lazy          as T-import qualified Data.Text.Lazy.Encoding as T-import qualified Data.ByteString.Lazy    as B-import qualified Data.ByteString.Builder as B---- | Render a html document to a Builder.-{-# INLINE renderBuilder #-}-renderBuilder :: Document a => a -> B.Builder-renderBuilder = renderchunks . tag--{-# INLINE tag #-}-tag :: a -> Tagged (ToTypeList a) a-tag = Tagged---- | Render a html document to a String.-{-# INLINE renderString #-}-renderString :: Document a => a -> String-renderString = T.unpack . renderText---- | Render a html document to a lazy Text.-{-# INLINE renderText #-}-renderText :: Document a => a -> T.Text-renderText = T.decodeUtf8 . renderByteString---- | Render a html document to a lazy ByteString.-{-# INLINE renderByteString #-}-renderByteString :: Document a => a -> B.ByteString-renderByteString = B.toLazyByteString . renderBuilder---- | Constraint synonym of html documents.-type Document a = Document' a+class R a where+  render :: a -> Converted -type Document' a = Renderchunks (Tagged (ToTypeList a) a)+instance+  KnownSymbol s+  => R (Proxy (s :: Symbol)) where+  {-# INLINE render #-}+  render = convert -class Renderchunks a where-  renderchunks :: a -> B.Builder+instance+  R (Proxy ('[] :: [Symbol])) where+  {-# INLINE render #-}+  render _ = mempty -instance KnownSymbol a => Renderchunks (Tagged (prox :: [k]) (Proxy a)) where-  {-# INLINE renderchunks #-}-  renderchunks _ = mempty+instance+  ( KnownSymbol x, R (Proxy xs)+  ) => R (Proxy ((x ': xs) :: [Symbol])) where+  {-# INLINE render #-}+  render _ = convert (Proxy @ x) <> render (Proxy @ xs) -instance Renderchunks (Tagged prox ()) where-  {-# INLINE renderchunks #-}-  renderchunks _ = mempty+instance {-# INCOHERENT #-}+  R (T '[] val) where+  {-# INLINE render #-}+  render _ = mempty  instance {-# INCOHERENT #-}   ( Convert val-  ) => Renderchunks (Tagged '[ EmptySym ] val) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged x)-    = unConv (convert x)+  ) => R (T '[ EmptySym ] val) where+  {-# INLINE render #-}+  render (T x) = convert x -instance {-# INCOHERENT #-}-  Renderchunks (Tagged '[] val) where-  {-# INLINE renderchunks #-}-  renderchunks _ = mempty+instance+  ( Convert b+  , R (Proxy s)+  ) => R (T '[s] (a := b)) where+  {-# INLINE render #-}+  render (T (AT x)) = render (Proxy @ s) <> convert x  instance {-# INCOHERENT #-}   ( Convert val-  , Convert (Proxy s)-  ) => Renderchunks (Tagged '[s] val) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged x)-    = unConv (convert (Proxy @ s))-    <> unConv (convert x)+  , R (Proxy s)+  ) => R (T '[s] val) where+  {-# INLINE render #-}+  render (T x) = render (Proxy @ s) <> convert x -instance {-# INCOHERENT #-}-  ( Renderchunks (Tagged xs val)-  ) => Renderchunks (Tagged (NoTail xs) val) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged t)-    = renderchunks (Tagged t :: Tagged xs val)+instance {-# OVERLAPPING #-}+  ( R (T xs val)+  ) => R (T (NoTail xs) val) where+  {-# INLINE render #-}+  render (T t) = render (T t :: T xs val) -instance {-# INCOHERENT #-}-  ( Renderchunks (Tagged xs val)-  , Convert (Proxy x)-  ) => Renderchunks (Tagged ('FingerTree xs x) val) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged t)-    = renderchunks (Tagged t :: Tagged xs val)-    <> unConv (convert (Proxy @ x))+instance+  ( R (T xs val)+  , R (Proxy x)+  ) => R (T ('FingerTree xs x) val) where+  {-# INLINE render #-}+  render (T t) = render (T t :: T xs val) <> render (Proxy @ x)  instance-  ( Renderchunks (Tagged (Take (CountContent b) prox) b)-  , Renderchunks (Tagged (Drop (CountContent b) prox) c)-  ) => Renderchunks (Tagged prox ((a :@: b) c)) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged ~(WithAttributes b c))-    = renderchunks (Tagged b :: Tagged (Take (CountContent b) prox) b)-   <> renderchunks (Tagged c :: Tagged (Drop (CountContent b) prox) c)+  ( R (T (Take (Length b) ps) b)+  , R (T (Drop (Length b) ps) c)+  ) => R (T ps ((a :@: b) c)) where+  {-# INLINE render #-}+  render (T ~(WithAttributes b c))+    = render (T b :: T (Take (Length b) ps) b)+   <> render (T c :: T (Drop (Length b) ps) c)  instance-  ( Renderchunks (Tagged (Take (CountContent a) prox) a)-  , Renderchunks (Tagged (Drop (CountContent a) prox) b)-  ) => Renderchunks (Tagged prox (a # b)) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged ~(a :#: b))-    = renderchunks (Tagged a :: Tagged (Take (CountContent a) prox) a)-   <> renderchunks (Tagged b :: Tagged (Drop (CountContent a) prox) b)+  ( R (T (Take (Length a) ps) a)+  , R (T (Drop (Length a) ps) b)+  ) => R (T ps (a # b)) where+  {-# INLINE render #-}+  render (T ~(a :#: b))+    = render (T a :: T (Take (Length a) ps) a)+   <> render (T b :: T (Drop (Length a) ps) b)  instance-  ( Renderchunks (Tagged (ToTypeList (a `f` b)) (a `f` b))-  , Convert (Proxy s)-  ) => Renderchunks (Tagged (s ': ss) [a `f` b]) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged xs)-    = unConv (convert (Proxy @ s))-    <> foldMap (renderchunks . tag) xs+  ( R (T (ToList (a `f` b)) (a `f` b))+  , R (Proxy s)+  ) => R (T (s ': ss) [a `f` b]) where+  {-# INLINE render #-}+  render (T xs)+    = render (Proxy @ s)+    <> foldMap (render . newT) xs++instance+  ( R (T (ToList a) a)+  , R (Proxy s)+  ) => R (T (s ': ss) (Maybe a)) where+  {-# INLINE render #-}+  render (T mx)+    = render (Proxy @ s)+    <> foldMap (render . newT) mx++instance+  ( R (T (ToList a) a)+  , R (T (ToList b) b)+  , R (Proxy s)+  ) => R (T (s ': ss) (Either a b)) where+  {-# INLINE render #-}+  render (T eab)+    = render (Proxy @ s)+    <> either (render . newT) (render . newT) eab++newT :: x -> T (ToList x) x+newT = T

@@ -337,16 +337,18 @@ type NoTail xs = 'FingerTree xs EmptySym type Singleton = 'FingerTree '[] +type Both l r = AppSymbols (Append (List l) (List r))+ type family (<|) s t :: FingerTree where-  (<|) l ('FingerTree (s ': ss) r) = 'FingerTree (AppSymbols (Append (List l) (List s)) ': ss) r-  (<|) l ('FingerTree '[] r) = 'FingerTree '[] (AppSymbols (Append (List l) (List r)))+  (<|) l ('FingerTree (s ': ss) r) = 'FingerTree (Both l s ': ss) r+  (<|) l ('FingerTree '[] r) = 'FingerTree '[] (Both l r)  type family (|>) t s :: FingerTree where-  (|>) ('FingerTree ss r) rr = 'FingerTree ss (AppSymbols (Append (List r) (List rr)))+  (|>) ('FingerTree ss r) rr = 'FingerTree ss (Both r rr)  type family (><) t1 t2 :: FingerTree where-  (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (AppSymbols (Append (List r) (List s)) ': ss2)) r2-  (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (AppSymbols (Append (List r) (List r2)))+  (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (Both r s ': ss2)) r2+  (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (Both r r2)  type family OpenTag e where   OpenTag e = ["<", ShowElement e, ">"]@@ -355,16 +357,16 @@   CloseTag e = ["</", ShowElement e, ">"]  -- | Flatten a document into a type list of tags.-type family ToTypeList a :: FingerTree where-  ToTypeList (a # b)         = ToTypeList a >< ToTypeList b-  ToTypeList ((a :@: ()) ()) = Singleton (If (HasContent (GetEInfo a)) (AppSymbols (Append (OpenTag a) (CloseTag a))) (AppSymbols (OpenTag a)))-  ToTypeList ((a :@: b) ())  = AppSymbols '["<", ShowElement a] <| ToTypeList b |> If (HasContent (GetEInfo a)) (AppSymbols (">" ': CloseTag a)) (AppSymbols '[">"])-  ToTypeList ((a :@: ()) b)  = AppSymbols (OpenTag a) <| ToTypeList b |> AppSymbols (CloseTag a)-  ToTypeList ((a :@: b) c)   = (AppSymbols '["<", ShowElement a] <| ToTypeList b) >< (AppSymbols '[">"] <| ToTypeList c |> AppSymbols (CloseTag a))-  ToTypeList (a := b)        = AppSymbols '[" ", ShowAttribute a,"=\""] <| ToTypeList b |> AppSymbols '["\""]-  ToTypeList ()              = Empty-  ToTypeList (Proxy x)       = Singleton (AppSymbols '[x])-  ToTypeList x               = Split+type family ToList a :: FingerTree where+  ToList (a # b)         = ToList a >< ToList b+  ToList ((a :@: ()) ()) = Singleton (If (HasContent (GetEInfo a)) (AppSymbols (Append (OpenTag a) (CloseTag a))) (AppSymbols (OpenTag a)))+  ToList ((a :@: b) ())  = AppSymbols '["<", ShowElement a] <| ToList b |> If (HasContent (GetEInfo a)) (AppSymbols (">" ': CloseTag a)) (AppSymbols '[">"])+  ToList ((a :@: ()) b)  = AppSymbols (OpenTag a) <| ToList b |> AppSymbols (CloseTag a)+  ToList ((a :@: b) c)   = (AppSymbols '["<", ShowElement a] <| ToList b) >< (AppSymbols '[">"] <| ToList c |> AppSymbols (CloseTag a))+  ToList (a := b)        = AppSymbols '[" ", ShowAttribute a,"=\""] <| ToList b |> AppSymbols '["\""]+  ToList ()              = Empty+  ToList (Proxy x)       = Singleton (AppSymbols '[x])+  ToList x               = Split  newtype (:=) (a :: Attribute) b = AT b @@ -385,6 +387,8 @@ type family (a :: Element) ??> b :: Constraint where   a ??> () = ()   a ??> (b # c)  = (a ??> b, a ??> c)+  a ??> Maybe b = a ??> b+  a ??> Either b c = (a ??> b, a ??> c)   a ??> (b := _) = If (Elem a (AInfoElements (GetAInfo b)) || Null (AInfoElements (GetAInfo b)))                    (() :: Constraint)                    (TypeError (ShowType b :<>: Text " is not a valid attribute of " :<>: ShowType a))@@ -432,13 +436,13 @@   Null '[] = True   Null _ = False -type family CountContent c where-  CountContent (a # b)       = CountContent a + CountContent b-  CountContent ((_ :@: b) c) = CountContent b + CountContent c-  CountContent (_ := b)      = CountContent b-  CountContent ()            = 0-  CountContent (Proxy _)     = 0-  CountContent _             = 1+type family Length c where+  Length (a # b)       = Length a + Length b+  Length ((_ :@: b) c) = Length b + Length c+  Length (_ := b)      = Length b+  Length ()            = 0+  Length (Proxy _)     = 0+  Length _             = 1  -- | Check whether an element may have content. type family HasContent a where@@ -552,7 +556,7 @@   Elem a (_ : xs) = Elem a xs   Elem a '[]      = False -newtype Tagged (proxies :: k) target = Tagged target+newtype T (proxies :: k) target = T target  data AInfo (name :: Symbol) (elements :: [Element]) type ShowAttribute (x :: Attribute) = AInfoName (GetAInfo x)

@@ -177,6 +177,34 @@         ===         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")

@@ -1,5 +1,5 @@ name:                 type-of-html-version:              1.2.0.0+version:              1.3.0.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