packages feed

type-of-html (empty) → 0.2.1.1

raw patch · 11 files changed

+3381/−0 lines, 11 filesdep +basedep +blaze-htmldep +bytestringsetup-changed

Dependencies added: base, blaze-html, bytestring, criterion, hspec, text, type-of-html

Files

+ ChangeLog.md view
@@ -0,0 +1,13 @@+# Revision history for type-of-html++## 0.2.1.0  -- 2017-08-04++* Escape strings++## 0.2.0.0  -- 2017-07-30++* Full implementation++## 0.1.0.0  -- 2017-07-09++* First draft
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2017, Florian Knupfer++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Florian Knupfer nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Readme.md view
@@ -0,0 +1,53 @@+# Type of html++`Type of html` is a library for generating html in a highly performant+and type safe manner.++Please read the documentation of the module:+[Html](https://hackage.haskell.org/package/type-of-html/docs/Html.html)++Note that you need at least ghc 8.2.++## Typesafety++Part of the html spec is encoded at the typelevel, turning a lot of+mistakes into type errors.++## Performance++`Type of html` is normally a lot faster than `blaze html`.  Criterion+says about the following snippet that `Type of html` needs only ~450+ns, `blaze html` needs ten times more time.++```haskell+example x =+  html_+    ( body_+      ( h1_+        ( img_+        # strong_ "0"+        )+      # div_+        ( div_ "1"+        )+      # div_+        ( form_+          ( fieldset_+            ( div_+              ( div_+                ( label_ "a"+                # select_+                  ( option_ "b"+                  # option_ "c"+                  )+                # div_ "d"+                )+              # i_ x+              )+            # button_ (i_ "e")+            )+          )+        )+      )+    )+```
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,275 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}++module Main where++import Html++import Data.String+import Control.Monad++import Data.Text.Lazy.Builder (Builder, toLazyText)+import Text.Blaze.Html5 ((!))++import Data.ByteString.Lazy (ByteString)++import qualified Data.Text                     as S+import qualified Data.Text.Lazy                as L+import qualified Text.Blaze.Html5              as B+import qualified Text.Blaze.Html5.Attributes   as B (class_, id)+import qualified Text.Blaze.Html.Renderer.Text as RT+import qualified Text.Blaze.Html.Renderer.Utf8 as RB++import Criterion.Main++main :: IO ()+main = defaultMain+  [ bgroup "minimal"+    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeMinimal     :: B.Html     -> L.Text)     "TEST"+    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeMinimal     :: B.Html     -> ByteString) "TEST"+    , bench "string"      $ nf (render . minimal                 :: String     -> String)     "TEST"+    , bench "strict text" $ nf (render . minimal                 :: S.Text     -> S.Text)     "TEST"+    , bench "lazy text"   $ nf (render . minimal                 :: L.Text     -> L.Text)     "TEST"+    , bench "builder"     $ nf (toLazyText . render . minimal    :: Builder    -> L.Text)     "TEST"+    ]+  , bgroup "hello world"+    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeHelloWorld  :: B.Html     -> L.Text)     "TEST"+    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeHelloWorld  :: B.Html     -> ByteString) "TEST"+    , bench "string"      $ nf (render . helloWorld              :: String     -> String)     "TEST"+    , bench "strict text" $ nf (render . helloWorld              :: S.Text     -> S.Text)     "TEST"+    , bench "lazy text"   $ nf (render . helloWorld              :: L.Text     -> L.Text)     "TEST"+    , bench "builder"     $ nf (toLazyText . render . helloWorld :: Builder    -> L.Text)     "TEST"+    ]+  , bgroup "big page"+    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigPage     :: B.Html     -> L.Text)     "TEST"+    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigPage     :: B.Html     -> ByteString) "TEST"+    , bench "string"      $ nf (render . bigPage                 :: String     -> String)     "TEST"+    , bench "strict text" $ nf (render . bigPage                 :: S.Text     -> S.Text)     "TEST"+    , bench "lazy text"   $ nf (render . bigPage                 :: L.Text     -> L.Text)     "TEST"+    , bench "builder"     $ nf (toLazyText . render . bigPage    :: Builder    -> L.Text)     "TEST"+    ]+  , bgroup "big page with attributes"+    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigPageA    :: B.Html     -> L.Text)     "TEST"+    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigPageA    :: B.Html     -> ByteString) "TEST"+    , bench "string"      $ nf (render . bigPageA                :: String     -> String)     "TEST"+    , bench "strict text" $ nf (render . bigPageA                :: S.Text     -> S.Text)     "TEST"+    , bench "lazy text"   $ nf (render . bigPageA                :: L.Text     -> L.Text)     "TEST"+    , bench "builder"     $ nf (toLazyText . render . bigPageA   :: Builder    -> L.Text)     "TEST"+    ]+  , bgroup "big table"+    [ bench "blaze.text"  $ nf (RT.renderHtml . blazeBigTable    :: (Int, Int) -> L.Text)     (4,4)+    , bench "blaze.utf8"  $ nf (RB.renderHtml . blazeBigTable    :: (Int, Int) -> ByteString) (4,4)+    , bench "string"      $ nf (render . bigTable                :: (Int, Int) -> String)     (4,4)+    , bench "strict text" $ nf (render . bigTable                :: (Int, Int) -> S.Text)     (4,4)+    , bench "lazy text"   $ nf (render . bigTable                :: (Int, Int) -> L.Text)     (4,4)+    , bench "builder"     $ nf (toLazyText . render . bigTable   :: (Int, Int) -> L.Text)     (4,4)+    ]+  ]++-- 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 "Hello World!"++blazeBigPage :: B.Html -> B.Html+blazeBigPage x =+  B.html $ do+    B.body $ do+      B.h1 $ do+        B.img+        B.strong "0"+      B.div $ do+        B.div "1"+      B.div $ do+        B.form $ do+          B.fieldset $ do+            B.div $ do+              B.div $ do+                B.label "a"+                B.select $ do+                  B.option "b"+                  B.option "c"+                B.div "d"+              B.i x+            B.button $ B.i "e"++blazeBigPageA :: B.Html -> B.Html+blazeBigPageA x =+  B.html $ do+    B.body $ do+      B.h1 ! B.id "a" $ do+        B.img+        B.strong ! B.class_ "b" $ "0"+      B.div $ do+        B.div ! B.id "c" $ "1"+      B.div $ do+        B.form ! B.class_ "d" $ do+          B.fieldset $ do+            B.div ! B.id "e" $ do+              B.div $ do+                B.label ! B.class_ "f" $ "a"+                B.select $ do+                  B.option ! B.id "g" $ "b"+                  B.option "c"+                B.div ! B.class_ "h" $ "d"+              B.i x+            B.button ! B.id "i" $ B.i "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 ?> a) => a -> 'Div > a+minimal = div_++helloWorld+  :: (IsString a, 'Title ?> a)+  => a+  ->+  'Html > ( 'Head > 'Title > a+          # 'Body > 'P > String+          )+helloWorld x =+  html_+    ( head_+      ( title_ x+      )+    # body_+      ( p_ ("Hello World!" :: String)+      )+    )++bigPage+  :: ('I ?> a)+  => a+  ->+  'Html >+  ( 'Body >+    ( 'H1 >+      ( 'Img > ()+      # 'Strong > String+      )+    # 'Div > 'Div > String+    # 'Div > 'Form > 'Fieldset >+      ( 'Div >+        ( 'Div >+          ( 'Label > String+          # 'Select >+            ( 'Option > String+            # 'Option > String+            )+          # 'Div > String+          )+        # 'I > a+        )+      # 'Button > 'I > String+      )+    )+  )+bigPage x =+  html_+    ( body_+      ( h1_+        ( img_+        # strong_ ("0" :: String)+        )+      # div_+        ( div_ ("1" :: String)+        )+      # div_+        ( form_+          ( fieldset_+            ( div_+              ( div_+                ( label_ ("a" :: String)+                # select_+                  ( option_ ("b" :: String)+                  # option_ ("c" :: String)+                  )+                # div_ ("d" :: String)+                )+              # i_ x+              )+            # button_ (i_ ("e" :: String))+            )+          )+        )+      )+    )++bigPageA+  :: ('I ?> a)+  => a+  ->+  'Html >+  ( 'Body >+    ( 'H1 :>+      ( 'Img > ()+      # 'Strong :> String+      )+    # 'Div > 'Div :> String+    # 'Div > 'Form :> 'Fieldset >+      ( 'Div :>+        ( 'Div >+          ( 'Label :> String+          # 'Select >+            ( 'Option :> String+            # 'Option > String+            )+          # 'Div :> String+          )+        # 'I > a+        )+      # 'Button :> 'I > String+      )+    )+  )+bigPageA x =+  html_+    ( body_+      ( h1_A [("id","a")]+        ( img_+        # strong_A [("class","b")] ("0" :: String)+        )+      # div_+        ( div_A [("id","c")] ("1" :: String)+        )+      # div_+        ( form_A [("class","d")]+          ( fieldset_+            ( div_A [("id","e")]+              ( div_+                ( label_A [("class","f")] ("a" :: String)+                # select_+                  ( option_A [("id","g")] ("b" :: String)+                  # option_ ("c" :: String)+                  )+                # div_A [("class","h")] ("d" :: String)+                )+              # i_ x+              )+            # button_A [("id","i")] (i_ ("e" :: String))+            )+          )+        )+      )+    )++bigTable :: (Int, Int) -> 'Table > ['Tr > ['Td > Int]]+bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [1..m]
+ src/Html.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE ExplicitNamespaces #-}++{-| With type-of-html are three main goals:++* Type safety++* Modularity++* Performance++Let's check out the /type safety/ in ghci:++> Html> td_ (tr_ "a")+>+> <interactive>:1:1: error:+>     • 'Tr is not a valid child of 'Td+>     • In the expression: td_ (tr_ "a")+>       In an equation for ‘it’: it = td_ (tr_ "a")+>+> <interactive>:1:6: error:+>     • 'Tr can't contain a string+>     • In the first argument of ‘td_’, namely ‘(tr_ "a")’+>       In the expression: td_ (tr_ "a")+>       In an equation for ‘it’: it = td_ (tr_ "a")++For every child, it is checked if it could possibly be lawful.++The checking is a bit lenient at the moment:++* some elements can't contain itself as any descendant: at the moment we look only at direct children. This allows some (quite exotic) invalid html documents.+* some elements change their permitted content based on attributes: we don't know at compile time the attributes, therefore we always allow content as if all relevant attributes are set.+* some elements can't be brethren: we look only at parent child relations, therefore if you don't specify the parent, it'll compile++Never the less: these cases are seldom.  In the vast majority of the time you're only allowed to construct valid html.++Let's talk about /modularity/:++Rosetrees of html are just ordinary haskell values which can be composed or abstracted over:++> Html> let table = table_ . map (tr_ . map td_)+> Html> :t table+> table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]]+> Html> table [["A","B"],["C"]]+> <table><tr><td>A<td>B<tr><td>C</table>+> Html> import Data.Char+> Html Data.Char> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d']+> <html><body><table><tr><td>a<td>97<tr><td>b<td>98<tr><td>c<td>99<tr><td>d<td>100</table></body></html>++And here's an example module++@+{\-\# LANGUAGE TypeOperators \#-\}+{\-\# LANGUAGE DataKinds     \#-\}++module Main where++import Html++import Data.Text.Lazy.IO      as T+import Data.Text.Lazy.Builder as T++main :: IO ()+main+  = T.putStrLn+  . T.toLazyText+  . render+  . page+  $ map td_ [1..(10::Int)]++page+  :: 'Tr ?> a+  => a+  -> 'Div+     > ( 'Div > [Char]+       # 'Div > [Char]+       # 'Table > 'Tr > a+       )+page tds =+  div_+    ( div_ "foo"+    # div_ "bar"+    # table_ (tr_ tds)+    )+@++Please note that the type of page is inferable, so ask ghc-mod or+whatever you use to write it for you.  If you choose not to write the+types, you don't need the language extensions.++Last and fast: /performance/!++Don't look any further, there is no option for faster html+generation. type-of-html up to 10 times faster than blaze-html, which+is until now the fastest generation library and the foundation block+of lucid and shakespeare.++Wait! 10 times faster? How is this possible? We supercompile lots of+parts of the generation process. This is possible thanks to the new+features of GHC 8.2: AppendSymbol. We represent tags as kinds and+remove according to the html specification omittable closing tags with+type families. Afterwards we map these tags to (a :: [Symbol]) and+then fold all neighbouring Proxies with AppendSymbol. Afterwards we+retrieve the Proxies with symbolVal which will be embedded in the+executable as CString. All this happens at compile time. At runtime we+do only generate the content and mconcat.++For example, if you write:++> render $ div_ "a"++The compiler does actually optimize it to the following:++> mconcat [ fromString $ symbolVal (Proxy :: Proxy "<div>")+>         , fromString "a"+>         , fromString $ symbolVal (Proxy :: Proxy "</div>")+>         ]++If you write++> render $ div_ (div_ ())++The compiler does actually optimize it to the following:++> mconcat [ fromString $ symbolVal (Proxy :: Proxy "<div><div></div></div>") ]++If you write++> render $ tr_ (td_ "test")++The compiler does actually optimize it to the following:++> mconcat [ fromString $ symbolVal (Proxy :: Proxy "<tr><td>")+>         , fromString "test"+>         , fromString $ symbolVal (Proxy :: Proxy "</tr>")+>         ]++Let's look at core:++We take an extremely simple library++> module Minimal where+>+> import Html+>+> minimal :: String+> minimal = render+>   ( div_ "a"+>   # div_ "b"+>   # table_ (tr_ (td_ "c"))+>   )++compile it with++> ghc -O2 Minimal.hs -ddump-to-file -ddump-simpl -dsuppress-idinfo -dsuppress-module-prefixes -dsuppress-type-applications -dsuppress-uniques++and clean up a bit:++> minimal1 :: Addr#+> minimal1 = "<div>a</div><div>b</div><table><tr><td>c</table>"#+>+> minimal :: String+> minimal = unpackCString# minimal1++Well, that's a perfect optimization! Not only was *all* overhead+removed, optional ending tags were chopped off (tr, td).  This sort of+compiletime optimization isn't for free.  Running ghc with -v says+that desugaring resulted in 675 types and 5507 coercions: Compile+times will increase, some medium size html documents will take 10 secs+to compile.++-}++module Html+  ( render+  , type (>)(..)+  , type (:>)(..)+  , addAttributes+  , type (#)(..)+  , (#)+  , type (?>)+  , Convert(..)+  , Escape(..)+  , Element(..)+  , module Html.Element+  ) where++import Html.Element++import Html.Type+  ( type (>)(..)+  , type (:>)(..)+  , type (?>)+  , type (#)(..)+  , (#)+  , Element(..)+  )++import Html.Function+  ( render+  , addAttributes+  , Convert(..)+  , Escape(..)+  )
+ src/Html/Element.hs view
@@ -0,0 +1,888 @@+{-# OPTIONS_GHC -fno-warn-deprecations #-}++{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds     #-}++module Html.Element where++import Html.Type+import Html.Function (addAttributes)++doctype_ :: 'DOCTYPE > ()+doctype_ = Child ()++a_ :: ('A ?> a) => a -> 'A > a+a_ = Child++a_A :: ('A ?> a) => [(String, String)] -> a -> 'A :> a+a_A xs = addAttributes xs . Child++abbr_ :: ('Abbr ?> a) => a -> 'Abbr > a+abbr_ = Child++abbr_A :: ('Abbr ?> a) => [(String, String)] -> a -> 'Abbr :> a+abbr_A xs = addAttributes xs . Child++acronym_ :: ('Acronym ?> a) => a -> 'Acronym > a+acronym_ = Child++acronym_A :: ('Acronym ?> a) => [(String, String)] -> a -> 'Acronym :> a+acronym_A xs = addAttributes xs . Child++address_ :: ('Address ?> a) => a -> 'Address > a+address_ = Child++address_A :: ('Address ?> a) => [(String, String)] -> a -> 'Address :> a+address_A xs = addAttributes xs . Child++applet_ :: ('Applet ?> a) => a -> 'Applet > a+applet_ = Child++applet_A :: ('Applet ?> a) => [(String, String)] -> a -> 'Applet :> a+applet_A xs = addAttributes xs . Child++area_ :: 'Area > ()+area_ = Child ()++area_A :: [(String, String)] -> 'Area :> ()+area_A xs = addAttributes xs $ Child ()++article_ :: ('Article ?> a) => a -> 'Article > a+article_ = Child++article_A :: ('Article ?> a) => [(String, String)] -> a -> 'Article :> a+article_A xs = addAttributes xs . Child++aside_ :: ('Aside ?> a) => a -> 'Aside > a+aside_ = Child++aside_A :: ('Aside ?> a) => [(String, String)] -> a -> 'Aside :> a+aside_A xs = addAttributes xs . Child++audio_ :: ('Audio ?> a) => a -> 'Audio > a+audio_ = Child++audio_A :: ('Audio ?> a) => [(String, String)] -> a -> 'Audio :> a+audio_A xs = addAttributes xs . Child++b_ :: ('B ?> a) => a -> 'B > a+b_ = Child++b_A :: ('B ?> a) => [(String, String)] -> a -> 'B :> a+b_A xs = addAttributes xs . Child++base_ :: 'Base > ()+base_ = Child ()++base_A :: [(String, String)] -> 'Base :> ()+base_A xs = addAttributes xs $ Child ()++basefont_ :: ('Basefont ?> a) => a -> 'Basefont > a+basefont_ = Child++basefont_A :: ('Basefont ?> a) => [(String, String)] -> a -> 'Basefont :> a+basefont_A xs = addAttributes xs . Child++bdi_ :: ('Bdi ?> a) => a -> 'Bdi > a+bdi_ = Child++bdi_A :: ('Bdi ?> a) => [(String, String)] -> a -> 'Bdi :> a+bdi_A xs = addAttributes xs . Child++bdo_ :: ('Bdo ?> a) => a -> 'Bdo > a+bdo_ = Child++bdo_A :: ('Bdo ?> a) => [(String, String)] -> a -> 'Bdo :> a+bdo_A xs = addAttributes xs . Child++bgsound_ :: ('Bgsound ?> a) => a -> 'Bgsound > a+bgsound_ = Child++bgsound_A :: ('Bgsound ?> a) => [(String, String)] -> a -> 'Bgsound :> a+bgsound_A xs = addAttributes xs . Child++big_ :: ('Big ?> a) => a -> 'Big > a+big_ = Child++big_A :: ('Big ?> a) => [(String, String)] -> a -> 'Big :> a+big_A xs = addAttributes xs . Child++blink_ :: ('Blink ?> a) => a -> 'Blink > a+blink_ = Child++blink_A :: ('Blink ?> a) => [(String, String)] -> a -> 'Blink :> a+blink_A xs = addAttributes xs . Child++blockquote_ :: ('Blockquote ?> a) => a -> 'Blockquote > a+blockquote_ = Child++blockquote_A :: ('Blockquote ?> a) => [(String, String)] -> a -> 'Blockquote :> a+blockquote_A xs = addAttributes xs . Child++body_ :: ('Body ?> a) => a -> 'Body > a+body_ = Child++body_A :: ('Body ?> a) => [(String, String)] -> a -> 'Body :> a+body_A xs = addAttributes xs . Child++br_ :: 'Br > ()+br_ = Child ()++br_A :: [(String, String)] -> 'Br :> ()+br_A xs = addAttributes xs $ Child ()++button_ :: ('Button ?> a) => a -> 'Button > a+button_ = Child++button_A :: ('Button ?> a) => [(String, String)] -> a -> 'Button :> a+button_A xs = addAttributes xs . Child++canvas_ :: ('Canvas ?> a) => a -> 'Canvas > a+canvas_ = Child++canvas_A :: ('Canvas ?> a) => [(String, String)] -> a -> 'Canvas :> a+canvas_A xs = addAttributes xs . Child++caption_ :: ('Caption ?> a) => a -> 'Caption > a+caption_ = Child++caption_A :: ('Caption ?> a) => [(String, String)] -> a -> 'Caption :> a+caption_A xs = addAttributes xs . Child++center_ :: ('Center ?> a) => a -> 'Center > a+center_ = Child++center_A :: ('Center ?> a) => [(String, String)] -> a -> 'Center :> a+center_A xs = addAttributes xs . Child++cite_ :: ('Cite ?> a) => a -> 'Cite > a+cite_ = Child++cite_A :: ('Cite ?> a) => [(String, String)] -> a -> 'Cite :> a+cite_A xs = addAttributes xs . Child++code_ :: ('Code ?> a) => a -> 'Code > a+code_ = Child++code_A :: ('Code ?> a) => [(String, String)] -> a -> 'Code :> a+code_A xs = addAttributes xs . Child++col_ :: 'Col > ()+col_ = Child ()++col_A :: [(String, String)] -> 'Col :> ()+col_A xs = addAttributes xs $ Child ()++colgroup_ :: ('Colgroup ?> a) => a -> 'Colgroup > a+colgroup_ = Child++colgroup_A :: ('Colgroup ?> a) => [(String, String)] -> a -> 'Colgroup :> a+colgroup_A xs = addAttributes xs . Child++command_ :: ('Command ?> a) => a -> 'Command > a+command_ = Child++command_A :: ('Command ?> a) => [(String, String)] -> a -> 'Command :> a+command_A xs = addAttributes xs . Child++content_ :: ('Content ?> a) => a -> 'Content > a+content_ = Child++content_A :: ('Content ?> a) => [(String, String)] -> a -> 'Content :> a+content_A xs = addAttributes xs . Child++data_ :: ('Data ?> a) => a -> 'Data > a+data_ = Child++data_A :: ('Data ?> a) => [(String, String)] -> a -> 'Data :> a+data_A xs = addAttributes xs . Child++datalist_ :: ('Datalist ?> a) => a -> 'Datalist > a+datalist_ = Child++datalist_A :: ('Datalist ?> a) => [(String, String)] -> a -> 'Datalist :> a+datalist_A xs = addAttributes xs . Child++dd_ :: ('Dd ?> a) => a -> 'Dd > a+dd_ = Child++dd_A :: ('Dd ?> a) => [(String, String)] -> a -> 'Dd :> a+dd_A xs = addAttributes xs . Child++del_ :: ('Del ?> a) => a -> 'Del > a+del_ = Child++del_A :: ('Del ?> a) => [(String, String)] -> a -> 'Del :> a+del_A xs = addAttributes xs . Child++details_ :: ('Details ?> a) => a -> 'Details > a+details_ = Child++details_A :: ('Details ?> a) => [(String, String)] -> a -> 'Details :> a+details_A xs = addAttributes xs . Child++dfn_ :: ('Dfn ?> a) => a -> 'Dfn > a+dfn_ = Child++dfn_A :: ('Dfn ?> a) => [(String, String)] -> a -> 'Dfn :> a+dfn_A xs = addAttributes xs . Child++dialog_ :: ('Dialog ?> a) => a -> 'Dialog > a+dialog_ = Child++dialog_A :: ('Dialog ?> a) => [(String, String)] -> a -> 'Dialog :> a+dialog_A xs = addAttributes xs . Child++dir_ :: ('Dir ?> a) => a -> 'Dir > a+dir_ = Child++dir_A :: ('Dir ?> a) => [(String, String)] -> a -> 'Dir :> a+dir_A xs = addAttributes xs . Child++div_ :: ('Div ?> a) => a -> 'Div > a+div_ = Child++div_A :: ('Div ?> a) => [(String, String)] -> a -> 'Div :> a+div_A xs = addAttributes xs . Child++dl_ :: ('Dl ?> a) => a -> 'Dl > a+dl_ = Child++dl_A :: ('Dl ?> a) => [(String, String)] -> a -> 'Dl :> a+dl_A xs = addAttributes xs . Child++dt_ :: ('Dt ?> a) => a -> 'Dt > a+dt_ = Child++dt_A :: ('Dt ?> a) => [(String, String)] -> a -> 'Dt :> a+dt_A xs = addAttributes xs . Child++element_ :: ('Element ?> a) => a -> 'Element > a+element_ = Child++element_A :: ('Element ?> a) => [(String, String)] -> a -> 'Element :> a+element_A xs = addAttributes xs . Child++em_ :: ('Em ?> a) => a -> 'Em > a+em_ = Child++em_A :: ('Em ?> a) => [(String, String)] -> a -> 'Em :> a+em_A xs = addAttributes xs . Child++embed_ :: 'Embed > ()+embed_ = Child ()++embed_A :: [(String, String)] -> 'Embed :> ()+embed_A xs = addAttributes xs $ Child ()++fieldset_ :: ('Fieldset ?> a) => a -> 'Fieldset > a+fieldset_ = Child++fieldset_A :: ('Fieldset ?> a) => [(String, String)] -> a -> 'Fieldset :> a+fieldset_A xs = addAttributes xs . Child++figcaption_ :: ('Figcaption ?> a) => a -> 'Figcaption > a+figcaption_ = Child++figcaption_A :: ('Figcaption ?> a) => [(String, String)] -> a -> 'Figcaption :> a+figcaption_A xs = addAttributes xs . Child++figure_ :: ('Figure ?> a) => a -> 'Figure > a+figure_ = Child++figure_A :: ('Figure ?> a) => [(String, String)] -> a -> 'Figure :> a+figure_A xs = addAttributes xs . Child++font_ :: ('Font ?> a) => a -> 'Font > a+font_ = Child++font_A :: ('Font ?> a) => [(String, String)] -> a -> 'Font :> a+font_A xs = addAttributes xs . Child++footer_ :: ('Footer ?> a) => a -> 'Footer > a+footer_ = Child++footer_A :: ('Footer ?> a) => [(String, String)] -> a -> 'Footer :> a+footer_A xs = addAttributes xs . Child++form_ :: ('Form ?> a) => a -> 'Form > a+form_ = Child++form_A :: ('Form ?> a) => [(String, String)] -> a -> 'Form :> a+form_A xs = addAttributes xs . Child++frame_ :: ('Frame ?> a) => a -> 'Frame > a+frame_ = Child++frame_A :: ('Frame ?> a) => [(String, String)] -> a -> 'Frame :> a+frame_A xs = addAttributes xs . Child++frameset_ :: ('Frameset ?> a) => a -> 'Frameset > a+frameset_ = Child++frameset_A :: ('Frameset ?> a) => [(String, String)] -> a -> 'Frameset :> a+frameset_A xs = addAttributes xs . Child++h1_ :: ('H1 ?> a) => a -> 'H1 > a+h1_ = Child++h1_A :: ('H1 ?> a) => [(String, String)] -> a -> 'H1 :> a+h1_A xs = addAttributes xs . Child++h2_ :: ('H2 ?> a) => a -> 'H2 > a+h2_ = Child++h2_A :: ('H2 ?> a) => [(String, String)] -> a -> 'H2 :> a+h2_A xs = addAttributes xs . Child++h3_ :: ('H3 ?> a) => a -> 'H3 > a+h3_ = Child++h3_A :: ('H3 ?> a) => [(String, String)] -> a -> 'H3 :> a+h3_A xs = addAttributes xs . Child++h4_ :: ('H4 ?> a) => a -> 'H4 > a+h4_ = Child++h4_A :: ('H4 ?> a) => [(String, String)] -> a -> 'H4 :> a+h4_A xs = addAttributes xs . Child++h5_ :: ('H5 ?> a) => a -> 'H5 > a+h5_ = Child++h5_A :: ('H5 ?> a) => [(String, String)] -> a -> 'H5 :> a+h5_A xs = addAttributes xs . Child++h6_ :: ('H6 ?> a) => a -> 'H6 > a+h6_ = Child++h6_A :: ('H6 ?> a) => [(String, String)] -> a -> 'H6 :> a+h6_A xs = addAttributes xs . Child++head_ :: ('Head ?> a) => a -> 'Head > a+head_ = Child++head_A :: ('Head ?> a) => [(String, String)] -> a -> 'Head :> a+head_A xs = addAttributes xs . Child++header_ :: ('Header ?> a) => a -> 'Header > a+header_ = Child++header_A :: ('Header ?> a) => [(String, String)] -> a -> 'Header :> a+header_A xs = addAttributes xs . Child++hgroup_ :: ('Hgroup ?> a) => a -> 'Hgroup > a+hgroup_ = Child++hgroup_A :: ('Hgroup ?> a) => [(String, String)] -> a -> 'Hgroup :> a+hgroup_A xs = addAttributes xs . Child++hr_ :: 'Hr > ()+hr_ = Child ()++hr_A :: [(String, String)] -> 'Hr :> ()+hr_A xs = addAttributes xs $ Child ()++html_ :: ('Html ?> a) => a -> 'Html > a+html_ = Child++html_A :: ('Html ?> a) => [(String, String)] -> a -> 'Html :> a+html_A xs = addAttributes xs . Child++i_ :: ('I ?> a) => a -> 'I > a+i_ = Child++i_A :: ('I ?> a) => [(String, String)] -> a -> 'I :> a+i_A xs = addAttributes xs . Child++iframe_ :: 'Iframe > ()+iframe_ = Child ()++iframe_A :: [(String, String)] -> 'Iframe :> ()+iframe_A xs = addAttributes xs $ Child ()++image_ :: ('Image ?> a) => a -> 'Image > a+image_ = Child++image_A :: ('Image ?> a) => [(String, String)] -> a -> 'Image :> a+image_A xs = addAttributes xs . Child++img_ :: 'Img > ()+img_ = Child ()++img_A :: [(String, String)] -> 'Img :> ()+img_A xs = addAttributes xs $ Child ()++input_ :: ('Input ?> a) => a -> 'Input > a+input_ = Child++input_A :: ('Input ?> a) => [(String, String)] -> a -> 'Input :> a+input_A xs = addAttributes xs . Child++ins_ :: ('Ins ?> a) => a -> 'Ins > a+ins_ = Child++ins_A :: ('Ins ?> a) => [(String, String)] -> a -> 'Ins :> a+ins_A xs = addAttributes xs . Child++isindex_ :: ('Isindex ?> a) => a -> 'Isindex > a+isindex_ = Child++isindex_A :: ('Isindex ?> a) => [(String, String)] -> a -> 'Isindex :> a+isindex_A xs = addAttributes xs . Child++kbd_ :: ('Kbd ?> a) => a -> 'Kbd > a+kbd_ = Child++kbd_A :: ('Kbd ?> a) => [(String, String)] -> a -> 'Kbd :> a+kbd_A xs = addAttributes xs . Child++keygen_ :: ('Keygen ?> a) => a -> 'Keygen > a+keygen_ = Child++keygen_A :: ('Keygen ?> a) => [(String, String)] -> a -> 'Keygen :> a+keygen_A xs = addAttributes xs . Child++label_ :: ('Label ?> a) => a -> 'Label > a+label_ = Child++label_A :: ('Label ?> a) => [(String, String)] -> a -> 'Label :> a+label_A xs = addAttributes xs . Child++legend_ :: ('Legend ?> a) => a -> 'Legend > a+legend_ = Child++legend_A :: ('Legend ?> a) => [(String, String)] -> a -> 'Legend :> a+legend_A xs = addAttributes xs . Child++li_ :: ('Li ?> a) => a -> 'Li > a+li_ = Child++li_A :: ('Li ?> a) => [(String, String)] -> a -> 'Li :> a+li_A xs = addAttributes xs . Child++link_ :: 'Link > ()+link_ = Child ()++link_A :: [(String, String)] -> 'Link :> ()+link_A xs = addAttributes xs $ Child ()++listing_ :: ('Listing ?> a) => a -> 'Listing > a+listing_ = Child++listing_A :: ('Listing ?> a) => [(String, String)] -> a -> 'Listing :> a+listing_A xs = addAttributes xs . Child++main_ :: ('Main ?> a) => a -> 'Main > a+main_ = Child++main_A :: ('Main ?> a) => [(String, String)] -> a -> 'Main :> a+main_A xs = addAttributes xs . Child++map_ :: ('Map ?> a) => a -> 'Map > a+map_ = Child++map_A :: ('Map ?> a) => [(String, String)] -> a -> 'Map :> a+map_A xs = addAttributes xs . Child++mark_ :: ('Mark ?> a) => a -> 'Mark > a+mark_ = Child++mark_A :: ('Mark ?> a) => [(String, String)] -> a -> 'Mark :> a+mark_A xs = addAttributes xs . Child++marquee_ :: ('Marquee ?> a) => a -> 'Marquee > a+marquee_ = Child++marquee_A :: ('Marquee ?> a) => [(String, String)] -> a -> 'Marquee :> a+marquee_A xs = addAttributes xs . Child++math_ :: ('Math ?> a) => a -> 'Math > a+math_ = Child++math_A :: ('Math ?> a) => [(String, String)] -> a -> 'Math :> a+math_A xs = addAttributes xs . Child++menu_ :: ('Menu ?> a) => a -> 'Menu > a+menu_ = Child++menu_A :: ('Menu ?> a) => [(String, String)] -> a -> 'Menu :> a+menu_A xs = addAttributes xs . Child++menuitem_ :: 'Menuitem > ()+menuitem_ = Child ()++menuitem_A :: [(String, String)] -> 'Menuitem :> ()+menuitem_A xs = addAttributes xs $ Child ()++meta_ :: 'Meta > ()+meta_ = Child ()++meta_A :: [(String, String)] -> 'Meta :> ()+meta_A xs = addAttributes xs $ Child ()++meter_ :: ('Meter ?> a) => a -> 'Meter > a+meter_ = Child++meter_A :: ('Meter ?> a) => [(String, String)] -> a -> 'Meter :> a+meter_A xs = addAttributes xs . Child++multicol_ :: ('Multicol ?> a) => a -> 'Multicol > a+multicol_ = Child++multicol_A :: ('Multicol ?> a) => [(String, String)] -> a -> 'Multicol :> a+multicol_A xs = addAttributes xs . Child++nav_ :: ('Nav ?> a) => a -> 'Nav > a+nav_ = Child++nav_A :: ('Nav ?> a) => [(String, String)] -> a -> 'Nav :> a+nav_A xs = addAttributes xs . Child++nextid_ :: ('Nextid ?> a) => a -> 'Nextid > a+nextid_ = Child++nextid_A :: ('Nextid ?> a) => [(String, String)] -> a -> 'Nextid :> a+nextid_A xs = addAttributes xs . Child++nobr_ :: ('Nobr ?> a) => a -> 'Nobr > a+nobr_ = Child++nobr_A :: ('Nobr ?> a) => [(String, String)] -> a -> 'Nobr :> a+nobr_A xs = addAttributes xs . Child++noembed_ :: ('Noembed ?> a) => a -> 'Noembed > a+noembed_ = Child++noembed_A :: ('Noembed ?> a) => [(String, String)] -> a -> 'Noembed :> a+noembed_A xs = addAttributes xs . Child++noframes_ :: ('Noframes ?> a) => a -> 'Noframes > a+noframes_ = Child++noframes_A :: ('Noframes ?> a) => [(String, String)] -> a -> 'Noframes :> a+noframes_A xs = addAttributes xs . Child++noscript_ :: ('Noscript ?> a) => a -> 'Noscript > a+noscript_ = Child++noscript_A :: ('Noscript ?> a) => [(String, String)] -> a -> 'Noscript :> a+noscript_A xs = addAttributes xs . Child++object_ :: ('Object ?> a) => a -> 'Object > a+object_ = Child++object_A :: ('Object ?> a) => [(String, String)] -> a -> 'Object :> a+object_A xs = addAttributes xs . Child++ol_ :: ('Ol ?> a) => a -> 'Ol > a+ol_ = Child++ol_A :: ('Ol ?> a) => [(String, String)] -> a -> 'Ol :> a+ol_A xs = addAttributes xs . Child++optgroup_ :: ('Optgroup ?> a) => a -> 'Optgroup > a+optgroup_ = Child++optgroup_A :: ('Optgroup ?> a) => [(String, String)] -> a -> 'Optgroup :> a+optgroup_A xs = addAttributes xs . Child++option_ :: ('Option ?> a) => a -> 'Option > a+option_ = Child++option_A :: ('Option ?> a) => [(String, String)] -> a -> 'Option :> a+option_A xs = addAttributes xs . Child++output_ :: ('Output ?> a) => a -> 'Output > a+output_ = Child++output_A :: ('Output ?> a) => [(String, String)] -> a -> 'Output :> a+output_A xs = addAttributes xs . Child++p_ :: ('P ?> a) => a -> 'P > a+p_ = Child++p_A :: ('P ?> a) => [(String, String)] -> a -> 'P :> a+p_A xs = addAttributes xs . Child++param_ :: 'Param > ()+param_ = Child ()++param_A :: [(String, String)] -> 'Param :> ()+param_A xs = addAttributes xs $ Child ()++picture_ :: ('Picture ?> a) => a -> 'Picture > a+picture_ = Child++picture_A :: ('Picture ?> a) => [(String, String)] -> a -> 'Picture :> a+picture_A xs = addAttributes xs . Child++plaintext_ :: ('Plaintext ?> a) => a -> 'Plaintext > a+plaintext_ = Child++plaintext_A :: ('Plaintext ?> a) => [(String, String)] -> a -> 'Plaintext :> a+plaintext_A xs = addAttributes xs . Child++pre_ :: ('Pre ?> a) => a -> 'Pre > a+pre_ = Child++pre_A :: ('Pre ?> a) => [(String, String)] -> a -> 'Pre :> a+pre_A xs = addAttributes xs . Child++progress_ :: ('Progress ?> a) => a -> 'Progress > a+progress_ = Child++progress_A :: ('Progress ?> a) => [(String, String)] -> a -> 'Progress :> a+progress_A xs = addAttributes xs . Child++q_ :: ('Q ?> a) => a -> 'Q > a+q_ = Child++q_A :: ('Q ?> a) => [(String, String)] -> a -> 'Q :> a+q_A xs = addAttributes xs . Child++rp_ :: ('Rp ?> a) => a -> 'Rp > a+rp_ = Child++rp_A :: ('Rp ?> a) => [(String, String)] -> a -> 'Rp :> a+rp_A xs = addAttributes xs . Child++rt_ :: ('Rt ?> a) => a -> 'Rt > a+rt_ = Child++rt_A :: ('Rt ?> a) => [(String, String)] -> a -> 'Rt :> a+rt_A xs = addAttributes xs . Child++rtc_ :: ('Rtc ?> a) => a -> 'Rtc > a+rtc_ = Child++rtc_A :: ('Rtc ?> a) => [(String, String)] -> a -> 'Rtc :> a+rtc_A xs = addAttributes xs . Child++ruby_ :: ('Ruby ?> a) => a -> 'Ruby > a+ruby_ = Child++ruby_A :: ('Ruby ?> a) => [(String, String)] -> a -> 'Ruby :> a+ruby_A xs = addAttributes xs . Child++s_ :: ('S ?> a) => a -> 'S > a+s_ = Child++s_A :: ('S ?> a) => [(String, String)] -> a -> 'S :> a+s_A xs = addAttributes xs . Child++samp_ :: ('Samp ?> a) => a -> 'Samp > a+samp_ = Child++samp_A :: ('Samp ?> a) => [(String, String)] -> a -> 'Samp :> a+samp_A xs = addAttributes xs . Child++script_ :: ('Script ?> a) => a -> 'Script > a+script_ = Child++script_A :: ('Script ?> a) => [(String, String)] -> a -> 'Script :> a+script_A xs = addAttributes xs . Child++section_ :: ('Section ?> a) => a -> 'Section > a+section_ = Child++section_A :: ('Section ?> a) => [(String, String)] -> a -> 'Section :> a+section_A xs = addAttributes xs . Child++select_ :: ('Select ?> a) => a -> 'Select > a+select_ = Child++select_A :: ('Select ?> a) => [(String, String)] -> a -> 'Select :> a+select_A xs = addAttributes xs . Child++shadow_ :: ('Shadow ?> a) => a -> 'Shadow > a+shadow_ = Child++shadow_A :: ('Shadow ?> a) => [(String, String)] -> a -> 'Shadow :> a+shadow_A xs = addAttributes xs . Child++slot_ :: ('Slot ?> a) => a -> 'Slot > a+slot_ = Child++slot_A :: ('Slot ?> a) => [(String, String)] -> a -> 'Slot :> a+slot_A xs = addAttributes xs . Child++small_ :: ('Small ?> a) => a -> 'Small > a+small_ = Child++small_A :: ('Small ?> a) => [(String, String)] -> a -> 'Small :> a+small_A xs = addAttributes xs . Child++source_ :: 'Source > ()+source_ = Child ()++source_A :: [(String, String)] -> 'Source :> ()+source_A xs = addAttributes xs $ Child ()++spacer_ :: ('Spacer ?> a) => a -> 'Spacer > a+spacer_ = Child++spacer_A :: ('Spacer ?> a) => [(String, String)] -> a -> 'Spacer :> a+spacer_A xs = addAttributes xs . Child++span_ :: ('Span ?> a) => a -> 'Span > a+span_ = Child++span_A :: ('Span ?> a) => [(String, String)] -> a -> 'Span :> a+span_A xs = addAttributes xs . Child++strike_ :: ('Strike ?> a) => a -> 'Strike > a+strike_ = Child++strike_A :: ('Strike ?> a) => [(String, String)] -> a -> 'Strike :> a+strike_A xs = addAttributes xs . Child++strong_ :: ('Strong ?> a) => a -> 'Strong > a+strong_ = Child++strong_A :: ('Strong ?> a) => [(String, String)] -> a -> 'Strong :> a+strong_A xs = addAttributes xs . Child++style_ :: ('Style ?> a) => a -> 'Style > a+style_ = Child++style_A :: ('Style ?> a) => [(String, String)] -> a -> 'Style :> a+style_A xs = addAttributes xs . Child++sub_ :: ('Sub ?> a) => a -> 'Sub > a+sub_ = Child++sub_A :: ('Sub ?> a) => [(String, String)] -> a -> 'Sub :> a+sub_A xs = addAttributes xs . Child++summary_ :: ('Summary ?> a) => a -> 'Summary > a+summary_ = Child++summary_A :: ('Summary ?> a) => [(String, String)] -> a -> 'Summary :> a+summary_A xs = addAttributes xs . Child++sup_ :: ('Sup ?> a) => a -> 'Sup > a+sup_ = Child++sup_A :: ('Sup ?> a) => [(String, String)] -> a -> 'Sup :> a+sup_A xs = addAttributes xs . Child++svg_ :: ('Svg ?> a) => a -> 'Svg > a+svg_ = Child++svg_A :: ('Svg ?> a) => [(String, String)] -> a -> 'Svg :> a+svg_A xs = addAttributes xs . Child++table_ :: ('Table ?> a) => a -> 'Table > a+table_ = Child++table_A :: ('Table ?> a) => [(String, String)] -> a -> 'Table :> a+table_A xs = addAttributes xs . Child++tbody_ :: ('Tbody ?> a) => a -> 'Tbody > a+tbody_ = Child++tbody_A :: ('Tbody ?> a) => [(String, String)] -> a -> 'Tbody :> a+tbody_A xs = addAttributes xs . Child++td_ :: ('Td ?> a) => a -> 'Td > a+td_ = Child++td_A :: ('Td ?> a) => [(String, String)] -> a -> 'Td :> a+td_A xs = addAttributes xs . Child++template_ :: ('Template ?> a) => a -> 'Template > a+template_ = Child++template_A :: ('Template ?> a) => [(String, String)] -> a -> 'Template :> a+template_A xs = addAttributes xs . Child++textarea_ :: ('Textarea ?> a) => a -> 'Textarea > a+textarea_ = Child++textarea_A :: ('Textarea ?> a) => [(String, String)] -> a -> 'Textarea :> a+textarea_A xs = addAttributes xs . Child++tfoot_ :: ('Tfoot ?> a) => a -> 'Tfoot > a+tfoot_ = Child++tfoot_A :: ('Tfoot ?> a) => [(String, String)] -> a -> 'Tfoot :> a+tfoot_A xs = addAttributes xs . Child++th_ :: ('Th ?> a) => a -> 'Th > a+th_ = Child++th_A :: ('Th ?> a) => [(String, String)] -> a -> 'Th :> a+th_A xs = addAttributes xs . Child++thead_ :: ('Thead ?> a) => a -> 'Thead > a+thead_ = Child++thead_A :: ('Thead ?> a) => [(String, String)] -> a -> 'Thead :> a+thead_A xs = addAttributes xs . Child++time_ :: ('Time ?> a) => a -> 'Time > a+time_ = Child++time_A :: ('Time ?> a) => [(String, String)] -> a -> 'Time :> a+time_A xs = addAttributes xs . Child++title_ :: ('Title ?> a) => a -> 'Title > a+title_ = Child++title_A :: ('Title ?> a) => [(String, String)] -> a -> 'Title :> a+title_A xs = addAttributes xs . Child++tr_ :: ('Tr ?> a) => a -> 'Tr > a+tr_ = Child++tr_A :: ('Tr ?> a) => [(String, String)] -> a -> 'Tr :> a+tr_A xs = addAttributes xs . Child++track_ :: 'Track > ()+track_ = Child ()++track_A :: [(String, String)] -> 'Track :> ()+track_A xs = addAttributes xs $ Child ()++tt_ :: ('Tt ?> a) => a -> 'Tt > a+tt_ = Child++tt_A :: ('Tt ?> a) => [(String, String)] -> a -> 'Tt :> a+tt_A xs = addAttributes xs . Child++u_ :: ('U ?> a) => a -> 'U > a+u_ = Child++u_A :: ('U ?> a) => [(String, String)] -> a -> 'U :> a+u_A xs = addAttributes xs . Child++ul_ :: ('Ul ?> a) => a -> 'Ul > a+ul_ = Child++ul_A :: ('Ul ?> a) => [(String, String)] -> a -> 'Ul :> a+ul_A xs = addAttributes xs . Child++var_ :: ('Var ?> a) => a -> 'Var > a+var_ = Child++var_A :: ('Var ?> a) => [(String, String)] -> a -> 'Var :> a+var_A xs = addAttributes xs . Child++video_ :: ('Video ?> a) => a -> 'Video > a+video_ = Child++video_A :: ('Video ?> a) => [(String, String)] -> a -> 'Video :> a+video_A xs = addAttributes xs . Child++wbr_ :: 'Wbr > ()+wbr_ = Child ()++wbr_A :: [(String, String)] -> 'Wbr :> ()+wbr_A xs = addAttributes xs $ Child ()++xmp_ :: ('Xmp ?> a) => a -> 'Xmp > a+xmp_ = Child++xmp_A :: ('Xmp ?> a) => [(String, String)] -> a -> 'Xmp :> a+xmp_A xs = addAttributes xs . Child
+ src/Html/Function.hs view
@@ -0,0 +1,422 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE DataKinds            #-}++module Html.Function where++import Html.Type++import GHC.Exts+import GHC.TypeLits+import Data.Proxy+import Data.Monoid hiding (Last)++import qualified Data.Text                  as T+import qualified Data.Text.Lazy             as LT+import qualified Data.Text.Lazy.Builder     as TLB++-- | Render a html document.  The resulting type can be a String,+-- strict Text, lazy Text, or Builder.  For performance it is+-- recommended to use a lazy Text or a Builder.+--+-- >>> render "a" :: String+-- "a"+--+-- >>> render (div_ "a") :: Text+-- "<div>a</div>"+--+-- For prototyping, there's as well a Show instance:+--+-- >>> i_ "a"+-- <i>a</i>+--+-- Please note the extra quotes for String when using show:+--+-- >>> show "a" == render "a"+-- False+--+-- >>> show img_ == render img_+-- True++{-# INLINE render #-}+render :: forall a b.+  ( Document a+  , Escape b+  , Monoid b+  , IsString b+  ) => a -> b+render x = render_ (Tagged x :: Tagged (Symbols a) a ())++  -------------------+  -- internal code --+  -------------------++type Document a =+  ( Renderchunks (Tagged (Symbols a) a ())+  , Renderstring (Tagged (Symbols a) a ())+  , KnownSymbol (Last' (Symbols a))+  )++{-# RULES+"render_/renderB"  render_ = renderB+"render_/renderS"  render_ = renderS+"render_/renderLT" render_ = renderLT+#-}++{-# INLINE [2] render_ #-}+render_ :: forall b prox val nex.+  ( KnownSymbol (Last' prox)+  , Renderstring (Tagged prox val nex)+  , Renderchunks (Tagged prox val nex)+  , Escape b+  , Monoid b+  , IsString b+  ) => Tagged prox val nex -> b+render_ x = mconcat $ renderchunks x ++ [closing]+  where closing = convert (Proxy :: Proxy (Last' prox))++{-# INLINE renderLT #-}+renderLT :: forall prox val nex.+  ( KnownSymbol (Last' prox)+  , Renderchunks (Tagged prox val nex)+  ) => Tagged prox val nex -> LT.Text+renderLT x = mconcat $ renderchunks x ++ [closing]+  where closing = convert (Proxy :: Proxy (Last' prox))++{-# INLINE renderS #-}+renderS :: forall prox val nex.+  ( KnownSymbol (Last' prox)+  , Renderchunks (Tagged prox val nex)+  ) => Tagged prox val nex -> String+renderS x = foldr (<>) closing $ renderchunks x+  where closing = convert (Proxy :: Proxy (Last' prox))++{-# INLINE renderB #-}+renderB :: forall prox val nex.+  ( KnownSymbol (Last' prox)+  , Renderstring (Tagged prox val nex)+  ) => Tagged prox val nex -> TLB.Builder+renderB x = renderstring x <> closing+  where closing = convert (Proxy :: Proxy (Last' prox))++{-# INLINE addAttributes #-}+addAttributes :: (a ?> b) => [(String, String)] -> (a > b) -> (a :> b)+addAttributes xs (Child b) = WithAttributes (Attributes xs) b++class Renderchunks a where+  renderchunks :: (Escape b, IsString b, Monoid b) => a -> [b]++instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a) nex) where+  {-# INLINE renderchunks #-}+  renderchunks _ = []++instance {-# OVERLAPPABLE #-}+  ( Convert val+  , KnownSymbol (HeadL prox)+  ) => Renderchunks (Tagged prox val nex) where+  {-# INLINE renderchunks #-}+  renderchunks (Tagged x)+    = convert (Proxy :: Proxy (HeadL prox))+    : [convert x]++instance Renderchunks (Tagged prox () nex) where+  {-# INLINE renderchunks #-}+  renderchunks _ = []++instance+  ( Renderchunks (Tagged (Take (CountContent a) prox) a b)+  , Renderchunks (Tagged (Drop (CountContent a) prox) b nex)+  ) => Renderchunks (Tagged prox (a # b) nex) where+  {-# INLINE renderchunks #-}+  renderchunks ~(Tagged (a :#: b))+    = renderchunks (Tagged a :: Tagged (Take (CountContent a) prox) a b)+    <> renderchunks (Tagged b :: Tagged (Drop (CountContent a) prox) b nex)++instance {-# OVERLAPPING #-}+  ( Renderchunks (Tagged (Drop 1 prox) (a > b) nex)+  , KnownSymbol (HeadL prox)+  , a ?> b+  ) => Renderchunks (Tagged prox (a :> b) nex) where+  {-# INLINE renderchunks #-}+  renderchunks ~(Tagged (WithAttributes a b))+    = convert (Proxy :: Proxy (HeadL prox))+    : convert a+    : renderchunks (Tagged (Child b) :: Tagged (Drop 1 prox) (a > b) nex)++instance+  ( Renderchunks (Tagged prox b (Close a))+  ) => Renderchunks (Tagged prox (a > b) nex) where+  {-# INLINE renderchunks #-}+  renderchunks ~(Tagged (Child b))+    = renderchunks (Tagged b :: Tagged prox b (Close a))++instance+  ( Renderchunks (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ())+  , KnownSymbol (Last' (Symbols (Next (a :> b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderchunks (Tagged prox [a :> b] nex) where+  {-# INLINE renderchunks #-}+  renderchunks (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    : concatMap+       (\x -> renderchunks+          (Tagged x :: Tagged (Symbols (Next (a :> b) nex)) (a :> b) ())+          ++ [closing]+       ) xs+    where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a :> b) nex))))++instance+  ( Renderchunks (Tagged (Symbols (Next (a > b) nex)) (a > b) ())+  , KnownSymbol (Last' (Symbols (Next (a > b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderchunks (Tagged prox [a > b] nex) where+  {-# INLINE renderchunks #-}+  renderchunks (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    : concatMap+       (\x -> renderchunks+          (Tagged x :: Tagged (Symbols (Next (a > b) nex)) (a > b) ())+          ++ [closing]+       ) xs+    where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a > b) nex))))++instance+  ( Renderchunks (Tagged (Symbols (Next (a # b) nex)) (a # b) ())+  , KnownSymbol (Last' (Symbols (Next (a # b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderchunks (Tagged prox [a # b] nex) where+  {-# INLINE renderchunks #-}+  renderchunks (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    : concatMap+       (\x -> renderchunks+          (Tagged x :: Tagged (Symbols (Next (a # b) nex)) (a # b) ())+          ++ [closing]+       ) xs+    where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a # b) nex))))++class Renderstring a where+  renderstring :: (Escape b, IsString b, Monoid b) => a -> b++instance KnownSymbol a => Renderstring (Tagged prox (Proxy a) nex) where+  {-# INLINE renderstring #-}+  renderstring _ = mempty++instance {-# OVERLAPPABLE #-}+  ( Convert val+  , KnownSymbol (HeadL prox)+  ) => Renderstring (Tagged prox val nex) where+  {-# INLINE renderstring #-}+  renderstring (Tagged x)+    = convert (undefined :: Proxy (HeadL prox))+    <> convert x++instance Renderstring (Tagged prox () nex) where+  {-# INLINE renderstring #-}+  renderstring _ = mempty++instance+  ( Renderstring (Tagged (Take (CountContent a) prox) a b)+  , Renderstring (Tagged (Drop (CountContent a) prox) b nex)+  ) => Renderstring (Tagged prox (a # b) nex) where+  {-# INLINE renderstring #-}+  renderstring ~(Tagged (a :#: b))+    = renderstring (Tagged a :: Tagged (Take (CountContent a) prox) a b)+    <> renderstring (Tagged b :: Tagged (Drop (CountContent a) prox) b nex)++instance {-# OVERLAPPING #-}+  ( Renderstring (Tagged (Drop 1 prox) (a > b) nex)+  , KnownSymbol (HeadL prox)+  , a ?> b+  ) => Renderstring (Tagged prox (a :> b) nex) where+  {-# INLINE renderstring #-}+  renderstring ~(Tagged (WithAttributes a b))+    = convert (Proxy :: Proxy (HeadL prox))+    <> convert a+    <> renderstring (Tagged (Child b) :: Tagged (Drop 1 prox) (a > b) nex)++instance+  ( Renderstring (Tagged prox b (Close a))+  ) => Renderstring (Tagged prox (a > b) nex) where+  {-# INLINE renderstring #-}+  renderstring ~(Tagged (Child b))+    = renderstring (Tagged b :: Tagged prox b (Close a))++instance+  ( Renderstring (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ())+  , Renderchunks (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ())+  , KnownSymbol (Last' (Symbols (Next (a :> b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderstring (Tagged prox [a :> b] nex) where+  {-# INLINE renderstring #-}+  renderstring (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    <> foldMap+       (\x ->+          render_+          (Tagged x :: Tagged (Symbols (Next (a :> b) nex)) (a :> b) ())+       ) xs++instance+  ( Renderstring (Tagged (Symbols (Next (a > b) nex)) (a > b) ())+  , Renderchunks (Tagged (Symbols (Next (a > b) nex)) (a > b) ())+  , KnownSymbol (Last' (Symbols (Next (a > b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderstring (Tagged prox [a > b] nex) where+  {-# INLINE renderstring #-}+  renderstring (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    <> foldMap+       (\x ->+          render_+          (Tagged x :: Tagged (Symbols (Next (a > b) nex)) (a > b) ())+       ) xs++instance+  ( Renderstring (Tagged (Symbols (Next (a # b) nex)) (a # b) ())+  , Renderchunks (Tagged (Symbols (Next (a # b) nex)) (a # b) ())+  , KnownSymbol (Last' (Symbols (Next (a # b) nex)))+  , KnownSymbol (HeadL prox)+  ) => Renderstring (Tagged prox [a # b] nex) where+  {-# INLINE renderstring #-}+  renderstring (Tagged xs)+    = convert (undefined :: Proxy (HeadL prox))+    <> foldMap+       (\x ->+          render_+          (Tagged x :: Tagged (Symbols (Next (a # b) nex)) (a # b) ())+       ) xs++{-# RULES+"fromString_/builder" fromString_ = TLB.fromLazyText . LT.pack+  #-}++{-# INLINE [2] fromString_ #-}+fromString_ :: IsString a => String -> a+fromString_ = fromString++{-# RULES+"convert/a/a"                   forall f. convert_ f = escape+"convert/string/builder"        forall f. convert_ f = TLB.fromLazyText . escape . LT.pack+"convert/lazy text/builder"     forall f. convert_ f = TLB.fromLazyText . escape+"convert/strict text/builder"   forall f. convert_ f = TLB.fromText . escape+"convert/builder/lazy text"     forall f. convert_ f = escape . TLB.toLazyText+"convert/lazy text/strict text" forall f. convert_ f = LT.toStrict . escape+"convert/strict text/lazy text" forall f. convert_ f = escape . LT.fromStrict+  #-}++{-# INLINE [1] convert_ #-}+convert_ :: (Escape b, IsString a, IsString b) => (a -> b) -> (a -> b)+convert_ f = escape . f++class (IsString a, Monoid a) => Escape a where+  escape :: a -> a++instance Escape TLB.Builder where++  escape+    = TLB.fromLazyText+    . escape+    . TLB.toLazyText++instance Escape T.Text where++  escape = T.foldr f mempty+    where+      f '<'  b = "&lt;"        <> b+      f '>'  b = "&gt;"        <> b+      f '&'  b = "&amp;"       <> b+      f '"'  b = "&quot;"      <> b+      f '\'' b = "&#39;"       <> b+      f x    b = T.singleton x <> b++instance Escape LT.Text where++  escape = foldr (<>) "" . LT.foldr f []+    where+      f '<'  b = "&lt;"         : b+      f '>'  b = "&gt;"         : b+      f '&'  b = "&amp;"        : b+      f '"'  b = "&quot;"       : b+      f '\'' b = "&#39;"        : b+      f x    b = LT.singleton x : b++instance Escape String where++  escape = concatMap f+    where+      f '<'  = "&lt;"+      f '>'  = "&gt;"+      f '&'  = "&amp;"+      f '"'  = "&quot;"+      f '\'' = "&#39;"+      f x    = [x]++-- | Convert something to a target stringlike thing.+class Convert a where+  convert :: (Escape b, IsString b, Monoid b) => a -> b++instance KnownSymbol a => Convert (Proxy a) where+  {-# INLINE convert #-}+  convert = fromString_ . symbolVal++instance Convert a => Convert (Maybe a) where+  {-# INLINE convert #-}+  convert Nothing = ""+  convert (Just x) = convert x++instance Convert Attributes where+  {-# INLINE convert #-}+  convert ~(Attributes xs) = fromString $ concat [ ' ' : a ++ "=\"" ++ escape b ++ "\"" | (a,b) <- xs]++instance Convert String where+  {-# INLINE convert #-}+  convert = convert_ fromString++instance Convert T.Text where+  {-# INLINE convert #-}+  convert = convert_ (fromString . T.unpack)++instance Convert LT.Text where+  {-# INLINE convert #-}+  convert = convert_ (fromString . LT.unpack)++instance Convert TLB.Builder where+  {-# INLINE convert #-}+  convert = convert_ (fromString . LT.unpack . TLB.toLazyText)++instance Convert Int where+  {-# INLINE convert #-}+  convert = fromString . show++instance Convert Integer where+  {-# INLINE convert #-}+  convert = fromString . show++instance Convert Float where+  {-# INLINE convert #-}+  convert = fromString . show++instance Convert Double where+  {-# INLINE convert #-}+  convert = fromString . show++instance Convert Word where+  {-# INLINE convert #-}+  convert = fromString . show++-- | Orphan show instances to faciliate ghci development.+instance                     Document (a # b)  => Show (a # b)  where show = render+instance {-# OVERLAPPING #-} Document [a # b]  => Show [a # b]  where show = render+instance                     Document (a > b)  => Show (a > b)  where show = render+instance {-# OVERLAPPING #-} Document [a > b]  => Show [a > b]  where show = render+instance                     Document (a :> b) => Show (a :> b) where show = render+instance {-# OVERLAPPING #-} Document [a :> b] => Show [a :> b] where show = render
+ src/Html/Type.hs view
@@ -0,0 +1,1208 @@+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}++{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE GADTs                #-}++module Html.Type where++import GHC.TypeLits+import GHC.Exts+import Data.Proxy+import Data.Type.Bool++{-# DEPRECATED++  Acronym   ,+  Applet    ,+  Basefont  ,+  Big       ,+  Blink     ,+  Center    ,+  Command   ,+  Content   ,+  Dir       ,+  Font      ,+  Frame     ,+  Frameset  ,+  Isindex   ,+  Keygen    ,+  Listing   ,+  Marquee   ,+  Multicol  ,+  Noembed   ,+  Plaintext ,+  Shadow    ,+  Spacer    ,+  Strike    ,+  Tt        ,+  Xmp       ,+  Nextid++ "This is an obsolete html element and should not be used." #-}++-- | The data type of all html elements and the kind of elements.+data Element+  = DOCTYPE++  | A+  | Abbr+  | Acronym+  | Address+  | Applet+  | Area+  | Article+  | Aside+  | Audio+  | B+  | Base+  | Basefont+  | Bdi+  | Bdo+  | Bgsound+  | Big+  | Blink+  | Blockquote+  | Body+  | Br+  | Button+  | Canvas+  | Caption+  | Center+  | Cite+  | Code+  | Col+  | Colgroup+  | Command+  | Content+  | Data+  | Datalist+  | Dd+  | Del+  | Details+  | Dfn+  | Dialog+  | Dir+  | Div+  | Dl+  | Dt+  | Element+  | Em+  | Embed+  | Fieldset+  | Figcaption+  | Figure+  | Font+  | Footer+  | Form+  | Frame+  | Frameset+  | H1+  | H2+  | H3+  | H4+  | H5+  | H6+  | Head+  | Header+  | Hgroup+  | Hr+  | Html+  | I+  | Iframe+  | Image+  | Img+  | Input+  | Ins+  | Isindex+  | Kbd+  | Keygen+  | Label+  | Legend+  | Li+  | Link+  | Listing+  | Main+  | Map+  | Mark+  | Marquee+  | Math+  | Menu+  | Menuitem+  | Meta+  | Meter+  | Multicol+  | Nav+  | Nextid+  | Nobr+  | Noembed+  | Noframes+  | Noscript+  | Object+  | Ol+  | Optgroup+  | Option+  | Output+  | P+  | Param+  | Picture+  | Plaintext+  | Pre+  | Progress+  | Q+  | Rp+  | Rt+  | Rtc+  | Ruby+  | S+  | Samp+  | Script+  | Section+  | Select+  | Shadow+  | Slot+  | Small+  | Source+  | Spacer+  | Span+  | Strike+  | Strong+  | Style+  | Sub+  | Summary+  | Sup+  | Svg+  | Table+  | Tbody+  | Td+  | Template+  | Textarea+  | Tfoot+  | Th+  | Thead+  | Time+  | Title+  | Tr+  | Track+  | Tt+  | U+  | Ul+  | Var+  | Video+  | Wbr+  | Xmp++-- | Check whether `b` is a valid child of `a`.  You'll propably never+-- need to call this directly.  Through a GADT, it is enforced that+-- every child is lawful.+--+-- The only way to circumvent this would be to use 'undefined' or+-- 'error' in combination with only type level values.+--+-- >>> undefined :: 'Div > ('Html > ())+-- <div><html></html></div>+--+-- >>> undefined :: 'Div > ('Html > Proxy "a")+-- <div><html>a</html></div>+--+-- >>> undefined :: 'Div > ('Html > String)+-- <div><html>*** Exception: Prelude.undefined+type family (a :: Element) ?> b :: Constraint where+  a ?> (b # c)    = (a ?> b, a ?> c)+  a ?> (b > _)    = MaybeTypeError a b (TestPaternity (SingleElement b) (GetInfo a) (GetInfo b))+  a ?> (b :> _)   = MaybeTypeError a b (TestPaternity (SingleElement b) (GetInfo a) (GetInfo b))+  a ?> Maybe b    = a ?> b+  a ?> Either b c = (a ?> b, a ?> c)+  a ?> f (b > c)  = a ?> (b > c)+  a ?> f (b :> c) = a ?> (b > c)+  a ?> f (b # c)  = a ?> (b # c)+  a ?> ()         = ()+  a ?> (b -> c)   = (TypeError (Text "Html elements can't contain functions"))+  a ?> b          = CheckString a++-- | Combine two elements sequentially.+--+-- >>> render (i_ () # div_ ()) :: String+-- "<i></i><div></div>"+data (#) a b = (:#:) a b+(#) :: a -> b -> a # b+(#) = (:#:)+infixr 5 #++-- | Descend to a valid child of an element.+-- It is recommended to use the predefined elements.+--+-- >>> Child "a" :: 'Div > String+-- <div>a</div>+--+-- >>> div_ "a"+-- <div>a</div>+data (>) (a :: Element) b where+  Child :: (a ?> b) => b -> a > b+infixr 8 >++-- | Decorate an element with attributes and descend to a valid child.+--+-- >>> WithAttributes [("foo","bar")] "a" :: 'Div :> String+-- <div foo=bar>a</div>+data (:>) (a :: Element) b where+  WithAttributes :: (a ?> b) => Attributes -> b -> a :> b+infixr 8 :>++  -------------------+  -- internal code --+  -------------------++type family ShowElement e where+  ShowElement DOCTYPE    = "!DOCTYPE html"+  ShowElement A          = "a"+  ShowElement Abbr       = "abbr"+  ShowElement Acronym    = "acronym"+  ShowElement Address    = "address"+  ShowElement Applet     = "applet"+  ShowElement Area       = "area"+  ShowElement Article    = "article"+  ShowElement Aside      = "aside"+  ShowElement Audio      = "audio"+  ShowElement B          = "b"+  ShowElement Base       = "base"+  ShowElement Basefont   = "basefont"+  ShowElement Bdi        = "bdi"+  ShowElement Bdo        = "bdo"+  ShowElement Bgsound    = "bgsound"+  ShowElement Big        = "big"+  ShowElement Blink      = "blink"+  ShowElement Blockquote = "blockquote"+  ShowElement Body       = "body"+  ShowElement Br         = "br"+  ShowElement Button     = "button"+  ShowElement Canvas     = "canvas"+  ShowElement Caption    = "caption"+  ShowElement Center     = "center"+  ShowElement Cite       = "cite"+  ShowElement Code       = "code"+  ShowElement Col        = "col"+  ShowElement Colgroup   = "colgroup"+  ShowElement Command    = "command"+  ShowElement Content    = "content"+  ShowElement Data       = "data"+  ShowElement Datalist   = "datalist"+  ShowElement Dd         = "dd"+  ShowElement Del        = "del"+  ShowElement Details    = "details"+  ShowElement Dfn        = "dfn"+  ShowElement Dialog     = "dialog"+  ShowElement Dir        = "dir"+  ShowElement Div        = "div"+  ShowElement Dl         = "dl"+  ShowElement Dt         = "dt"+  ShowElement 'Element   = "element"+  ShowElement Em         = "em"+  ShowElement Embed      = "embed"+  ShowElement Fieldset   = "fieldset"+  ShowElement Figcaption = "figcaption"+  ShowElement Figure     = "figure"+  ShowElement Font       = "font"+  ShowElement Footer     = "footer"+  ShowElement Form       = "form"+  ShowElement Frame      = "frame"+  ShowElement Frameset   = "frameset"+  ShowElement H1         = "h1"+  ShowElement H2         = "h2"+  ShowElement H3         = "h3"+  ShowElement H4         = "h4"+  ShowElement H5         = "h5"+  ShowElement H6         = "h6"+  ShowElement Head       = "head"+  ShowElement Header     = "header"+  ShowElement Hgroup     = "hgroup"+  ShowElement Hr         = "hr"+  ShowElement Html       = "html"+  ShowElement I          = "i"+  ShowElement Iframe     = "iframe"+  ShowElement Image      = "image"+  ShowElement Img        = "img"+  ShowElement Input      = "input"+  ShowElement Ins        = "ins"+  ShowElement Isindex    = "isindex"+  ShowElement Kbd        = "kbd"+  ShowElement Keygen     = "keygen"+  ShowElement Label      = "label"+  ShowElement Legend     = "legend"+  ShowElement Li         = "li"+  ShowElement Link       = "link"+  ShowElement Listing    = "listing"+  ShowElement Main       = "main"+  ShowElement Map        = "map"+  ShowElement Mark       = "mark"+  ShowElement Marquee    = "marquee"+  ShowElement Math       = "math"+  ShowElement Menu       = "menu"+  ShowElement Menuitem   = "menuitem"+  ShowElement Meta       = "meta"+  ShowElement Meter      = "meter"+  ShowElement Multicol   = "multicol"+  ShowElement Nav        = "nav"+  ShowElement Nextid     = "nextid"+  ShowElement Nobr       = "nobr"+  ShowElement Noembed    = "noembed"+  ShowElement Noframes   = "noframes"+  ShowElement Noscript   = "noscript"+  ShowElement Object     = "object"+  ShowElement Ol         = "ol"+  ShowElement Optgroup   = "optgroup"+  ShowElement Option     = "option"+  ShowElement Output     = "output"+  ShowElement P          = "p"+  ShowElement Param      = "param"+  ShowElement Picture    = "picture"+  ShowElement Plaintext  = "plaintext"+  ShowElement Pre        = "pre"+  ShowElement Progress   = "progress"+  ShowElement Q          = "q"+  ShowElement Rp         = "rp"+  ShowElement Rt         = "rt"+  ShowElement Rtc        = "rtc"+  ShowElement Ruby       = "ruby"+  ShowElement S          = "s"+  ShowElement Samp       = "samp"+  ShowElement Script     = "script"+  ShowElement Section    = "section"+  ShowElement Select     = "select"+  ShowElement Shadow     = "shadow"+  ShowElement Slot       = "slot"+  ShowElement Small      = "small"+  ShowElement Source     = "source"+  ShowElement Spacer     = "spacer"+  ShowElement Span       = "span"+  ShowElement Strike     = "strike"+  ShowElement Strong     = "strong"+  ShowElement Style      = "style"+  ShowElement Sub        = "sub"+  ShowElement Summary    = "summary"+  ShowElement Sup        = "sup"+  ShowElement Svg        = "svg"+  ShowElement Table      = "table"+  ShowElement Tbody      = "tbody"+  ShowElement Td         = "td"+  ShowElement Template   = "template"+  ShowElement Textarea   = "textarea"+  ShowElement Tfoot      = "tfoot"+  ShowElement Th         = "th"+  ShowElement Thead      = "thead"+  ShowElement Time       = "time"+  ShowElement Title      = "title"+  ShowElement Tr         = "tr"+  ShowElement Track      = "track"+  ShowElement Tt         = "tt"+  ShowElement U          = "u"+  ShowElement Ul         = "ul"+  ShowElement Var        = "var"+  ShowElement Video      = "video"+  ShowElement Wbr        = "wbr"+  ShowElement Xmp        = "xmp"++type family OpenTag e where+  OpenTag e = AppendSymbol (AppendSymbol "<" (ShowElement e)) ">"++type family CloseTag e where+  CloseTag e = AppendSymbol (AppendSymbol "</" (ShowElement e)) ">"++type family CountContent c where+  CountContent (a # b)  = CountContent a + CountContent b+  CountContent (a > b)  = CountContent b+  CountContent (a :> b) = 1 + CountContent b+  CountContent ()       = 0+  CountContent _        = 1++-- | Flatten a html tree of elements into a type list of tags.+type family ToTypeList a where+  ToTypeList (Next val nex) = Next (ToTypeList val) (ToTypeList nex)+  ToTypeList (a # b)        = Append (ToTypeList a) (ToTypeList b)+  ToTypeList (a > ())       = If (HasContent (GetInfo a)) (Open a, Close a) (Open a)+  ToTypeList (a :> ())      = If (HasContent (GetInfo a)) (OpenAttr a, (Attributes, (EndOfOpen, Close a))) (OpenAttr a, (Attributes, EndOfOpen))+  ToTypeList (a > b)        = Append (Open a, ToTypeList b) (Close a)+  ToTypeList (a :> b)       = Append (OpenAttr a, (Attributes, (EndOfOpen, ToTypeList b))) (Close a)+  ToTypeList x              = x++-- | Append two type lists.+type family Append a b where+  Append (a, b) c = (a, Append b c)+  Append a      b = (a, b)++-- | Check whether an element may have content.+type family HasContent a where+  HasContent (ElementInfo _ NoContent _) = False+  HasContent _                           = True++-- | Remove omittable and empty tags from a type list of tags.+type family PruneTags a where+  PruneTags ((), a)      = PruneTags a+  PruneTags (a , ())     = PruneTags a+  PruneTags (Close a, b) = IsOmittable (GetInfo a) (Close a, b)+  PruneTags (Next a b)   = IsOmittableL (Head' (PruneTags a)) (PruneTags a) (Last (PruneTags a)) b+  PruneTags (a, b)       = (a, PruneTags b)+  PruneTags a            = a++data Next v nex++type family IsOmittableL head val last next where+  IsOmittableL (OpenAttr head) val (Close last) (Close next) = IsOmittable2 (Open head) val (GetInfo last) (Close next)+  IsOmittableL (Open head)     val (Close last) (Close next) = IsOmittable2 (Open head) val (GetInfo last) (Close next)++-- Base case+  IsOmittableL _head val _last next = val++type family IsOmittable2 head list last next where+  IsOmittable2+    (Open head)+    val+    (ElementInfo _ _ (LastChildOrFollowedBy (head ': _))) -- last+    (Close next)+    = Init val++  IsOmittable2+    (Open head)+    val+    (ElementInfo a b (LastChildOrFollowedBy (_ ': xs))) -- last+    (Close next)+    = IsOmittable2 (Open head) val (ElementInfo a b (LastChildOrFollowedBy xs)) (Close next)++-- Base case+  IsOmittable2+    _head+    val+    _last+    next+    = val++-- | Checks whether a tag is omittable.  Sadly, returning a kind Bool+-- would make the compiler loop, so we inline the if into the type+-- function.+type family IsOmittable a b where+  IsOmittable (ElementInfo _ _ RightOmission) (_,c)                                   = PruneTags c+  IsOmittable (ElementInfo _ _ (LastChildOrFollowedBy _)) (_,(Close b, c))            = PruneTags (Close b, c)+  IsOmittable (ElementInfo _ _ (LastChildOrFollowedBy _)) (_,Close b)                 = Close b+  IsOmittable (ElementInfo _ _ (LastChildOrFollowedBy '[])) (b,c)                     = (b, PruneTags c)+  IsOmittable (ElementInfo _ _ (LastChildOrFollowedBy (x ': _))) (c, (Open x, d))     = PruneTags (Open x, d)+  IsOmittable (ElementInfo _ _ (LastChildOrFollowedBy (x ': _))) (c, (OpenAttr x, d)) = PruneTags (OpenAttr x, d)+  IsOmittable (ElementInfo a b (LastChildOrFollowedBy (_ ': xs))) c                   = IsOmittable (ElementInfo a b (LastChildOrFollowedBy xs)) c+  IsOmittable _ (c,d)                                                                 = (c, PruneTags d)++-- | Convert tags to type level strings.+type family RenderTags a where+  RenderTags (a, b)       = (RenderTags a, RenderTags b)+  RenderTags (Open a)     = Proxy (OpenTag a)+  RenderTags (OpenAttr a) = Proxy (AppendSymbol "<" (ShowElement a))+  RenderTags (Close a)    = Proxy (CloseTag a)+  RenderTags EndOfOpen    = Proxy ">"+  RenderTags a            = a++-- | Fuse neighbouring type level strings.+type family Fuse a where+  Fuse (Proxy (a :: Symbol), (Proxy (b :: Symbol), c)) = Fuse (Proxy (AppendSymbol a b), c)+  Fuse (Proxy (a :: Symbol), Proxy (b :: Symbol))      = '[AppendSymbol a b]+  Fuse (Proxy (a :: Symbol), (b,c))                    =  a ': Fuse c+  Fuse (Proxy (a :: Symbol), b)                        = a ': Fuse b+  Fuse (Proxy (a :: Symbol))                           = '[a]+  Fuse (a, b)                                          = "" ': Fuse b+  Fuse a                                               = '[""]++type family Drop n xs :: [Symbol] where+  Drop 0 xs = xs+  Drop 1 (_ ': xs) = xs+  Drop 2 (_ ': _ ': xs) = xs+  Drop 3 (_ ': _ ': _ ': xs) = xs+  Drop 4 (_ ': _ ': _ ': _ ': xs) = xs+  Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs++type family Take n xs :: [Symbol] where+  Take 0 _ = '[]+  Take 1 (x1 ': _) = '[x1]+  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++-- | Init for type level lists.+type family Init xs where+  Init (a, (b, (c, d))) = (a, (b, Init (c, d)))+  Init (a, (b,c)) = (a, b)+  Init (a, b)     = a+  Init a          = a++-- | Last for type level lists.+type family Last a where+  Last (a, (b, (c, d))) = Last d+  Last (a, (b, c)) = c+  Last (a, b) = b+  Last a = a++-- | Last for type level lists.+type family Last' (xs :: [Symbol]) where+  Last' (_ ': _ ': _ ': _ ': x ': xs) = Last' (x ': xs)+  Last' (_ ': _ ': _ ': x ': xs) = x+  Last' (_ ': _ ': x ': xs) = x+  Last' (_ ': x ': xs) = x+  Last' (x ': xs) = x+  Last' _         = ""++-- | Head for type level lists.+type family Head' a where+  Head' (a, as) = a+  Head' a       = a++type family HeadL a :: Symbol where+  HeadL (a ': _) = a++-- | Utility types.+data EndOfOpen+data Open (a :: Element)+data OpenAttr (a :: Element)+data Close (a :: Element)+newtype Attributes = Attributes [(String, String)]++-- | Type of type level information about tags.+data ElementInfo+  (contentCategories :: [ContentCategory])+  (permittedContent  :: ContentCategory)+  (tagOmission       :: TagOmission)++-- | Kind describing whether it is valid to delete a closing tag.+data TagOmission+  = NoOmission+  | RightOmission+  | LastChildOrFollowedBy [Element]++type family TestPaternity a b c :: Bool where+  TestPaternity a (ElementInfo _ ps _) (ElementInfo cs _ _) = CheckContentCategory ps (a ': cs)++type family CheckContentCategory (a :: ContentCategory) (b :: [ContentCategory]) :: Bool where+  CheckContentCategory (a :|: b) c = CheckContentCategory a c || CheckContentCategory b c+  CheckContentCategory (a :&: b) c = CheckContentCategory a c && CheckContentCategory b c+  CheckContentCategory (NOT a) c   = Not (CheckContentCategory a c)+  CheckContentCategory a c         = Elem a c++-- | Check whether a given element may contain a string.+type family CheckString (a :: Element) where+  CheckString a = If (TestPaternity OnlyText (GetInfo a) (ElementInfo '[FlowContent, PhrasingContent] NoContent NoOmission))+                     (() :: Constraint)+                     (TypeError (ShowType a :<>: Text " can't contain a string"))++-- | Content categories according to the html spec.+data ContentCategory+  = MetadataContent+  | FlowContent+  | SectioningContent+  | HeadingContent+  | PhrasingContent+  | EmbeddedContent+  | InteractiveContent+  | FormAssociatedContent+  | TransparentContent+  | PalpableContent+  | SectioningRoot+  | (:|:) ContentCategory ContentCategory+  | (:&:) ContentCategory ContentCategory+  | NOT ContentCategory+  | NoContent+  | OnlyText+  | SingleElement Element++infixr 2 :|:+infixr 3 :&:++type family MaybeTypeError (a :: Element) (b :: Element) c where+  MaybeTypeError a b c = If c (() :: Constraint)+   (TypeError (ShowType b :<>: Text " is not a valid child of " :<>: ShowType a))++type family Elem (a :: ContentCategory) (xs :: [ContentCategory]) where+  Elem a (a : xs) = True+  Elem a (_ : xs) = Elem a xs+  Elem a '[]      = False++newtype Tagged (proxies :: [Symbol]) target (next :: *) = Tagged target++type Symbols a = Fuse (RenderTags (PruneTags (ToTypeList a)))++-- | Retrieve type level meta data about elements.+type family GetInfo a where++  GetInfo DOCTYPE = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo A = ElementInfo+    [ FlowContent, PhrasingContent, InteractiveContent, PalpableContent ]+    (TransparentContent :|: FlowContent :&: NOT InteractiveContent :|: PhrasingContent)+    NoOmission++  GetInfo Abbr = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Address = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :&: NOT (HeadingContent :|: SectioningContent :|: SingleElement Address :|: SingleElement Header :|: SingleElement Footer))+    NoOmission++  GetInfo Area = ElementInfo+    [ FlowContent, PhrasingContent ]+    NoContent+    RightOmission++  GetInfo Article = ElementInfo+    [ FlowContent, SectioningContent, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Aside = ElementInfo+    [ FlowContent, SectioningContent, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Audio = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+    (SingleElement Source :|: SingleElement Track :|: TransparentContent :&: NOT (SingleElement Audio :|: SingleElement Video))+    NoOmission++  GetInfo B = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Base = ElementInfo+    '[ MetadataContent ]+    NoContent+    RightOmission++  GetInfo Bdi = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Bdo = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Blockquote = ElementInfo+    [ FlowContent, SectioningRoot, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Body = ElementInfo+    '[ SectioningRoot ]+    FlowContent+    NoOmission -- complicated exceptions++  GetInfo Br = ElementInfo+    [ FlowContent, PhrasingContent ]+    NoContent+    RightOmission++  GetInfo Button = ElementInfo+    [ FlowContent, PhrasingContent, InteractiveContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Canvas = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent ]+    (TransparentContent :&: NOT InteractiveContent :|: SingleElement A :|: SingleElement Button :|: SingleElement Input)+    NoOmission++  GetInfo Caption = ElementInfo+    '[]+    FlowContent+    NoOmission++  GetInfo Cite = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Code = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Col = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo Colgroup = ElementInfo+    '[]+    (SingleElement Col)+    NoOmission -- complicated rules++  GetInfo Data = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Datalist = ElementInfo+    [ FlowContent, PhrasingContent ]+    (PhrasingContent :|: SingleElement Option)+    NoOmission++  GetInfo Dd = ElementInfo+    '[]+    FlowContent+    (LastChildOrFollowedBy '[Dd])++  GetInfo Del = ElementInfo+    [ FlowContent, PhrasingContent ]+    TransparentContent+    NoOmission++  GetInfo Details = ElementInfo+    [ FlowContent, SectioningRoot, InteractiveContent, PalpableContent ]+    ( SingleElement Summary :|: FlowContent)+    NoOmission++  GetInfo Dfn = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    (PhrasingContent :&: NOT (SingleElement Dfn))+    NoOmission++  GetInfo Dialog = ElementInfo+    [ FlowContent, SectioningRoot ]+    FlowContent+    NoOmission++  GetInfo Div = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :|: SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template)+    NoOmission++  GetInfo Dl = ElementInfo+    [ FlowContent, PalpableContent ]+    (SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template :|: SingleElement Div)+    NoOmission++  GetInfo Dt = ElementInfo+    '[]+    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent))+    (LastChildOrFollowedBy '[Dd]) -- really?++  GetInfo Em = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Embed = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+    NoContent+    RightOmission++  GetInfo Fieldset = ElementInfo+    [ FlowContent, SectioningRoot, FormAssociatedContent, PalpableContent ]+    (SingleElement Legend :|: FlowContent)+    NoOmission++  GetInfo Figcaption = ElementInfo+    '[]+    FlowContent+    NoOmission++  GetInfo Figure = ElementInfo+    [ FlowContent, SectioningRoot, PalpableContent ]+    (SingleElement Figcaption :|: FlowContent)+    NoOmission++  GetInfo Footer = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :&: NOT (SingleElement Footer :|: SingleElement Header))+    NoOmission++  GetInfo Form = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :&: NOT (SingleElement Form))+    NoOmission++  GetInfo H1 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo H2 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo H3 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo H4 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo H5 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo H6 = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Head = ElementInfo+    '[]+    (MetadataContent :|: SingleElement Title)+    NoOmission -- complicated++  GetInfo Header = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer))+    NoOmission++  GetInfo Hgroup = ElementInfo+    [ FlowContent, HeadingContent, PalpableContent ]+    (SingleElement H1 :|: SingleElement H2 :|: SingleElement H3 :|: SingleElement H4 :|: SingleElement H5 :|: SingleElement H6)+    NoOmission++  GetInfo Hr = ElementInfo+    '[ FlowContent ]+    NoContent+    RightOmission++  GetInfo Html = ElementInfo+    '[]+    (SingleElement Head :|: SingleElement Body)+    NoOmission -- complicated++  GetInfo I = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Iframe = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+    NoContent -- complicated+    NoOmission++  GetInfo Img = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent, InteractiveContent ]+    NoContent+    RightOmission++  GetInfo Ins = ElementInfo+    [ FlowContent, PhrasingContent ]+    TransparentContent+    NoOmission++  GetInfo Kbd = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Label = ElementInfo+    [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent, PalpableContent ]+    (PhrasingContent :&: NOT (SingleElement Label))+    NoOmission++  GetInfo Legend = ElementInfo+    '[]+    PhrasingContent+    NoOmission++  GetInfo Li = ElementInfo+    '[]+    FlowContent+    (LastChildOrFollowedBy '[Li]) -- if followed by li or no more content++  GetInfo Link = ElementInfo+    [ MetadataContent, FlowContent, PhrasingContent ]+    NoContent+    RightOmission++  GetInfo Main = ElementInfo+    [ FlowContent, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Map = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    TransparentContent+    NoOmission++  GetInfo Mark = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Menu = ElementInfo+    [ FlowContent, PalpableContent ]+    (FlowContent :|: SingleElement Li :|: SingleElement Script :|: SingleElement Template :|: SingleElement Menu :|: SingleElement Menuitem :|: SingleElement Hr)+    NoOmission++  GetInfo Menuitem = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo Meta = ElementInfo+    [ MetadataContent, FlowContent, PhrasingContent ]+    NoContent+    RightOmission++  GetInfo Meter = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    (PhrasingContent :&: NOT (SingleElement Meter))+    NoOmission++  GetInfo Nav = ElementInfo+    [ FlowContent, SectioningContent, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Noscript = ElementInfo+    [ MetadataContent, FlowContent, PhrasingContent ]+    (SingleElement Link :|: SingleElement Style :|: SingleElement Meta :|: TransparentContent :&: NOT (SingleElement Noscript) :|: FlowContent :|: PhrasingContent)+    NoOmission++  GetInfo Object = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, PalpableContent, InteractiveContent, FormAssociatedContent ]+    (SingleElement Param :|: TransparentContent)+    NoOmission++  GetInfo Ol = ElementInfo+    [ FlowContent, PalpableContent ]+    (SingleElement Li)+    NoOmission++  GetInfo Optgroup = ElementInfo+    '[]+    (SingleElement Option)+    (LastChildOrFollowedBy '[Optgroup])++  GetInfo Option = ElementInfo+    '[]+    OnlyText+    (LastChildOrFollowedBy '[Option, Optgroup])++  GetInfo Output = ElementInfo+    [ FlowContent, PhrasingContent, FormAssociatedContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo P = ElementInfo+    [ FlowContent, PalpableContent ]+    PhrasingContent+    (LastChildOrFollowedBy '[Address, Article, Aside, Blockquote, Div, Dl, Fieldset, Footer, Form, H1, H2, H3, H4, H5, H6, Header, Hr, Menu, Nav, Ol, Pre, Section, Table, Ul, P])+    -- And parent isn't <a>++  GetInfo Param = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo Picture = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent ]+    (SingleElement Source :|: SingleElement Img)+    NoOmission++  GetInfo Pre = ElementInfo+    [ FlowContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Progress = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    (PhrasingContent :&: NOT (SingleElement Progress))+    NoOmission++  GetInfo Q = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Rp = ElementInfo+    '[]+    OnlyText+    NoOmission++  GetInfo Rt = ElementInfo+    '[]+    PhrasingContent+    (LastChildOrFollowedBy '[Rt, Rp])++  GetInfo Rtc = ElementInfo+    '[]+    (PhrasingContent :|: SingleElement Rt)+    (LastChildOrFollowedBy '[Rtc, Rt])++  GetInfo Ruby = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo S = ElementInfo+    [ FlowContent, PhrasingContent ]+    PhrasingContent+    NoOmission++  GetInfo Samp = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Script = ElementInfo+    [ MetadataContent, FlowContent, PhrasingContent ]+    OnlyText+    NoOmission++  GetInfo Section = ElementInfo+    [ FlowContent, SectioningContent, PalpableContent ]+    FlowContent+    NoOmission++  GetInfo Select = ElementInfo+    [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent ]+    (SingleElement Option :|: SingleElement Optgroup)+    NoOmission++  GetInfo Slot = ElementInfo+    [ FlowContent, PhrasingContent ]+    TransparentContent+    NoOmission++  GetInfo Small = ElementInfo+    [ FlowContent, PhrasingContent ]+    PhrasingContent+    NoOmission++  GetInfo Source = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo Span = ElementInfo+    [ FlowContent, PhrasingContent ]+    PhrasingContent+    NoOmission++  GetInfo Strong = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Style = ElementInfo+    [ MetadataContent, FlowContent ]+    OnlyText+    NoOmission++  GetInfo Sub = ElementInfo+    [ FlowContent, PhrasingContent ]+    PhrasingContent+    NoOmission++  GetInfo Summary = ElementInfo+    '[]+    (PhrasingContent :|: HeadingContent)+    NoOmission++  GetInfo Sup = ElementInfo+    [ FlowContent, PhrasingContent ]+    PhrasingContent+    NoOmission++  GetInfo Table = ElementInfo+    '[FlowContent]+    (SingleElement Caption :|: SingleElement Colgroup :|: SingleElement Thead :|: SingleElement Tbody :|: SingleElement Tr :|: SingleElement Tfoot)+    NoOmission++  GetInfo Tbody = ElementInfo+    '[]+    (SingleElement Tr)+    NoOmission++  GetInfo Td = ElementInfo+    '[]+    FlowContent+    (LastChildOrFollowedBy '[Th, Td])++  GetInfo Template = ElementInfo+    [ MetadataContent, FlowContent, PhrasingContent ]+    (MetadataContent :|: FlowContent) -- complicated+    NoOmission++  GetInfo Textarea = ElementInfo+    [ FlowContent, PhrasingContent, InteractiveContent, FormAssociatedContent ]+    OnlyText+    NoOmission++  GetInfo Tfoot = ElementInfo+    '[]+    (SingleElement Tr)+    (LastChildOrFollowedBy '[])++  GetInfo Th = ElementInfo+    '[]+    (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent))+    (LastChildOrFollowedBy '[Th, Td])++  GetInfo Thead = ElementInfo+    '[]+    (SingleElement Tr)+    (LastChildOrFollowedBy '[Tbody, Tfoot])+    -- nearly++  GetInfo Time = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Title = ElementInfo+    '[ MetadataContent ]+    OnlyText+    NoOmission++  GetInfo Tr = ElementInfo+    '[]+    (SingleElement Td :|: SingleElement Th)+    (LastChildOrFollowedBy '[Tr])++  GetInfo Track = ElementInfo+    '[]+    NoContent+    RightOmission++  GetInfo U = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Ul = ElementInfo+    [ FlowContent, PalpableContent ]+    (SingleElement Li)+    NoOmission++  GetInfo Var = ElementInfo+    [ FlowContent, PhrasingContent, PalpableContent ]+    PhrasingContent+    NoOmission++  GetInfo Video = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+    (SingleElement Track :|: TransparentContent :&: NOT (SingleElement Audio :|: SingleElement Video) :|: SingleElement Source)+    NoOmission++  GetInfo Wbr = ElementInfo+    [ FlowContent, PhrasingContent ]+    NoContent+    RightOmission++  GetInfo _ = ElementInfo+    [ FlowContent, PhrasingContent, EmbeddedContent, InteractiveContent, PalpableContent ]+    (FlowContent :|: PhrasingContent :|: EmbeddedContent :|: InteractiveContent :|: PalpableContent)+    NoOmission
+ test/Main.hs view
@@ -0,0 +1,233 @@+{-# LANGUAGE TypeOperators    #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE DataKinds        #-}++module Main where++import Html+import Test.Hspec++import Data.Proxy++import qualified Data.Text as T+import qualified Data.Text.Lazy as LT+import qualified Data.Text.Lazy.Builder as LT++main :: IO ()+main = hspec spec++spec :: Spec+spec = let {-# INLINE allT #-}+           allT a b c = b (render a, render a, render a , render a       )+                          (c       , T.pack c, LT.pack c, LT.fromString c)++       in parallel $ do++  describe "render" $ do++    it "is id on empty string" $ do++      allT ""+        shouldBe+        ""++    it "handles single elements" $ do++      allT (div_ "a")+        shouldBe+        "<div>a</div>"++    it "handles nested elements" $ do++      allT (div_ (div_ "a"))+        shouldBe+        "<div><div>a</div></div>"++    it "handles parallel elements" $ do++      allT (div_ "a" # div_ "b")+        shouldBe+        "<div>a</div><div>b</div>"++    it "doesn't use closing tags for empty elements" $ do++      allT area_+        shouldBe+        "<area>"++      allT base_+        shouldBe+        "<base>"++      allT br_+        shouldBe+        "<br>"++      allT col_+        shouldBe+        "<col>"++      allT embed_+        shouldBe+        "<embed>"++      allT hr_+        shouldBe+        "<hr>"++      allT iframe_+        shouldBe+        "<iframe>"++      allT img_+        shouldBe+        "<img>"++      allT link_+        shouldBe+        "<link>"++      allT menuitem_+        shouldBe+        "<menuitem>"++      allT meta_+        shouldBe+        "<meta>"++      allT param_+        shouldBe+        "<param>"++      allT source_+        shouldBe+        "<source>"++      allT track_+        shouldBe+        "<track>"++      allT wbr_+        shouldBe+        "<wbr>"++    it "avoids optional closing tags" $ do++      -- The closing tag at the end is because we can't know what+      -- element will follow.++      allT (td_ () # td_ ())+        shouldBe+        "<td><td></td>"++      allT (tr_ $ td_ ())+        shouldBe+        "<tr><td></tr>"++      allT (table_ . tr_ $ td_ ())+        shouldBe+        "<table><tr><td></table>"++    it "handles trailing text" $ do++      allT (td_ "a" # "b")+        shouldBe+        "<td>a</td>b"++    it "handles a single compile time text" $ do++      allT (Proxy :: Proxy "a")+        shouldBe+        "a"++    it "handles trailing compile time text" $ do++      allT (div_ "a" # (Proxy :: Proxy "b"))+        shouldBe+        "<div>a</div>b"++    it "handles nested compile time text" $ do++      allT (div_ (Proxy :: Proxy "a"))+        shouldBe+        "<div>a</div>"++    it "handles an empty list" $ do++      allT (tail [td_ "a"])+        shouldBe+        ""++    it "handles a list with a single element" $ do++      allT [td_ "a"]+        shouldBe+        "<td>a</td>"++    it "handles tags in a list with parallel elements" $ do++      allT [td_ "a" # td_ "b"]+        shouldBe+        "<td>a<td>b</td>"++    it "handles tags in a list with parallel elements and a following tag" $ do++      pendingWith "This is a not yet implemented optimization"++      allT ([td_ "a" # td_ "b"] # td_ "c")+        shouldBe+        "<td>a<td>b<td>c</td>"++      allT ([td_ "a" # td_ "b"] # div_ "c")+        shouldBe+        "<td>a<td>b</td><div>c</div>"++      allT ([div_ "a" # td_ "b"] # td_ "c")+        shouldBe+        "<div>a</div><td>b</td><td>c</td>"++    it "handles tags in a list when the list is the last child" $ do++      allT (tr_ [td_ "a" # td_ "b"])+        shouldBe+        "<tr><td>a<td>b</tr>"++    it "handles nested lists" $ do++      allT (table_ [tr_ [td_ (4 :: Int)]])+        shouldBe+        "<table><tr><td>4</table>"++    it "handles tags before a list" $ do++      pendingWith "This is a not yet implemented optimization"++      allT (td_ "a" # [td_ "b"] # table_ ())+        shouldBe+        "<td>a</td><td>b</td><table></table>"++      allT (td_ "a" # [td_ "b"] # td_ "c")+        shouldBe+        "<td>a<td>b<td>c</td>"++    it "computes its result lazily" $ do++      take 5 (render (div_ (errorWithoutStackTrace "not lazy" :: String)))+        `shouldBe`+        "<div>"++      take 5 (render (errorWithoutStackTrace "not lazy" :: 'Img > ()))+        `shouldBe`+        "<img>"++      take 5 (render (errorWithoutStackTrace "not lazy" :: 'Div > String))+        `shouldBe`+        "<div>"++      take 12 (render (div_ "a" # (errorWithoutStackTrace "not lazy" :: String)))+        `shouldBe`+        "<div>a</div>"++      take 17 (render (div_ "a" # [img_ # (errorWithoutStackTrace "not lazy" :: String)]))+        `shouldBe`+        "<div>a</div><img>"
+ type-of-html.cabal view
@@ -0,0 +1,54 @@+name:                 type-of-html+version:              0.2.1.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+license-file:         LICENSE+author:               Florian Knupfer+maintainer:           fknupfer@gmail.com+homepage:             https://github.com/knupfer/type-of-html+tested-with:          GHC == 8.2.1+copyright:            2017, Florian Knupfer+category:             Language+build-type:           Simple+extra-source-files:   ChangeLog.md+                    , Readme.md+cabal-version:        >=1.10+source-repository     head+   Type: git+   Location: https://github.com/knupfer/type-of-html++library+  exposed-modules:    Html+  other-modules:      Html.Type+                    , Html.Element+                    , Html.Function+  hs-source-dirs:     src+  default-language:   Haskell2010+  ghc-options:        -Wall+  build-depends:      base >= 4.10 && < 4.11+                    , text++test-suite test+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     test+  ghc-options:        -Wall -threaded -O2 -rtsopts -with-rtsopts=-N+  default-language:   Haskell2010+  build-depends:      base >= 4.10 && < 4.11+                    , type-of-html+                    , hspec+                    , text++benchmark bench+  type:               exitcode-stdio-1.0+  main-is:            Main.hs+  hs-source-dirs:     bench+  ghc-options:        -Wall -O2+  default-language:   Haskell2010+  build-depends:      base >= 4.10 && < 4.11+                    , type-of-html+                    , text+                    , bytestring+                    , blaze-html+                    , criterion