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 +13/−0
- LICENSE +30/−0
- Readme.md +53/−0
- Setup.hs +2/−0
- bench/Main.hs +275/−0
- src/Html.hs +203/−0
- src/Html/Element.hs +888/−0
- src/Html/Function.hs +422/−0
- src/Html/Type.hs +1208/−0
- test/Main.hs +233/−0
- type-of-html.cabal +54/−0
+ 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 = "<" <> b+ f '>' b = ">" <> b+ f '&' b = "&" <> b+ f '"' b = """ <> b+ f '\'' b = "'" <> b+ f x b = T.singleton x <> b++instance Escape LT.Text where++ escape = foldr (<>) "" . LT.foldr f []+ where+ f '<' b = "<" : b+ f '>' b = ">" : b+ f '&' b = "&" : b+ f '"' b = """ : b+ f '\'' b = "'" : b+ f x b = LT.singleton x : b++instance Escape String where++ escape = concatMap f+ where+ f '<' = "<"+ f '>' = ">"+ f '&' = "&"+ f '"' = """+ f '\'' = "'"+ 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