diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,17 @@ # Revision history for type-of-html +## 0.5.0.0 -- 2017-09-12 + +* type attributes +* don't allow invalid attributes +* perf increase +* better compile times + +## 0.4.2.0 -- 2017-09-11 + +* don't remove omittable tags +* simplify internals + ## 0.4.0.0 -- 2017-09-09 * new api: attributes are now monoids diff --git a/Readme.md b/Readme.md --- a/Readme.md +++ b/Readme.md @@ -1,9 +1,9 @@ # Type of html -`Type of html` is a library for generating html in a highly performant -and type safe manner. +`Type of html` is a library for generating html in a highly +performant, modular and type safe manner. -Please read the documentation of the module: +Please look at the documentation of the module for an overview of the api: [Html](https://hackage.haskell.org/package/type-of-html/docs/Html.html) Note that you need at least ghc 8.2. @@ -13,14 +13,223 @@ Part of the html spec is encoded at the typelevel, turning a lot of mistakes into type errors. +Let's check out the /type safety/ in ghci: + +```haskell +>>> td_ (tr_ "a") + +: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") + +: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") + +>>> tr_ (td_ "a") +a +``` + +And + +```haskell +>>> td_A (A.coords_ "a") "b" + +:1:1: error: + • 'CoordsA is not a valid attribute of 'Td + • In the expression: td_A (A.coords_ "a") "b" + In an equation for ‘it’: it = td_A (A.coords_ "a") "b" + +>>> td_A (A.id_ "a") "b" +b +``` + +Every parent child relation of html elements is checked against the +specification of html and non conforming elements result in compile +errors. + +The same is true for html attributes. + +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 always allow content as if all relevant attributes are set. + +Never the less: these cases are seldom. In the vast majority of cases you're only allowed to construct valid html. +These restrictions aren't fundamental, they could be turned into compile time errors. Perhaps a future version will be even more strict. + +## Modularity + +Html documents are just ordinary haskell values which can be composed or abstracted over: + +```haskell +>>> let table = table_ . map (tr_ . map td_) +>>> :t table +table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]] +>>> table [["A","B"],["C"]] +
AB
C
+>>> import Data.Char +>>> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d'] +
a97
b98
c99
d100
+``` + +And here's an example module: + +```haskell +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} + +module Main where + +import Html + +import qualified Html.Attribute as A + +main :: IO () +main + = print + . page + $ map td_ [1..(10::Int)] + +page + :: 'Tr ?> a + => a + -> ('Div :@: ('ClassA := String # 'IdA := String)) + ( 'Div > String + # 'Div > String + # 'Table > 'Tr > a + ) +page tds = + div_A (A.class_ "qux" # A.id_ "baz") + ( 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. I strongly suggest +that you don't write signatures for bigger documents. + +All text will be automatically html escaped: + +```haskell +>>> i_ "&" +& + +>>> div_A (A.id_ ">") () +
+``` + +If you want to opt out, wrap your types into the 'Raw' +constructor. This will increase performance, but can be only used with +trusted input. You can use this e.g. to embed some blaze-html code +into type-of-html. + +```haskell +>>> i_ (Raw "") + +``` + ## 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. +`Type of html` is a lot faster than `blaze html` or than `lucid`. +Look at the following benchmarks: + +Remember this benchmark from blaze? + +![blaze](https://jaspervdj.be/blaze/images/benchmarks-bigtable.png) + +This is comparing blaze with type of html: + +![bench-324712b](https://user-images.githubusercontent.com/5609565/30344227-b4547230-9800-11e7-8c9d-6a8b8b5ab64d.png) + +To look at the exact code of this benchmark look [here](bench/Main.hs) +in the repo. The big table benchmark here is only a 4x4 table. Using +a 1000x10 table like on the blaze homepage yields even better relative +performance (~9 times faster), but would make the other benchmarks +unreadable. + +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 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 Addr#. All this happens at +compile time. At runtime we do only generate the content and append +Builders. + +For example, if you write: + ```haskell -example x = +renderText $ tr_ (td_ "test") +``` + +The compiler does optimize it to the following (well, unpackCString# +doesn't exist for Builder, so it's slightly more complicated): + +```haskell +decodeUtf8 $ toLazyByteString + ( Data.ByteString.Builder.unpackCString# ""# + <> escape (Data.Text.unpackCString# "test"#) + <> Data.ByteString.Builder.unpackCString# ""# + ) +``` + +If you write + +```haskell +renderBuilder $ div_ (div_ ()) +``` + +The compiler does optimize it to the following: + +```haskell +Data.ByteString.Builder.unpackCString# "
"# +``` + +This sort of compiletime optimization isn't for free, it'll increase +compilation times. + +## Comparision to lucid and blaze-html + +Advantages of 'type-of-html': +- more or less 5 times faster +- a lot higher type safety: a lot of invalid documents are not inhabited +- fewer dependencies + +Disadvantages of 'type-of-html': +- a bit noisy syntax (don't write types!) +- sometimes unusual type error messages +- compile times (1 min for a medium sized page, with -O0 only ~4sec) +- needs at least ghc 8.2 + +I'd generally recommend that you put your documents into an extra +module to avoid frequent recompilations. Additionally you can use +type-of-html within an blaze-html document and vice versa. This +allows you to gradually migrate, or only write the hotpath in a more +efficient representation. + +## Example usage + +```haskell +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + +module Main where + +import Html + +import Data.Text.Lazy.IO as TL + +main :: IO () +main = TL.putStrLn $ renderText example + +example = html_ ( body_ ( h1_ @@ -42,7 +251,6 @@ ) # div_ "d" ) - # i_ x ) # button_ (i_ "e") ) diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -13,7 +13,6 @@ import Data.String import Control.Monad import Criterion.Main -import Data.Monoid import Text.Blaze.Html5 ((!)) import Text.Blaze.Html.Renderer.Utf8 @@ -24,32 +23,32 @@ main :: IO () main = defaultMain [ bgroup "minimal" - [ bench "blaze.utf8" $ nf (renderHtml . blazeMinimal) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . minimal) "TEST" + [ bench "blaze-html" $ nf (renderHtml . blazeMinimal) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . minimal) "TEST" ] , bgroup "hello world" - [ bench "blaze.utf8" $ nf (renderHtml . blazeHelloWorld) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . helloWorld) "TEST" - ] - , bgroup "attributes short" - [ bench "blaze.utf8" $ nf (renderHtml . blazeAttrShort) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . attrShort) "TEST" + [ bench "blaze-html" $ nf (renderHtml . blazeHelloWorld) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . helloWorld) "TEST" ] , bgroup "attributes long" - [ bench "blaze.utf8" $ nf (renderHtml . blazeAttrLong) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . attrLong) "TEST" + [ bench "blaze-html" $ nf (renderHtml . blazeAttrLong) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . attrLong) "TEST" ] + , bgroup "attributes short" + [ bench "blaze-html" $ nf (renderHtml . blazeAttrShort) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . attrShort) "TEST" + ] , bgroup "big page" - [ bench "blaze.utf8" $ nf (renderHtml . blazeBigPage) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . bigPage) "TEST" + [ bench "blaze-html" $ nf (renderHtml . blazeBigPage) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . bigPage) "TEST" ] , bgroup "big page with attributes" - [ bench "blaze.utf8" $ nf (renderHtml . blazeBigPageA) (fromString "TEST") - , bench "bytestring" $ nf (renderByteString . bigPageA) "TEST" + [ bench "blaze-html" $ nf (renderHtml . blazeBigPageA) (fromString "TEST") + , bench "type-of-html" $ nf (renderByteString . bigPageA) "TEST" ] , bgroup "big table" - [ bench "blaze.utf8" $ nf (renderHtml . blazeBigTable) (4,4) - , bench "bytestring" $ nf (renderByteString . bigTable) (4,4) + [ bench "blaze-html" $ nf (renderHtml . blazeBigTable) (4,4) + , bench "type-of-html" $ nf (renderByteString . bigTable) (4,4) ] ] @@ -90,23 +89,39 @@ blazeAttrShort :: B.Html -> B.Html blazeAttrShort x - = B.i ! BA.accept (fromString "a") - $ B.i ! BA.acceptCharset (fromString "b") - $ B.i ! BA.accesskey (fromString "c") - $ B.i ! BA.action (fromString "d") - $ B.i ! BA.alt (fromString "f") - $ B.i ! BA.async (fromString "g") + = B.i ! BA.accesskey (fromString "a") + $ B.i ! BA.class_ (fromString "b") + $ B.i ! BA.contenteditable (fromString "c") + $ B.i ! BA.contextmenu (fromString "d") + $ B.i ! BA.dir (fromString "e") + $ B.i ! BA.draggable (fromString "f") + $ B.i ! BA.hidden (fromString "g") + $ B.i ! BA.id (fromString "h") + $ B.i ! BA.itemprop (fromString "i") + $ B.i ! BA.lang (fromString "j") + $ B.i ! BA.spellcheck (fromString "k") + $ B.i ! BA.style (fromString "l") + $ B.i ! BA.tabindex (fromString "m") + $ B.i ! BA.title (fromString "n") $ x blazeAttrLong :: B.Html -> B.Html blazeAttrLong x - = B.i ! BA.accept (fromString "a") - ! BA.acceptCharset (fromString "b") - ! BA.accesskey (fromString "c") - ! BA.action (fromString "d") - ! BA.alt (fromString "f") - ! BA.async (fromString "g") - $ x + = B.i ! BA.accesskey (fromString "a") + ! BA.class_ (fromString "b") + ! BA.contenteditable (fromString "c") + ! BA.contextmenu (fromString "d") + ! BA.dir (fromString "e") + ! BA.draggable (fromString "f") + ! BA.hidden (fromString "g") + ! BA.id (fromString "h") + ! BA.itemprop (fromString "i") + ! BA.lang (fromString "j") + ! BA.spellcheck (fromString "k") + ! BA.style (fromString "l") + ! BA.tabindex (fromString "m") + ! BA.title (fromString "n") + $ x blazeBigPageA :: B.Html -> B.Html blazeBigPageA x = @@ -182,22 +197,39 @@ ) ) -attrLong x = - i_A ( A.accept_ "a" - <> A.acceptcharset_ "b" - <> A.accesskey_ "c" - <> A.action_ "d" - <> A.alt_ "f" - <> A.async_ "g") x - attrShort x - = i_A (A.accept_ "a") - . i_A (A.acceptcharset_ "b") - . i_A (A.accesskey_ "c") - . i_A (A.action_ "d") - . i_A (A.alt_ "f") - $ i_A (A.async_ "g") x + = i_A (A.accesskey_ "a") + . i_A (A.class_ "b") + . i_A (A.contenteditable_ "c") + . i_A (A.contextmenu_ "d") + . i_A (A.dir_ "e") + . i_A (A.draggable_ "f") + . i_A (A.hidden_ "g") + . i_A (A.id_ "h") + . i_A (A.itemprop_ "i") + . i_A (A.lang_ "j") + . i_A (A.spellcheck_ "k") + . i_A (A.style_ "l") + . i_A (A.tabindex_ "m") + . i_A (A.title_ "n") + $ x +attrLong x = + i_A ( A.accesskey_ "a" + # A.class_ "b" + # A.contenteditable_ "c" + # A.contextmenu_ "d" + # A.dir_ "e" + # A.draggable_ "f" + # A.hidden_ "g" + # A.id_ "h" + # A.itemprop_ "i" + # A.lang_ "j" + # A.spellcheck_ "k" + # A.style_ "l" + # A.tabindex_ "m" + # A.title_ "n" + ) x bigPageA x = html_ diff --git a/src/Html.hs b/src/Html.hs --- a/src/Html.hs +++ b/src/Html.hs @@ -8,165 +8,22 @@ {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TypeOperators #-} -{-| type-of-html has three main goals: - -* Type safety - -* Modularity - -* Performance - -Let's check out the /type safety/ in ghci: - ->>> td_ (tr_ "a") - -: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") - -: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") - ->>> tr_ (td_ "a") -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 cases 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: - ->>> let table = table_ . map (tr_ . map td_) ->>> :t table -table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]] ->>> table [["A","B"],["C"]] -
AB
C
->>> import Data.Char ->>> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d'] -
a97
b98
c99
d100
- -And here's an example module - -@ -{\-\# LANGUAGE TypeOperators \#-\} -{\-\# LANGUAGE DataKinds \#-\} - -module Main where - -import Html - -import qualified Html.Attribute as A - -main :: IO () -main - = print - . page - $ map td_ [1..(10::Int)] - -page - :: 'Tr ?> a - => a - -> 'Div - :> ( 'Div > [Char] - # 'Div > [Char] - # 'Table > 'Tr > a - ) -page tds = - div_A (A.class_ "qux" <> A.id_ "baz") - ( 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. - -All text will be automatically html escaped: - ->>> i_ "&" -& - ->>> div_A (A.id_ ">") () -
- -If you want to opt out, wrap your types into the 'Raw' -constructor. This will increase performance, but can be only used with -trusted input. You can use this e.g. to embed some blaze-html code -into type-of-html. - ->>> i_ (Raw "") - - -Last and fast: /performance/! - -Don't look any further, there is no option for faster html -generation. type-of-html is up to 10 times faster than blaze-html, -which was 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: - -> renderText $ tr_ (td_ "test") - -The compiler does optimize it to the following (we don't know at -compile time if we need to escape the string): - -> mconcat [ Data.Text.Lazy.unpackCString# ""# -> , escape (Data.Text.Lazy.unpackCString# "test"#) -> , Data.Text.Lazy.unpackCString# ""#) -> ] - -If you write - -> renderText $ div_ (div_ ()) - -The compiler does optimize it to the following: - -> mconcat [ Data.Text.Lazy.unpackCString# "
"# ] - -Note that optional ending tags were chopped off (tr, td). This sort of -compiletime optimization isn't for free, it'll increase compilation times. - --} - module Html ( renderString , renderText , renderByteString , renderBuilder , type (>)(..) - , type (:>)(..) + , type (:@:)(..) , type (#)(..) , (#) , type (?>) + , type (??>) + , type (:=)(..) , Raw(..) , Convert(..) , Converted - , Attribute + , Attribute(..) , Element(..) , module Html.Element ) where @@ -180,9 +37,9 @@ import Html.Type -- | Orphan show instances to faciliate ghci development. -instance Document (a > b) => Show (a > b) where show = renderString -instance {-# OVERLAPPING #-} Document (a > b) => Show [a > b] where show = renderString -instance Document (a:> b) => Show (a:> b) where show = renderString -instance {-# OVERLAPPING #-} Document (a:> b) => Show [a:> b] where show = renderString -instance Document (a # b) => Show (a # b) where show = renderString -instance {-# OVERLAPPING #-} Document (a # b) => Show [a # b] where show = renderString +instance Document (a > b) => Show (a > b) where show = renderString +instance {-# OVERLAPPING #-} Document (a > b) => Show [a > b] where show = renderString +instance Document ((a :@: b) c) => Show ((a :@: b) c) where show = renderString +instance {-# OVERLAPPING #-} Document ((a :@: b) c) => Show [(a :@: b) c] where show = renderString +instance Document (a # b) => Show (a # b) where show = renderString +instance {-# OVERLAPPING #-} Document (a # b) => Show [a # b] where show = renderString diff --git a/src/Html/Attribute.hs b/src/Html/Attribute.hs --- a/src/Html/Attribute.hs +++ b/src/Html/Attribute.hs @@ -1,479 +1,357 @@ {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE MagicHash #-} +{-# LANGUAGE DataKinds #-} module Html.Attribute where -import Html.Convert import Html.Type -import Data.Semigroup -import Data.ByteString.Builder -import qualified Data.ByteString.Builder.Internal as U - -{-# INLINE accept_ #-} -accept_ :: Convert a => a -> Attribute -accept_ x = Attribute $ U.byteStringCopy (unsafe 9 " accept=\""#) <> unConv (convert x) <> char7 '"' +accept_ :: a -> 'AcceptA := a +accept_ = AT -{-# INLINE acceptcharset_ #-} -acceptcharset_ :: Convert a => a -> Attribute -acceptcharset_ x = Attribute $ U.byteStringCopy (unsafe 16 " acceptcharset=\""#) <> unConv (convert x) <> char7 '"' +acceptCharset_ :: a -> 'AcceptCharsetA := a +acceptCharset_ = AT -{-# INLINE accesskey_ #-} -accesskey_ :: Convert a => a -> Attribute -accesskey_ x = Attribute $ U.byteStringCopy (unsafe 12 " accesskey=\""#) <> unConv (convert x) <> char7 '"' +accesskey_ :: a -> 'AccesskeyA := a +accesskey_ = AT -{-# INLINE action_ #-} -action_ :: Convert a => a -> Attribute -action_ x = Attribute $ U.byteStringCopy (unsafe 9 " action=\""#) <> unConv (convert x) <> char7 '"' +action_ :: a -> 'ActionA := a +action_ = AT -{-# INLINE align_ #-} -align_ :: Convert a => a -> Attribute -align_ x = Attribute $ U.byteStringCopy (unsafe 8 " align=\""#) <> unConv (convert x) <> char7 '"' +align_ :: a -> 'AlignA := a +align_ = AT -{-# INLINE alt_ #-} -alt_ :: Convert a => a -> Attribute -alt_ x = Attribute $ U.byteStringCopy (unsafe 6 " alt=\""#) <> unConv (convert x) <> char7 '"' +alt_ :: a -> 'AltA := a +alt_ = AT -{-# INLINE async_ #-} -async_ :: Convert a => a -> Attribute -async_ x = Attribute $ U.byteStringCopy (unsafe 8 " async=\""#) <> unConv (convert x) <> char7 '"' +async_ :: a -> 'AsyncA := a +async_ = AT -{-# INLINE autocomplete_ #-} -autocomplete_ :: Convert a => a -> Attribute -autocomplete_ x = Attribute $ U.byteStringCopy (unsafe 15 " autocomplete=\""#) <> unConv (convert x) <> char7 '"' +autocomplete_ :: a -> 'AutocompleteA := a +autocomplete_ = AT -{-# INLINE autofocus_ #-} -autofocus_ :: Convert a => a -> Attribute -autofocus_ x = Attribute $ U.byteStringCopy (unsafe 12 " autofocus=\""#) <> unConv (convert x) <> char7 '"' +autofocus_ :: a -> 'AutofocusA := a +autofocus_ = AT -{-# INLINE autoplay_ #-} -autoplay_ :: Convert a => a -> Attribute -autoplay_ x = Attribute $ U.byteStringCopy (unsafe 11 " autoplay=\""#) <> unConv (convert x) <> char7 '"' +autoplay_ :: a -> 'AutoplayA := a +autoplay_ = AT -{-# INLINE autosave_ #-} -autosave_ :: Convert a => a -> Attribute -autosave_ x = Attribute $ U.byteStringCopy (unsafe 11 " autosave=\""#) <> unConv (convert x) <> char7 '"' +autosave_ :: a -> 'AutosaveA := a +autosave_ = AT -{-# INLINE bgcolor_ #-} -bgcolor_ :: Convert a => a -> Attribute -bgcolor_ x = Attribute $ U.byteStringCopy (unsafe 10 " bgcolor=\""#) <> unConv (convert x) <> char7 '"' +bgcolor_ :: a -> 'BgcolorA := a +bgcolor_ = AT -{-# INLINE border_ #-} -border_ :: Convert a => a -> Attribute -border_ x = Attribute $ U.byteStringCopy (unsafe 9 " border=\""#) <> unConv (convert x) <> char7 '"' +border_ :: a -> 'BorderA := a +border_ = AT -{-# INLINE buffered_ #-} -buffered_ :: Convert a => a -> Attribute -buffered_ x = Attribute $ U.byteStringCopy (unsafe 11 " buffered=\""#) <> unConv (convert x) <> char7 '"' +buffered_ :: a -> 'BufferedA := a +buffered_ = AT -{-# INLINE challenge_ #-} -challenge_ :: Convert a => a -> Attribute -challenge_ x = Attribute $ U.byteStringCopy (unsafe 12 " challenge=\""#) <> unConv (convert x) <> char7 '"' +challenge_ :: a -> 'ChallengeA := a +challenge_ = AT -{-# INLINE charset_ #-} -charset_ :: Convert a => a -> Attribute -charset_ x = Attribute $ U.byteStringCopy (unsafe 10 " charset=\""#) <> unConv (convert x) <> char7 '"' +charset_ :: a -> 'CharsetA := a +charset_ = AT -{-# INLINE checked_ #-} -checked_ :: Convert a => a -> Attribute -checked_ x = Attribute $ U.byteStringCopy (unsafe 10 " checked=\""#) <> unConv (convert x) <> char7 '"' +checked_ :: a -> 'CheckedA := a +checked_ = AT -{-# INLINE cite_ #-} -cite_ :: Convert a => a -> Attribute -cite_ x = Attribute $ U.byteStringCopy (unsafe 7 " cite=\""#) <> unConv (convert x) <> char7 '"' +cite_ :: a -> 'CiteA := a +cite_ = AT -{-# INLINE class_ #-} -class_ :: Convert a => a -> Attribute -class_ x = Attribute $ U.byteStringCopy (unsafe 8 " class=\""#) <> unConv (convert x) <> char7 '"' +class_ :: a -> 'ClassA := a +class_ = AT -{-# INLINE code_ #-} -code_ :: Convert a => a -> Attribute -code_ x = Attribute $ U.byteStringCopy (unsafe 7 " code=\""#) <> unConv (convert x) <> char7 '"' +code_ :: a -> 'CodeA := a +code_ = AT -{-# INLINE codebase_ #-} -codebase_ :: Convert a => a -> Attribute -codebase_ x = Attribute $ U.byteStringCopy (unsafe 11 " codebase=\""#) <> unConv (convert x) <> char7 '"' +codebase_ :: a -> 'CodebaseA := a +codebase_ = AT -{-# INLINE color_ #-} -color_ :: Convert a => a -> Attribute -color_ x = Attribute $ U.byteStringCopy (unsafe 8 " color=\""#) <> unConv (convert x) <> char7 '"' +color_ :: a -> 'ColorA := a +color_ = AT -{-# INLINE cols_ #-} -cols_ :: Convert a => a -> Attribute -cols_ x = Attribute $ U.byteStringCopy (unsafe 7 " cols=\""#) <> unConv (convert x) <> char7 '"' +cols_ :: a -> 'ColsA := a +cols_ = AT -{-# INLINE colspan_ #-} -colspan_ :: Convert a => a -> Attribute -colspan_ x = Attribute $ U.byteStringCopy (unsafe 10 " colspan=\""#) <> unConv (convert x) <> char7 '"' +colspan_ :: a -> 'ColspanA := a +colspan_ = AT -{-# INLINE content_ #-} -content_ :: Convert a => a -> Attribute -content_ x = Attribute $ U.byteStringCopy (unsafe 10 " content=\""#) <> unConv (convert x) <> char7 '"' +content_ :: a -> 'ContentA := a +content_ = AT -{-# INLINE contenteditable_ #-} -contenteditable_ :: Convert a => a -> Attribute -contenteditable_ x = Attribute $ U.byteStringCopy (unsafe 18 " contenteditable=\""#) <> unConv (convert x) <> char7 '"' +contenteditable_ :: a -> 'ContenteditableA := a +contenteditable_ = AT -{-# INLINE contextmenu_ #-} -contextmenu_ :: Convert a => a -> Attribute -contextmenu_ x = Attribute $ U.byteStringCopy (unsafe 14 " contextmenu=\""#) <> unConv (convert x) <> char7 '"' +contextmenu_ :: a -> 'ContextmenuA := a +contextmenu_ = AT -{-# INLINE controls_ #-} -controls_ :: Convert a => a -> Attribute -controls_ x = Attribute $ U.byteStringCopy (unsafe 11 " controls=\""#) <> unConv (convert x) <> char7 '"' +controls_ :: a -> 'ControlsA := a +controls_ = AT -{-# INLINE coords_ #-} -coords_ :: Convert a => a -> Attribute -coords_ x = Attribute $ U.byteStringCopy (unsafe 9 " coords=\""#) <> unConv (convert x) <> char7 '"' +coords_ :: a -> 'CoordsA := a +coords_ = AT -{-# INLINE crossorigin_ #-} -crossorigin_ :: Convert a => a -> Attribute -crossorigin_ x = Attribute $ U.byteStringCopy (unsafe 14 " crossorigin=\""#) <> unConv (convert x) <> char7 '"' +crossorigin_ :: a -> 'CrossoriginA := a +crossorigin_ = AT -{-# INLINE data_ #-} -data_ :: Convert a => a -> Attribute -data_ x = Attribute $ U.byteStringCopy (unsafe 7 " data=\""#) <> unConv (convert x) <> char7 '"' +data_ :: a -> 'DataA := a +data_ = AT -{-# INLINE datetime_ #-} -datetime_ :: Convert a => a -> Attribute -datetime_ x = Attribute $ U.byteStringCopy (unsafe 11 " datetime=\""#) <> unConv (convert x) <> char7 '"' +datetime_ :: a -> 'DatetimeA := a +datetime_ = AT -{-# INLINE default_ #-} -default_ :: Convert a => a -> Attribute -default_ x = Attribute $ U.byteStringCopy (unsafe 10 " default=\""#) <> unConv (convert x) <> char7 '"' +default_ :: a -> 'DefaultA := a +default_ = AT -{-# INLINE defer_ #-} -defer_ :: Convert a => a -> Attribute -defer_ x = Attribute $ U.byteStringCopy (unsafe 8 " defer=\""#) <> unConv (convert x) <> char7 '"' +defer_ :: a -> 'DeferA := a +defer_ = AT -{-# INLINE dir_ #-} -dir_ :: Convert a => a -> Attribute -dir_ x = Attribute $ U.byteStringCopy (unsafe 6 " dir=\""#) <> unConv (convert x) <> char7 '"' +dir_ :: a -> 'DirA := a +dir_ = AT -{-# INLINE dirname_ #-} -dirname_ :: Convert a => a -> Attribute -dirname_ x = Attribute $ U.byteStringCopy (unsafe 10 " dirname=\""#) <> unConv (convert x) <> char7 '"' +dirname_ :: a -> 'DirnameA := a +dirname_ = AT -{-# INLINE disabled_ #-} -disabled_ :: Convert a => a -> Attribute -disabled_ x = Attribute $ U.byteStringCopy (unsafe 11 " disabled=\""#) <> unConv (convert x) <> char7 '"' +disabled_ :: a -> 'DisabledA := a +disabled_ = AT -{-# INLINE download_ #-} -download_ :: Convert a => a -> Attribute -download_ x = Attribute $ U.byteStringCopy (unsafe 11 " download=\""#) <> unConv (convert x) <> char7 '"' +download_ :: a -> 'DownloadA := a +download_ = AT -{-# INLINE draggable_ #-} -draggable_ :: Convert a => a -> Attribute -draggable_ x = Attribute $ U.byteStringCopy (unsafe 12 " draggable=\""#) <> unConv (convert x) <> char7 '"' +draggable_ :: a -> 'DraggableA := a +draggable_ = AT -{-# INLINE dropzone_ #-} -dropzone_ :: Convert a => a -> Attribute -dropzone_ x = Attribute $ U.byteStringCopy (unsafe 11 " dropzone=\""#) <> unConv (convert x) <> char7 '"' +dropzone_ :: a -> 'DropzoneA := a +dropzone_ = AT -{-# INLINE enctype_ #-} -enctype_ :: Convert a => a -> Attribute -enctype_ x = Attribute $ U.byteStringCopy (unsafe 10 " enctype=\""#) <> unConv (convert x) <> char7 '"' +enctype_ :: a -> 'EnctypeA := a +enctype_ = AT -{-# INLINE for_ #-} -for_ :: Convert a => a -> Attribute -for_ x = Attribute $ U.byteStringCopy (unsafe 6 " for=\""#) <> unConv (convert x) <> char7 '"' +for_ :: a -> 'ForA := a +for_ = AT -{-# INLINE form_ #-} -form_ :: Convert a => a -> Attribute -form_ x = Attribute $ U.byteStringCopy (unsafe 7 " form=\""#) <> unConv (convert x) <> char7 '"' +form_ :: a -> 'FormA := a +form_ = AT -{-# INLINE formaction_ #-} -formaction_ :: Convert a => a -> Attribute -formaction_ x = Attribute $ U.byteStringCopy (unsafe 13 " formaction=\""#) <> unConv (convert x) <> char7 '"' +formaction_ :: a -> 'FormactionA := a +formaction_ = AT -{-# INLINE headers_ #-} -headers_ :: Convert a => a -> Attribute -headers_ x = Attribute $ U.byteStringCopy (unsafe 10 " headers=\""#) <> unConv (convert x) <> char7 '"' +headers_ :: a -> 'HeadersA := a +headers_ = AT -{-# INLINE height_ #-} -height_ :: Convert a => a -> Attribute -height_ x = Attribute $ U.byteStringCopy (unsafe 9 " height=\""#) <> unConv (convert x) <> char7 '"' +height_ :: a -> 'HeightA := a +height_ = AT -{-# INLINE hidden_ #-} -hidden_ :: Convert a => a -> Attribute -hidden_ x = Attribute $ U.byteStringCopy (unsafe 9 " hidden=\""#) <> unConv (convert x) <> char7 '"' +hidden_ :: a -> 'HiddenA := a +hidden_ = AT -{-# INLINE high_ #-} -high_ :: Convert a => a -> Attribute -high_ x = Attribute $ U.byteStringCopy (unsafe 7 " high=\""#) <> unConv (convert x) <> char7 '"' +high_ :: a -> 'HighA := a +high_ = AT -{-# INLINE href_ #-} -href_ :: Convert a => a -> Attribute -href_ x = Attribute $ U.byteStringCopy (unsafe 7 " href=\""#) <> unConv (convert x) <> char7 '"' +href_ :: a -> 'HrefA := a +href_ = AT -{-# INLINE hreflang_ #-} -hreflang_ :: Convert a => a -> Attribute -hreflang_ x = Attribute $ U.byteStringCopy (unsafe 11 " hreflang=\""#) <> unConv (convert x) <> char7 '"' +hreflang_ :: a -> 'HreflangA := a +hreflang_ = AT -{-# INLINE httpequiv_ #-} -httpequiv_ :: Convert a => a -> Attribute -httpequiv_ x = Attribute $ U.byteStringCopy (unsafe 12 " httpequiv=\""#) <> unConv (convert x) <> char7 '"' +httpEquiv_ :: a -> 'HttpEquivA := a +httpEquiv_ = AT -{-# INLINE icon_ #-} -icon_ :: Convert a => a -> Attribute -icon_ x = Attribute $ U.byteStringCopy (unsafe 7 " icon=\""#) <> unConv (convert x) <> char7 '"' +icon_ :: a -> 'IconA := a +icon_ = AT -{-# INLINE id_ #-} -id_ :: Convert a => a -> Attribute -id_ x = Attribute $ U.byteStringCopy (unsafe 5 " id=\""#) <> unConv (convert x) <> char7 '"' +id_ :: a -> 'IdA := a +id_ = AT -{-# INLINE integrity_ #-} -integrity_ :: Convert a => a -> Attribute -integrity_ x = Attribute $ U.byteStringCopy (unsafe 12 " integrity=\""#) <> unConv (convert x) <> char7 '"' +integrity_ :: a -> 'IntegrityA := a +integrity_ = AT -{-# INLINE ismap_ #-} -ismap_ :: Convert a => a -> Attribute -ismap_ x = Attribute $ U.byteStringCopy (unsafe 8 " ismap=\""#) <> unConv (convert x) <> char7 '"' +ismap_ :: a -> 'IsmapA := a +ismap_ = AT -{-# INLINE itemprop_ #-} -itemprop_ :: Convert a => a -> Attribute -itemprop_ x = Attribute $ U.byteStringCopy (unsafe 11 " itemprop=\""#) <> unConv (convert x) <> char7 '"' +itemprop_ :: a -> 'ItempropA := a +itemprop_ = AT -{-# INLINE keytype_ #-} -keytype_ :: Convert a => a -> Attribute -keytype_ x = Attribute $ U.byteStringCopy (unsafe 10 " keytype=\""#) <> unConv (convert x) <> char7 '"' +keytype_ :: a -> 'KeytypeA := a +keytype_ = AT -{-# INLINE kind_ #-} -kind_ :: Convert a => a -> Attribute -kind_ x = Attribute $ U.byteStringCopy (unsafe 7 " kind=\""#) <> unConv (convert x) <> char7 '"' +kind_ :: a -> 'KindA := a +kind_ = AT -{-# INLINE label_ #-} -label_ :: Convert a => a -> Attribute -label_ x = Attribute $ U.byteStringCopy (unsafe 8 " label=\""#) <> unConv (convert x) <> char7 '"' +label_ :: a -> 'LabelA := a +label_ = AT -{-# INLINE lang_ #-} -lang_ :: Convert a => a -> Attribute -lang_ x = Attribute $ U.byteStringCopy (unsafe 7 " lang=\""#) <> unConv (convert x) <> char7 '"' +lang_ :: a -> 'LangA := a +lang_ = AT -{-# INLINE language_ #-} -language_ :: Convert a => a -> Attribute -language_ x = Attribute $ U.byteStringCopy (unsafe 11 " language=\""#) <> unConv (convert x) <> char7 '"' +language_ :: a -> 'LanguageA := a +language_ = AT -{-# INLINE list_ #-} -list_ :: Convert a => a -> Attribute -list_ x = Attribute $ U.byteStringCopy (unsafe 7 " list=\""#) <> unConv (convert x) <> char7 '"' +list_ :: a -> 'ListA := a +list_ = AT -{-# INLINE loop_ #-} -loop_ :: Convert a => a -> Attribute -loop_ x = Attribute $ U.byteStringCopy (unsafe 7 " loop=\""#) <> unConv (convert x) <> char7 '"' +loop_ :: a -> 'LoopA := a +loop_ = AT -{-# INLINE low_ #-} -low_ :: Convert a => a -> Attribute -low_ x = Attribute $ U.byteStringCopy (unsafe 6 " low=\""#) <> unConv (convert x) <> char7 '"' +low_ :: a -> 'LowA := a +low_ = AT -{-# INLINE manifest_ #-} -manifest_ :: Convert a => a -> Attribute -manifest_ x = Attribute $ U.byteStringCopy (unsafe 11 " manifest=\""#) <> unConv (convert x) <> char7 '"' +manifest_ :: a -> 'ManifestA := a +manifest_ = AT -{-# INLINE max_ #-} -max_ :: Convert a => a -> Attribute -max_ x = Attribute $ U.byteStringCopy (unsafe 6 " max=\""#) <> unConv (convert x) <> char7 '"' +max_ :: a -> 'MaxA := a +max_ = AT -{-# INLINE maxlength_ #-} -maxlength_ :: Convert a => a -> Attribute -maxlength_ x = Attribute $ U.byteStringCopy (unsafe 12 " maxlength=\""#) <> unConv (convert x) <> char7 '"' +maxlength_ :: a -> 'MaxlengthA := a +maxlength_ = AT -{-# INLINE minlength_ #-} -minlength_ :: Convert a => a -> Attribute -minlength_ x = Attribute $ U.byteStringCopy (unsafe 6 " minlength=\""#) <> unConv (convert x) <> char7 '"' +minlength_ :: a -> 'MinlengthA := a +minlength_ = AT -{-# INLINE media_ #-} -media_ :: Convert a => a -> Attribute -media_ x = Attribute $ U.byteStringCopy (unsafe 8 " media=\""#) <> unConv (convert x) <> char7 '"' +media_ :: a -> 'MediaA := a +media_ = AT -{-# INLINE method_ #-} -method_ :: Convert a => a -> Attribute -method_ x = Attribute $ U.byteStringCopy (unsafe 9 " method=\""#) <> unConv (convert x) <> char7 '"' +method_ :: a -> 'MethodA := a +method_ = AT -{-# INLINE min_ #-} -min_ :: Convert a => a -> Attribute -min_ x = Attribute $ U.byteStringCopy (unsafe 6 " min=\""#) <> unConv (convert x) <> char7 '"' +min_ :: a -> 'MinA := a +min_ = AT -{-# INLINE multiple_ #-} -multiple_ :: Convert a => a -> Attribute -multiple_ x = Attribute $ U.byteStringCopy (unsafe 11 " multiple=\""#) <> unConv (convert x) <> char7 '"' +multiple_ :: a -> 'MultipleA := a +multiple_ = AT -{-# INLINE muted_ #-} -muted_ :: Convert a => a -> Attribute -muted_ x = Attribute $ U.byteStringCopy (unsafe 8 " muted=\""#) <> unConv (convert x) <> char7 '"' +muted_ :: a -> 'MutedA := a +muted_ = AT -{-# INLINE name_ #-} -name_ :: Convert a => a -> Attribute -name_ x = Attribute $ U.byteStringCopy (unsafe 7 " name=\""#) <> unConv (convert x) <> char7 '"' +name_ :: a -> 'NameA := a +name_ = AT -{-# INLINE novalidate_ #-} -novalidate_ :: Convert a => a -> Attribute -novalidate_ x = Attribute $ U.byteStringCopy (unsafe 13 " novalidate=\""#) <> unConv (convert x) <> char7 '"' +novalidate_ :: a -> 'NovalidateA := a +novalidate_ = AT -{-# INLINE open_ #-} -open_ :: Convert a => a -> Attribute -open_ x = Attribute $ U.byteStringCopy (unsafe 7 " open=\""#) <> unConv (convert x) <> char7 '"' +open_ :: a -> 'OpenA := a +open_ = AT -{-# INLINE optimum_ #-} -optimum_ :: Convert a => a -> Attribute -optimum_ x = Attribute $ U.byteStringCopy (unsafe 10 " optimum=\""#) <> unConv (convert x) <> char7 '"' +optimum_ :: a -> 'OptimumA := a +optimum_ = AT -{-# INLINE pattern_ #-} -pattern_ :: Convert a => a -> Attribute -pattern_ x = Attribute $ U.byteStringCopy (unsafe 10 " pattern=\""#) <> unConv (convert x) <> char7 '"' +pattern_ :: a -> 'PatternA := a +pattern_ = AT -{-# INLINE ping_ #-} -ping_ :: Convert a => a -> Attribute -ping_ x = Attribute $ U.byteStringCopy (unsafe 7 " ping=\""#) <> unConv (convert x) <> char7 '"' +ping_ :: a -> 'PingA := a +ping_ = AT -{-# INLINE placeholder_ #-} -placeholder_ :: Convert a => a -> Attribute -placeholder_ x = Attribute $ U.byteStringCopy (unsafe 14 " placeholder=\""#) <> unConv (convert x) <> char7 '"' +placeholder_ :: a -> 'PlaceholderA := a +placeholder_ = AT -{-# INLINE poster_ #-} -poster_ :: Convert a => a -> Attribute -poster_ x = Attribute $ U.byteStringCopy (unsafe 9 " poster=\""#) <> unConv (convert x) <> char7 '"' +poster_ :: a -> 'PosterA := a +poster_ = AT -{-# INLINE preload_ #-} -preload_ :: Convert a => a -> Attribute -preload_ x = Attribute $ U.byteStringCopy (unsafe 10 " preload=\""#) <> unConv (convert x) <> char7 '"' +preload_ :: a -> 'PreloadA := a +preload_ = AT -{-# INLINE radiogroup_ #-} -radiogroup_ :: Convert a => a -> Attribute -radiogroup_ x = Attribute $ U.byteStringCopy (unsafe 13 " radiogroup=\""#) <> unConv (convert x) <> char7 '"' +radiogroup_ :: a -> 'RadiogroupA := a +radiogroup_ = AT -{-# INLINE readonly_ #-} -readonly_ :: Convert a => a -> Attribute -readonly_ x = Attribute $ U.byteStringCopy (unsafe 11 " readonly=\""#) <> unConv (convert x) <> char7 '"' +readonly_ :: a -> 'ReadonlyA := a +readonly_ = AT -{-# INLINE rel_ #-} -rel_ :: Convert a => a -> Attribute -rel_ x = Attribute $ U.byteStringCopy (unsafe 6 " rel=\""#) <> unConv (convert x) <> char7 '"' +rel_ :: a -> 'RelA := a +rel_ = AT -{-# INLINE required_ #-} -required_ :: Convert a => a -> Attribute -required_ x = Attribute $ U.byteStringCopy (unsafe 11 " required=\""#) <> unConv (convert x) <> char7 '"' +required_ :: a -> 'RequiredA := a +required_ = AT -{-# INLINE reversed_ #-} -reversed_ :: Convert a => a -> Attribute -reversed_ x = Attribute $ U.byteStringCopy (unsafe 11 " reversed=\""#) <> unConv (convert x) <> char7 '"' +reversed_ :: a -> 'ReversedA := a +reversed_ = AT -{-# INLINE rows_ #-} -rows_ :: Convert a => a -> Attribute -rows_ x = Attribute $ U.byteStringCopy (unsafe 7 " rows=\""#) <> unConv (convert x) <> char7 '"' +rows_ :: a -> 'RowsA := a +rows_ = AT -{-# INLINE rowspan_ #-} -rowspan_ :: Convert a => a -> Attribute -rowspan_ x = Attribute $ U.byteStringCopy (unsafe 10 " rowspan=\""#) <> unConv (convert x) <> char7 '"' +rowspan_ :: a -> 'RowspanA := a +rowspan_ = AT -{-# INLINE sandbox_ #-} -sandbox_ :: Convert a => a -> Attribute -sandbox_ x = Attribute $ U.byteStringCopy (unsafe 10 " sandbox=\""#) <> unConv (convert x) <> char7 '"' +sandbox_ :: a -> 'SandboxA := a +sandbox_ = AT -{-# INLINE scope_ #-} -scope_ :: Convert a => a -> Attribute -scope_ x = Attribute $ U.byteStringCopy (unsafe 8 " scope=\""#) <> unConv (convert x) <> char7 '"' +scope_ :: a -> 'ScopeA := a +scope_ = AT -{-# INLINE scoped_ #-} -scoped_ :: Convert a => a -> Attribute -scoped_ x = Attribute $ U.byteStringCopy (unsafe 9 " scoped=\""#) <> unConv (convert x) <> char7 '"' +scoped_ :: a -> 'ScopedA := a +scoped_ = AT -{-# INLINE seamless_ #-} -seamless_ :: Convert a => a -> Attribute -seamless_ x = Attribute $ U.byteStringCopy (unsafe 11 " seamless=\""#) <> unConv (convert x) <> char7 '"' +seamless_ :: a -> 'SeamlessA := a +seamless_ = AT -{-# INLINE selected_ #-} -selected_ :: Convert a => a -> Attribute -selected_ x = Attribute $ U.byteStringCopy (unsafe 11 " selected=\""#) <> unConv (convert x) <> char7 '"' +selected_ :: a -> 'SelectedA := a +selected_ = AT -{-# INLINE shape_ #-} -shape_ :: Convert a => a -> Attribute -shape_ x = Attribute $ U.byteStringCopy (unsafe 8 " shape=\""#) <> unConv (convert x) <> char7 '"' +shape_ :: a -> 'ShapeA := a +shape_ = AT -{-# INLINE size_ #-} -size_ :: Convert a => a -> Attribute -size_ x = Attribute $ U.byteStringCopy (unsafe 7 " size=\""#) <> unConv (convert x) <> char7 '"' +size_ :: a -> 'SizeA := a +size_ = AT -{-# INLINE sizes_ #-} -sizes_ :: Convert a => a -> Attribute -sizes_ x = Attribute $ U.byteStringCopy (unsafe 8 " sizes=\""#) <> unConv (convert x) <> char7 '"' +sizes_ :: a -> 'SizesA := a +sizes_ = AT -{-# INLINE slot_ #-} -slot_ :: Convert a => a -> Attribute -slot_ x = Attribute $ U.byteStringCopy (unsafe 7 " slot=\""#) <> unConv (convert x) <> char7 '"' +slot_ :: a -> 'SlotA := a +slot_ = AT -{-# INLINE span_ #-} -span_ :: Convert a => a -> Attribute -span_ x = Attribute $ U.byteStringCopy (unsafe 7 " span=\""#) <> unConv (convert x) <> char7 '"' +span_ :: a -> 'SpanA := a +span_ = AT -{-# INLINE spellcheck_ #-} -spellcheck_ :: Convert a => a -> Attribute -spellcheck_ x = Attribute $ U.byteStringCopy (unsafe 13 " spellcheck=\""#) <> unConv (convert x) <> char7 '"' +spellcheck_ :: a -> 'SpellcheckA := a +spellcheck_ = AT -{-# INLINE src_ #-} -src_ :: Convert a => a -> Attribute -src_ x = Attribute $ U.byteStringCopy (unsafe 6 " src=\""#) <> unConv (convert x) <> char7 '"' +src_ :: a -> 'SrcA := a +src_ = AT -{-# INLINE srcdoc_ #-} -srcdoc_ :: Convert a => a -> Attribute -srcdoc_ x = Attribute $ U.byteStringCopy (unsafe 9 " srcdoc=\""#) <> unConv (convert x) <> char7 '"' +srcdoc_ :: a -> 'SrcdocA := a +srcdoc_ = AT -{-# INLINE srclang_ #-} -srclang_ :: Convert a => a -> Attribute -srclang_ x = Attribute $ U.byteStringCopy (unsafe 10 " srclang=\""#) <> unConv (convert x) <> char7 '"' +srclang_ :: a -> 'SrclangA := a +srclang_ = AT -{-# INLINE srcset_ #-} -srcset_ :: Convert a => a -> Attribute -srcset_ x = Attribute $ U.byteStringCopy (unsafe 9 " srcset=\""#) <> unConv (convert x) <> char7 '"' +srcset_ :: a -> 'SrcsetA := a +srcset_ = AT -{-# INLINE start_ #-} -start_ :: Convert a => a -> Attribute -start_ x = Attribute $ U.byteStringCopy (unsafe 8 " start=\""#) <> unConv (convert x) <> char7 '"' +start_ :: a -> 'StartA := a +start_ = AT -{-# INLINE step_ #-} -step_ :: Convert a => a -> Attribute -step_ x = Attribute $ U.byteStringCopy (unsafe 7 " step=\""#) <> unConv (convert x) <> char7 '"' +step_ :: a -> 'StepA := a +step_ = AT -{-# INLINE style_ #-} -style_ :: Convert a => a -> Attribute -style_ x = Attribute $ U.byteStringCopy (unsafe 8 " style=\""#) <> unConv (convert x) <> char7 '"' +style_ :: a -> 'StyleA := a +style_ = AT -{-# INLINE summary_ #-} -summary_ :: Convert a => a -> Attribute -summary_ x = Attribute $ U.byteStringCopy (unsafe 10 " summary=\""#) <> unConv (convert x) <> char7 '"' +summary_ :: a -> 'SummaryA := a +summary_ = AT -{-# INLINE tabindex_ #-} -tabindex_ :: Convert a => a -> Attribute -tabindex_ x = Attribute $ U.byteStringCopy (unsafe 11 " tabindex=\""#) <> unConv (convert x) <> char7 '"' +tabindex_ :: a -> 'TabindexA := a +tabindex_ = AT -{-# INLINE target_ #-} -target_ :: Convert a => a -> Attribute -target_ x = Attribute $ U.byteStringCopy (unsafe 9 " target=\""#) <> unConv (convert x) <> char7 '"' +target_ :: a -> 'TargetA := a +target_ = AT -{-# INLINE title_ #-} -title_ :: Convert a => a -> Attribute -title_ x = Attribute $ U.byteStringCopy (unsafe 8 " title=\""#) <> unConv (convert x) <> char7 '"' +title_ :: a -> 'TitleA := a +title_ = AT -{-# INLINE type_ #-} -type_ :: Convert a => a -> Attribute -type_ x = Attribute $ U.byteStringCopy (unsafe 7 " type=\""#) <> unConv (convert x) <> char7 '"' +type_ :: a -> 'TypeA := a +type_ = AT -{-# INLINE usemap_ #-} -usemap_ :: Convert a => a -> Attribute -usemap_ x = Attribute $ U.byteStringCopy (unsafe 9 " usemap=\""#) <> unConv (convert x) <> char7 '"' +usemap_ :: a -> 'UsemapA := a +usemap_ = AT -{-# INLINE value_ #-} -value_ :: Convert a => a -> Attribute -value_ x = Attribute $ U.byteStringCopy (unsafe 8 " value=\""#) <> unConv (convert x) <> char7 '"' +value_ :: a -> 'ValueA := a +value_ = AT -{-# INLINE width_ #-} -width_ :: Convert a => a -> Attribute -width_ x = Attribute $ U.byteStringCopy (unsafe 8 " width=\""#) <> unConv (convert x) <> char7 '"' +width_ :: a -> 'WidthA := a +width_ = AT -{-# INLINE wrap_ #-} -wrap_ :: Convert a => a -> Attribute -wrap_ x = Attribute $ U.byteStringCopy (unsafe 7 " wrap=\""#) <> unConv (convert x) <> char7 '"' +wrap_ :: a -> 'WrapA := a +wrap_ = AT -{-# INLINE addAttributes #-} -addAttributes :: (a ?> b) => Attribute -> (a > b) -> (a :> b) -addAttributes xs (Child b) = WithAttributes xs b +addAttributes :: (a ??> b, a ?> c) => b -> a > c -> (a :@: b) c +addAttributes b (Child c) = WithAttributes b c diff --git a/src/Html/Convert.hs b/src/Html/Convert.hs --- a/src/Html/Convert.hs +++ b/src/Html/Convert.hs @@ -2,6 +2,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeOperators #-} module Html.Convert where @@ -13,13 +14,11 @@ import Data.Char (ord) -import qualified Data.Monoid as M +import qualified Data.Monoid as M import qualified Data.Semigroup as S -import qualified Data.ByteString.Internal as U -import qualified Data.ByteString.Unsafe as U -import qualified Data.ByteString.Builder as B -import qualified Data.ByteString.Builder.Prim as BP +import qualified Data.ByteString.Builder as B +import qualified Data.ByteString.Builder.Prim as BP import qualified Data.ByteString.Builder.Internal as U import qualified Data.Text as T @@ -28,9 +27,6 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -{-# INLINE unsafe #-} -unsafe i addr = U.accursedUnutterablePerformIO (U.unsafePackAddressLen i addr) - {-# INLINE escape #-} escape :: BP.BoundedPrim Word8 escape = @@ -54,6 +50,11 @@ fixed5 x = BP.liftFixedToBounded $ const x BP.>$< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 +newtype Converted = Converted {unConv :: B.Builder} deriving (M.Monoid,S.Semigroup) + +instance IsString Converted where + fromString = convert + {-| Convert a type efficienctly to different string like types. Add instances if you want use custom types in your document. @@ -77,7 +78,6 @@ -- | This is already very efficient. -- Wrap the Strings in Raw if you don't want to escape them. - instance Convert Person where convert (Person{..}) = convert name @@ -93,15 +93,12 @@ main = print (div_ john) @ -} - -newtype Converted = Converted {unConv :: B.Builder} deriving (M.Monoid,S.Semigroup) - -instance IsString Converted where - fromString = convert - class Convert a where convert :: a -> Converted +instance Convert b => Convert (a := b) where + {-# INLINE convert #-} + convert (AT x) = convert x instance Convert (Raw String) where {-# INLINE convert #-} convert (Raw x) = Converted (fromString x) diff --git a/src/Html/Element.hs b/src/Html/Element.hs --- a/src/Html/Element.hs +++ b/src/Html/Element.hs @@ -13,875 +13,875 @@ a_ :: ('A ?> a) => a -> 'A > a a_ = Child -a_A :: ('A ?> a) => Attribute -> a -> 'A :> a +a_A :: ('A ??> a, 'A ?> b) => a -> b -> ('A :@: a) b a_A = WithAttributes abbr_ :: ('Abbr ?> a) => a -> 'Abbr > a abbr_ = Child -abbr_A :: ('Abbr ?> a) => Attribute -> a -> 'Abbr :> a +abbr_A :: ('Abbr ??> a, 'Abbr ?> b) => a -> b -> ('Abbr :@: a) b abbr_A = WithAttributes acronym_ :: ('Acronym ?> a) => a -> 'Acronym > a acronym_ = Child -acronym_A :: ('Acronym ?> a) => Attribute -> a -> 'Acronym :> a +acronym_A :: ('Acronym ??> a, 'Acronym ?> b) => a -> b -> ('Acronym :@: a) b acronym_A = WithAttributes address_ :: ('Address ?> a) => a -> 'Address > a address_ = Child -address_A :: ('Address ?> a) => Attribute -> a -> 'Address :> a +address_A :: ('Address ??> a, 'Address ?> b) => a -> b -> ('Address :@: a) b address_A = WithAttributes applet_ :: ('Applet ?> a) => a -> 'Applet > a applet_ = Child -applet_A :: ('Applet ?> a) => Attribute -> a -> 'Applet :> a +applet_A :: ('Applet ??> a, 'Applet ?> b) => a -> b -> ('Applet :@: a) b applet_A = WithAttributes area_ :: 'Area > () area_ = Child () -area_A :: Attribute -> 'Area :> () +area_A :: 'Area ??> a => a -> ('Area :@: a) () area_A = flip WithAttributes () article_ :: ('Article ?> a) => a -> 'Article > a article_ = Child -article_A :: ('Article ?> a) => Attribute -> a -> 'Article :> a +article_A :: ('Article ??> a, 'Article ?> b) => a -> b -> ('Article :@: a) b article_A = WithAttributes aside_ :: ('Aside ?> a) => a -> 'Aside > a aside_ = Child -aside_A :: ('Aside ?> a) => Attribute -> a -> 'Aside :> a +aside_A :: ('Aside ??> a, 'Aside ?> b) => a -> b -> ('Aside :@: a) b aside_A = WithAttributes audio_ :: ('Audio ?> a) => a -> 'Audio > a audio_ = Child -audio_A :: ('Audio ?> a) => Attribute -> a -> 'Audio :> a +audio_A :: ('Audio ??> a, 'Audio ?> b) => a -> b -> ('Audio :@: a) b audio_A = WithAttributes b_ :: ('B ?> a) => a -> 'B > a b_ = Child -b_A :: ('B ?> a) => Attribute -> a -> 'B :> a +b_A :: ('B ??> a, 'B ?> b) => a -> b -> ('B :@: a) b b_A = WithAttributes base_ :: 'Base > () base_ = Child () -base_A :: Attribute -> 'Base :> () +base_A :: 'Base ??> a => a -> ('Base :@: a) () base_A = flip WithAttributes () basefont_ :: ('Basefont ?> a) => a -> 'Basefont > a basefont_ = Child -basefont_A :: ('Basefont ?> a) => Attribute -> a -> 'Basefont :> a +basefont_A :: ('Basefont ??> a, 'Basefont ?> b) => a -> b -> ('Basefont :@: a) b basefont_A = WithAttributes bdi_ :: ('Bdi ?> a) => a -> 'Bdi > a bdi_ = Child -bdi_A :: ('Bdi ?> a) => Attribute -> a -> 'Bdi :> a +bdi_A :: ('Bdi ??> a, 'Bdi ?> b) => a -> b -> ('Bdi :@: a) b bdi_A = WithAttributes bdo_ :: ('Bdo ?> a) => a -> 'Bdo > a bdo_ = Child -bdo_A :: ('Bdo ?> a) => Attribute -> a -> 'Bdo :> a +bdo_A :: ('Bdo ??> a, 'Bdo ?> b) => a -> b -> ('Bdo :@: a) b bdo_A = WithAttributes bgsound_ :: ('Bgsound ?> a) => a -> 'Bgsound > a bgsound_ = Child -bgsound_A :: ('Bgsound ?> a) => Attribute -> a -> 'Bgsound :> a +bgsound_A :: ('Bgsound ??> a, 'Bgsound ?> b) => a -> b -> ('Bgsound :@: a) b bgsound_A = WithAttributes big_ :: ('Big ?> a) => a -> 'Big > a big_ = Child -big_A :: ('Big ?> a) => Attribute -> a -> 'Big :> a +big_A :: ('Big ??> a, 'Big ?> b) => a -> b -> ('Big :@: a) b big_A = WithAttributes blink_ :: ('Blink ?> a) => a -> 'Blink > a blink_ = Child -blink_A :: ('Blink ?> a) => Attribute -> a -> 'Blink :> a +blink_A :: ('Blink ??> a, 'Blink ?> b) => a -> b -> ('Blink :@: a) b blink_A = WithAttributes blockquote_ :: ('Blockquote ?> a) => a -> 'Blockquote > a blockquote_ = Child -blockquote_A :: ('Blockquote ?> a) => Attribute -> a -> 'Blockquote :> a +blockquote_A :: ('Blockquote ??> a, 'Blockquote ?> b) => a -> b -> ('Blockquote :@: a) b blockquote_A = WithAttributes body_ :: ('Body ?> a) => a -> 'Body > a body_ = Child -body_A :: ('Body ?> a) => Attribute -> a -> 'Body :> a +body_A :: ('Body ??> a, 'Body ?> b) => a -> b -> ('Body :@: a) b body_A = WithAttributes br_ :: 'Br > () br_ = Child () -br_A :: Attribute -> 'Br :> () +br_A :: 'Br ??> a => a -> ('Br :@: a) () br_A = flip WithAttributes () button_ :: ('Button ?> a) => a -> 'Button > a button_ = Child -button_A :: ('Button ?> a) => Attribute -> a -> 'Button :> a +button_A :: ('Button ??> a, 'Button ?> b) => a -> b -> ('Button :@: a) b button_A = WithAttributes canvas_ :: ('Canvas ?> a) => a -> 'Canvas > a canvas_ = Child -canvas_A :: ('Canvas ?> a) => Attribute -> a -> 'Canvas :> a +canvas_A :: ('Canvas ??> a, 'Canvas ?> b) => a -> b -> ('Canvas :@: a) b canvas_A = WithAttributes caption_ :: ('Caption ?> a) => a -> 'Caption > a caption_ = Child -caption_A :: ('Caption ?> a) => Attribute -> a -> 'Caption :> a +caption_A :: ('Caption ??> a, 'Caption ?> b) => a -> b -> ('Caption :@: a) b caption_A = WithAttributes center_ :: ('Center ?> a) => a -> 'Center > a center_ = Child -center_A :: ('Center ?> a) => Attribute -> a -> 'Center :> a +center_A :: ('Center ??> a, 'Center ?> b) => a -> b -> ('Center :@: a) b center_A = WithAttributes cite_ :: ('Cite ?> a) => a -> 'Cite > a cite_ = Child -cite_A :: ('Cite ?> a) => Attribute -> a -> 'Cite :> a +cite_A :: ('Cite ??> a, 'Cite ?> b) => a -> b -> ('Cite :@: a) b cite_A = WithAttributes code_ :: ('Code ?> a) => a -> 'Code > a code_ = Child -code_A :: ('Code ?> a) => Attribute -> a -> 'Code :> a +code_A :: ('Code ??> a, 'Code ?> b) => a -> b -> ('Code :@: a) b code_A = WithAttributes col_ :: 'Col > () col_ = Child () -col_A :: Attribute -> 'Col :> () +col_A :: 'Col ??> a => a -> ('Col :@: a) () col_A = flip WithAttributes () colgroup_ :: ('Colgroup ?> a) => a -> 'Colgroup > a colgroup_ = Child -colgroup_A :: ('Colgroup ?> a) => Attribute -> a -> 'Colgroup :> a +colgroup_A :: ('Colgroup ??> a, 'Colgroup ?> b) => a -> b -> ('Colgroup :@: a) b colgroup_A = WithAttributes command_ :: ('Command ?> a) => a -> 'Command > a command_ = Child -command_A :: ('Command ?> a) => Attribute -> a -> 'Command :> a +command_A :: ('Command ??> a, 'Command ?> b) => a -> b -> ('Command :@: a) b command_A = WithAttributes content_ :: ('Content ?> a) => a -> 'Content > a content_ = Child -content_A :: ('Content ?> a) => Attribute -> a -> 'Content :> a +content_A :: ('Content ??> a, 'Content ?> b) => a -> b -> ('Content :@: a) b content_A = WithAttributes data_ :: ('Data ?> a) => a -> 'Data > a data_ = Child -data_A :: ('Data ?> a) => Attribute -> a -> 'Data :> a +data_A :: ('Data ??> a, 'Data ?> b) => a -> b -> ('Data :@: a) b data_A = WithAttributes datalist_ :: ('Datalist ?> a) => a -> 'Datalist > a datalist_ = Child -datalist_A :: ('Datalist ?> a) => Attribute -> a -> 'Datalist :> a +datalist_A :: ('Datalist ??> a, 'Datalist ?> b) => a -> b -> ('Datalist :@: a) b datalist_A = WithAttributes dd_ :: ('Dd ?> a) => a -> 'Dd > a dd_ = Child -dd_A :: ('Dd ?> a) => Attribute -> a -> 'Dd :> a +dd_A :: ('Dd ??> a, 'Dd ?> b) => a -> b -> ('Dd :@: a) b dd_A = WithAttributes del_ :: ('Del ?> a) => a -> 'Del > a del_ = Child -del_A :: ('Del ?> a) => Attribute -> a -> 'Del :> a +del_A :: ('Del ??> a, 'Del ?> b) => a -> b -> ('Del :@: a) b del_A = WithAttributes details_ :: ('Details ?> a) => a -> 'Details > a details_ = Child -details_A :: ('Details ?> a) => Attribute -> a -> 'Details :> a +details_A :: ('Details ??> a, 'Details ?> b) => a -> b -> ('Details :@: a) b details_A = WithAttributes dfn_ :: ('Dfn ?> a) => a -> 'Dfn > a dfn_ = Child -dfn_A :: ('Dfn ?> a) => Attribute -> a -> 'Dfn :> a +dfn_A :: ('Dfn ??> a, 'Dfn ?> b) => a -> b -> ('Dfn :@: a) b dfn_A = WithAttributes dialog_ :: ('Dialog ?> a) => a -> 'Dialog > a dialog_ = Child -dialog_A :: ('Dialog ?> a) => Attribute -> a -> 'Dialog :> a +dialog_A :: ('Dialog ??> a, 'Dialog ?> b) => a -> b -> ('Dialog :@: a) b dialog_A = WithAttributes dir_ :: ('Dir ?> a) => a -> 'Dir > a dir_ = Child -dir_A :: ('Dir ?> a) => Attribute -> a -> 'Dir :> a +dir_A :: ('Dir ??> a, 'Dir ?> b) => a -> b -> ('Dir :@: a) b dir_A = WithAttributes div_ :: ('Div ?> a) => a -> 'Div > a div_ = Child -div_A :: ('Div ?> a) => Attribute -> a -> 'Div :> a +div_A :: ('Div ??> a, 'Div ?> b) => a -> b -> ('Div :@: a) b div_A = WithAttributes dl_ :: ('Dl ?> a) => a -> 'Dl > a dl_ = Child -dl_A :: ('Dl ?> a) => Attribute -> a -> 'Dl :> a +dl_A :: ('Dl ??> a, 'Dl ?> b) => a -> b -> ('Dl :@: a) b dl_A = WithAttributes dt_ :: ('Dt ?> a) => a -> 'Dt > a dt_ = Child -dt_A :: ('Dt ?> a) => Attribute -> a -> 'Dt :> a +dt_A :: ('Dt ??> a, 'Dt ?> b) => a -> b -> ('Dt :@: a) b dt_A = WithAttributes element_ :: ('Element ?> a) => a -> 'Element > a element_ = Child -element_A :: ('Element ?> a) => Attribute -> a -> 'Element :> a +element_A :: ('Element ??> a, 'Element ?> b) => a -> b -> ('Element :@: a) b element_A = WithAttributes em_ :: ('Em ?> a) => a -> 'Em > a em_ = Child -em_A :: ('Em ?> a) => Attribute -> a -> 'Em :> a +em_A :: ('Em ??> a, 'Em ?> b) => a -> b -> ('Em :@: a) b em_A = WithAttributes embed_ :: 'Embed > () embed_ = Child () -embed_A :: Attribute -> 'Embed :> () +embed_A :: 'Embed ??> a => a -> ('Embed :@: a) () embed_A = flip WithAttributes () fieldset_ :: ('Fieldset ?> a) => a -> 'Fieldset > a fieldset_ = Child -fieldset_A :: ('Fieldset ?> a) => Attribute -> a -> 'Fieldset :> a +fieldset_A :: ('Fieldset ??> a, 'Fieldset ?> b) => a -> b -> ('Fieldset :@: a) b fieldset_A = WithAttributes figcaption_ :: ('Figcaption ?> a) => a -> 'Figcaption > a figcaption_ = Child -figcaption_A :: ('Figcaption ?> a) => Attribute -> a -> 'Figcaption :> a +figcaption_A :: ('Figcaption ??> a, 'Figcaption ?> b) => a -> b -> ('Figcaption :@: a) b figcaption_A = WithAttributes figure_ :: ('Figure ?> a) => a -> 'Figure > a figure_ = Child -figure_A :: ('Figure ?> a) => Attribute -> a -> 'Figure :> a +figure_A :: ('Figure ??> a, 'Figure ?> b) => a -> b -> ('Figure :@: a) b figure_A = WithAttributes font_ :: ('Font ?> a) => a -> 'Font > a font_ = Child -font_A :: ('Font ?> a) => Attribute -> a -> 'Font :> a +font_A :: ('Font ??> a, 'Font ?> b) => a -> b -> ('Font :@: a) b font_A = WithAttributes footer_ :: ('Footer ?> a) => a -> 'Footer > a footer_ = Child -footer_A :: ('Footer ?> a) => Attribute -> a -> 'Footer :> a +footer_A :: ('Footer ??> a, 'Footer ?> b) => a -> b -> ('Footer :@: a) b footer_A = WithAttributes form_ :: ('Form ?> a) => a -> 'Form > a form_ = Child -form_A :: ('Form ?> a) => Attribute -> a -> 'Form :> a +form_A :: ('Form ??> a, 'Form ?> b) => a -> b -> ('Form :@: a) b form_A = WithAttributes frame_ :: ('Frame ?> a) => a -> 'Frame > a frame_ = Child -frame_A :: ('Frame ?> a) => Attribute -> a -> 'Frame :> a +frame_A :: ('Frame ??> a, 'Frame ?> b) => a -> b -> ('Frame :@: a) b frame_A = WithAttributes frameset_ :: ('Frameset ?> a) => a -> 'Frameset > a frameset_ = Child -frameset_A :: ('Frameset ?> a) => Attribute -> a -> 'Frameset :> a +frameset_A :: ('Frameset ??> a, 'Frameset ?> b) => a -> b -> ('Frameset :@: a) b frameset_A = WithAttributes h1_ :: ('H1 ?> a) => a -> 'H1 > a h1_ = Child -h1_A :: ('H1 ?> a) => Attribute -> a -> 'H1 :> a +h1_A :: ('H1 ??> a, 'H1 ?> b) => a -> b -> ('H1 :@: a) b h1_A = WithAttributes h2_ :: ('H2 ?> a) => a -> 'H2 > a h2_ = Child -h2_A :: ('H2 ?> a) => Attribute -> a -> 'H2 :> a +h2_A :: ('H2 ??> a, 'H2 ?> b) => a -> b -> ('H2 :@: a) b h2_A = WithAttributes h3_ :: ('H3 ?> a) => a -> 'H3 > a h3_ = Child -h3_A :: ('H3 ?> a) => Attribute -> a -> 'H3 :> a +h3_A :: ('H3 ??> a, 'H3 ?> b) => a -> b -> ('H3 :@: a) b h3_A = WithAttributes h4_ :: ('H4 ?> a) => a -> 'H4 > a h4_ = Child -h4_A :: ('H4 ?> a) => Attribute -> a -> 'H4 :> a +h4_A :: ('H4 ??> a, 'H4 ?> b) => a -> b -> ('H4 :@: a) b h4_A = WithAttributes h5_ :: ('H5 ?> a) => a -> 'H5 > a h5_ = Child -h5_A :: ('H5 ?> a) => Attribute -> a -> 'H5 :> a +h5_A :: ('H5 ??> a, 'H5 ?> b) => a -> b -> ('H5 :@: a) b h5_A = WithAttributes h6_ :: ('H6 ?> a) => a -> 'H6 > a h6_ = Child -h6_A :: ('H6 ?> a) => Attribute -> a -> 'H6 :> a +h6_A :: ('H6 ??> a, 'H6 ?> b) => a -> b -> ('H6 :@: a) b h6_A = WithAttributes head_ :: ('Head ?> a) => a -> 'Head > a head_ = Child -head_A :: ('Head ?> a) => Attribute -> a -> 'Head :> a +head_A :: ('Head ??> a, 'Head ?> b) => a -> b -> ('Head :@: a) b head_A = WithAttributes header_ :: ('Header ?> a) => a -> 'Header > a header_ = Child -header_A :: ('Header ?> a) => Attribute -> a -> 'Header :> a +header_A :: ('Header ??> a, 'Header ?> b) => a -> b -> ('Header :@: a) b header_A = WithAttributes hgroup_ :: ('Hgroup ?> a) => a -> 'Hgroup > a hgroup_ = Child -hgroup_A :: ('Hgroup ?> a) => Attribute -> a -> 'Hgroup :> a +hgroup_A :: ('Hgroup ??> a, 'Hgroup ?> b) => a -> b -> ('Hgroup :@: a) b hgroup_A = WithAttributes hr_ :: 'Hr > () hr_ = Child () -hr_A :: Attribute -> 'Hr :> () +hr_A :: 'Hr ??> a => a -> ('Hr :@: a) () hr_A = flip WithAttributes () html_ :: ('Html ?> a) => a -> 'Html > a html_ = Child -html_A :: ('Html ?> a) => Attribute -> a -> 'Html :> a +html_A :: ('Html ??> a, 'Html ?> b) => a -> b -> ('Html :@: a) b html_A = WithAttributes i_ :: ('I ?> a) => a -> 'I > a i_ = Child -i_A :: ('I ?> a) => Attribute -> a -> 'I :> a +i_A :: ('I ??> a, 'I ?> b) => a -> b -> ('I :@: a) b i_A = WithAttributes iframe_ :: 'Iframe > () iframe_ = Child () -iframe_A :: Attribute -> 'Iframe :> () +iframe_A :: 'Iframe ??> a => a -> ('Iframe :@: a) () iframe_A = flip WithAttributes () image_ :: ('Image ?> a) => a -> 'Image > a image_ = Child -image_A :: ('Image ?> a) => Attribute -> a -> 'Image :> a +image_A :: ('Image ??> a, 'Image ?> b) => a -> b -> ('Image :@: a) b image_A = WithAttributes img_ :: 'Img > () img_ = Child () -img_A :: Attribute -> 'Img :> () +img_A :: 'Img ??> a => a -> ('Img :@: a) () img_A = flip WithAttributes () input_ :: ('Input ?> a) => a -> 'Input > a input_ = Child -input_A :: ('Input ?> a) => Attribute -> a -> 'Input :> a +input_A :: ('Input ??> a, 'Input ?> b) => a -> b -> ('Input :@: a) b input_A = WithAttributes ins_ :: ('Ins ?> a) => a -> 'Ins > a ins_ = Child -ins_A :: ('Ins ?> a) => Attribute -> a -> 'Ins :> a +ins_A :: ('Ins ??> a, 'Ins ?> b) => a -> b -> ('Ins :@: a) b ins_A = WithAttributes isindex_ :: ('Isindex ?> a) => a -> 'Isindex > a isindex_ = Child -isindex_A :: ('Isindex ?> a) => Attribute -> a -> 'Isindex :> a +isindex_A :: ('Isindex ??> a, 'Isindex ?> b) => a -> b -> ('Isindex :@: a) b isindex_A = WithAttributes kbd_ :: ('Kbd ?> a) => a -> 'Kbd > a kbd_ = Child -kbd_A :: ('Kbd ?> a) => Attribute -> a -> 'Kbd :> a +kbd_A :: ('Kbd ??> a, 'Kbd ?> b) => a -> b -> ('Kbd :@: a) b kbd_A = WithAttributes keygen_ :: ('Keygen ?> a) => a -> 'Keygen > a keygen_ = Child -keygen_A :: ('Keygen ?> a) => Attribute -> a -> 'Keygen :> a +keygen_A :: ('Keygen ??> a, 'Keygen ?> b) => a -> b -> ('Keygen :@: a) b keygen_A = WithAttributes label_ :: ('Label ?> a) => a -> 'Label > a label_ = Child -label_A :: ('Label ?> a) => Attribute -> a -> 'Label :> a +label_A :: ('Label ??> a, 'Label ?> b) => a -> b -> ('Label :@: a) b label_A = WithAttributes legend_ :: ('Legend ?> a) => a -> 'Legend > a legend_ = Child -legend_A :: ('Legend ?> a) => Attribute -> a -> 'Legend :> a +legend_A :: ('Legend ??> a, 'Legend ?> b) => a -> b -> ('Legend :@: a) b legend_A = WithAttributes li_ :: ('Li ?> a) => a -> 'Li > a li_ = Child -li_A :: ('Li ?> a) => Attribute -> a -> 'Li :> a +li_A :: ('Li ??> a, 'Li ?> b) => a -> b -> ('Li :@: a) b li_A = WithAttributes link_ :: 'Link > () link_ = Child () -link_A :: Attribute -> 'Link :> () +link_A :: 'Link ??> a => a -> ('Link :@: a) () link_A = flip WithAttributes () listing_ :: ('Listing ?> a) => a -> 'Listing > a listing_ = Child -listing_A :: ('Listing ?> a) => Attribute -> a -> 'Listing :> a +listing_A :: ('Listing ??> a, 'Listing ?> b) => a -> b -> ('Listing :@: a) b listing_A = WithAttributes main_ :: ('Main ?> a) => a -> 'Main > a main_ = Child -main_A :: ('Main ?> a) => Attribute -> a -> 'Main :> a +main_A :: ('Main ??> a, 'Main ?> b) => a -> b -> ('Main :@: a) b main_A = WithAttributes map_ :: ('Map ?> a) => a -> 'Map > a map_ = Child -map_A :: ('Map ?> a) => Attribute -> a -> 'Map :> a +map_A :: ('Map ??> a, 'Map ?> b) => a -> b -> ('Map :@: a) b map_A = WithAttributes mark_ :: ('Mark ?> a) => a -> 'Mark > a mark_ = Child -mark_A :: ('Mark ?> a) => Attribute -> a -> 'Mark :> a +mark_A :: ('Mark ??> a, 'Mark ?> b) => a -> b -> ('Mark :@: a) b mark_A = WithAttributes marquee_ :: ('Marquee ?> a) => a -> 'Marquee > a marquee_ = Child -marquee_A :: ('Marquee ?> a) => Attribute -> a -> 'Marquee :> a +marquee_A :: ('Marquee ??> a, 'Marquee ?> b) => a -> b -> ('Marquee :@: a) b marquee_A = WithAttributes math_ :: ('Math ?> a) => a -> 'Math > a math_ = Child -math_A :: ('Math ?> a) => Attribute -> a -> 'Math :> a +math_A :: ('Math ??> a, 'Math ?> b) => a -> b -> ('Math :@: a) b math_A = WithAttributes menu_ :: ('Menu ?> a) => a -> 'Menu > a menu_ = Child -menu_A :: ('Menu ?> a) => Attribute -> a -> 'Menu :> a +menu_A :: ('Menu ??> a, 'Menu ?> b) => a -> b -> ('Menu :@: a) b menu_A = WithAttributes menuitem_ :: 'Menuitem > () menuitem_ = Child () -menuitem_A :: Attribute -> 'Menuitem :> () +menuitem_A :: 'Menuitem ??> a => a -> ('Menuitem :@: a) () menuitem_A = flip WithAttributes () meta_ :: 'Meta > () meta_ = Child () -meta_A :: Attribute -> 'Meta :> () +meta_A :: 'Meta ??> a => a -> ('Meta :@: a) () meta_A = flip WithAttributes () meter_ :: ('Meter ?> a) => a -> 'Meter > a meter_ = Child -meter_A :: ('Meter ?> a) => Attribute -> a -> 'Meter :> a +meter_A :: ('Meter ??> a, 'Meter ?> b) => a -> b -> ('Meter :@: a) b meter_A = WithAttributes multicol_ :: ('Multicol ?> a) => a -> 'Multicol > a multicol_ = Child -multicol_A :: ('Multicol ?> a) => Attribute -> a -> 'Multicol :> a +multicol_A :: ('Multicol ??> a, 'Multicol ?> b) => a -> b -> ('Multicol :@: a) b multicol_A = WithAttributes nav_ :: ('Nav ?> a) => a -> 'Nav > a nav_ = Child -nav_A :: ('Nav ?> a) => Attribute -> a -> 'Nav :> a +nav_A :: ('Nav ??> a, 'Nav ?> b) => a -> b -> ('Nav :@: a) b nav_A = WithAttributes nextid_ :: ('Nextid ?> a) => a -> 'Nextid > a nextid_ = Child -nextid_A :: ('Nextid ?> a) => Attribute -> a -> 'Nextid :> a +nextid_A :: ('Nextid ??> a, 'Nextid ?> b) => a -> b -> ('Nextid :@: a) b nextid_A = WithAttributes nobr_ :: ('Nobr ?> a) => a -> 'Nobr > a nobr_ = Child -nobr_A :: ('Nobr ?> a) => Attribute -> a -> 'Nobr :> a +nobr_A :: ('Nobr ??> a, 'Nobr ?> b) => a -> b -> ('Nobr :@: a) b nobr_A = WithAttributes noembed_ :: ('Noembed ?> a) => a -> 'Noembed > a noembed_ = Child -noembed_A :: ('Noembed ?> a) => Attribute -> a -> 'Noembed :> a +noembed_A :: ('Noembed ??> a, 'Noembed ?> b) => a -> b -> ('Noembed :@: a) b noembed_A = WithAttributes noframes_ :: ('Noframes ?> a) => a -> 'Noframes > a noframes_ = Child -noframes_A :: ('Noframes ?> a) => Attribute -> a -> 'Noframes :> a +noframes_A :: ('Noframes ??> a, 'Noframes ?> b) => a -> b -> ('Noframes :@: a) b noframes_A = WithAttributes noscript_ :: ('Noscript ?> a) => a -> 'Noscript > a noscript_ = Child -noscript_A :: ('Noscript ?> a) => Attribute -> a -> 'Noscript :> a +noscript_A :: ('Noscript ??> a, 'Noscript ?> b) => a -> b -> ('Noscript :@: a) b noscript_A = WithAttributes object_ :: ('Object ?> a) => a -> 'Object > a object_ = Child -object_A :: ('Object ?> a) => Attribute -> a -> 'Object :> a +object_A :: ('Object ??> a, 'Object ?> b) => a -> b -> ('Object :@: a) b object_A = WithAttributes ol_ :: ('Ol ?> a) => a -> 'Ol > a ol_ = Child -ol_A :: ('Ol ?> a) => Attribute -> a -> 'Ol :> a +ol_A :: ('Ol ??> a, 'Ol ?> b) => a -> b -> ('Ol :@: a) b ol_A = WithAttributes optgroup_ :: ('Optgroup ?> a) => a -> 'Optgroup > a optgroup_ = Child -optgroup_A :: ('Optgroup ?> a) => Attribute -> a -> 'Optgroup :> a +optgroup_A :: ('Optgroup ??> a, 'Optgroup ?> b) => a -> b -> ('Optgroup :@: a) b optgroup_A = WithAttributes option_ :: ('Option ?> a) => a -> 'Option > a option_ = Child -option_A :: ('Option ?> a) => Attribute -> a -> 'Option :> a +option_A :: ('Option ??> a, 'Option ?> b) => a -> b -> ('Option :@: a) b option_A = WithAttributes output_ :: ('Output ?> a) => a -> 'Output > a output_ = Child -output_A :: ('Output ?> a) => Attribute -> a -> 'Output :> a +output_A :: ('Output ??> a, 'Output ?> b) => a -> b -> ('Output :@: a) b output_A = WithAttributes p_ :: ('P ?> a) => a -> 'P > a p_ = Child -p_A :: ('P ?> a) => Attribute -> a -> 'P :> a +p_A :: ('P ??> a, 'P ?> b) => a -> b -> ('P :@: a) b p_A = WithAttributes param_ :: 'Param > () param_ = Child () -param_A :: Attribute -> 'Param :> () +param_A :: 'Param ??> a => a -> ('Param :@: a) () param_A = flip WithAttributes () picture_ :: ('Picture ?> a) => a -> 'Picture > a picture_ = Child -picture_A :: ('Picture ?> a) => Attribute -> a -> 'Picture :> a +picture_A :: ('Picture ??> a, 'Picture ?> b) => a -> b -> ('Picture :@: a) b picture_A = WithAttributes plaintext_ :: ('Plaintext ?> a) => a -> 'Plaintext > a plaintext_ = Child -plaintext_A :: ('Plaintext ?> a) => Attribute -> a -> 'Plaintext :> a +plaintext_A :: ('Plaintext ??> a, 'Plaintext ?> b) => a -> b -> ('Plaintext :@: a) b plaintext_A = WithAttributes pre_ :: ('Pre ?> a) => a -> 'Pre > a pre_ = Child -pre_A :: ('Pre ?> a) => Attribute -> a -> 'Pre :> a +pre_A :: ('Pre ??> a, 'Pre ?> b) => a -> b -> ('Pre :@: a) b pre_A = WithAttributes progress_ :: ('Progress ?> a) => a -> 'Progress > a progress_ = Child -progress_A :: ('Progress ?> a) => Attribute -> a -> 'Progress :> a +progress_A :: ('Progress ??> a, 'Progress ?> b) => a -> b -> ('Progress :@: a) b progress_A = WithAttributes q_ :: ('Q ?> a) => a -> 'Q > a q_ = Child -q_A :: ('Q ?> a) => Attribute -> a -> 'Q :> a +q_A :: ('Q ??> a, 'Q ?> b) => a -> b -> ('Q :@: a) b q_A = WithAttributes rp_ :: ('Rp ?> a) => a -> 'Rp > a rp_ = Child -rp_A :: ('Rp ?> a) => Attribute -> a -> 'Rp :> a +rp_A :: ('Rp ??> a, 'Rp ?> b) => a -> b -> ('Rp :@: a) b rp_A = WithAttributes rt_ :: ('Rt ?> a) => a -> 'Rt > a rt_ = Child -rt_A :: ('Rt ?> a) => Attribute -> a -> 'Rt :> a +rt_A :: ('Rt ??> a, 'Rt ?> b) => a -> b -> ('Rt :@: a) b rt_A = WithAttributes rtc_ :: ('Rtc ?> a) => a -> 'Rtc > a rtc_ = Child -rtc_A :: ('Rtc ?> a) => Attribute -> a -> 'Rtc :> a +rtc_A :: ('Rtc ??> a, 'Rtc ?> b) => a -> b -> ('Rtc :@: a) b rtc_A = WithAttributes ruby_ :: ('Ruby ?> a) => a -> 'Ruby > a ruby_ = Child -ruby_A :: ('Ruby ?> a) => Attribute -> a -> 'Ruby :> a +ruby_A :: ('Ruby ??> a, 'Ruby ?> b) => a -> b -> ('Ruby :@: a) b ruby_A = WithAttributes s_ :: ('S ?> a) => a -> 'S > a s_ = Child -s_A :: ('S ?> a) => Attribute -> a -> 'S :> a +s_A :: ('S ??> a, 'S ?> b) => a -> b -> ('S :@: a) b s_A = WithAttributes samp_ :: ('Samp ?> a) => a -> 'Samp > a samp_ = Child -samp_A :: ('Samp ?> a) => Attribute -> a -> 'Samp :> a +samp_A :: ('Samp ??> a, 'Samp ?> b) => a -> b -> ('Samp :@: a) b samp_A = WithAttributes script_ :: ('Script ?> a) => a -> 'Script > a script_ = Child -script_A :: ('Script ?> a) => Attribute -> a -> 'Script :> a +script_A :: ('Script ??> a, 'Script ?> b) => a -> b -> ('Script :@: a) b script_A = WithAttributes section_ :: ('Section ?> a) => a -> 'Section > a section_ = Child -section_A :: ('Section ?> a) => Attribute -> a -> 'Section :> a +section_A :: ('Section ??> a, 'Section ?> b) => a -> b -> ('Section :@: a) b section_A = WithAttributes select_ :: ('Select ?> a) => a -> 'Select > a select_ = Child -select_A :: ('Select ?> a) => Attribute -> a -> 'Select :> a +select_A :: ('Select ??> a, 'Select ?> b) => a -> b -> ('Select :@: a) b select_A = WithAttributes shadow_ :: ('Shadow ?> a) => a -> 'Shadow > a shadow_ = Child -shadow_A :: ('Shadow ?> a) => Attribute -> a -> 'Shadow :> a +shadow_A :: ('Shadow ??> a, 'Shadow ?> b) => a -> b -> ('Shadow :@: a) b shadow_A = WithAttributes slot_ :: ('Slot ?> a) => a -> 'Slot > a slot_ = Child -slot_A :: ('Slot ?> a) => Attribute -> a -> 'Slot :> a +slot_A :: ('Slot ??> a, 'Slot ?> b) => a -> b -> ('Slot :@: a) b slot_A = WithAttributes small_ :: ('Small ?> a) => a -> 'Small > a small_ = Child -small_A :: ('Small ?> a) => Attribute -> a -> 'Small :> a +small_A :: ('Small ??> a, 'Small ?> b) => a -> b -> ('Small :@: a) b small_A = WithAttributes source_ :: 'Source > () source_ = Child () -source_A :: Attribute -> 'Source :> () +source_A :: 'Source ??> a => a -> ('Source :@: a) () source_A = flip WithAttributes () spacer_ :: ('Spacer ?> a) => a -> 'Spacer > a spacer_ = Child -spacer_A :: ('Spacer ?> a) => Attribute -> a -> 'Spacer :> a +spacer_A :: ('Spacer ??> a, 'Spacer ?> b) => a -> b -> ('Spacer :@: a) b spacer_A = WithAttributes span_ :: ('Span ?> a) => a -> 'Span > a span_ = Child -span_A :: ('Span ?> a) => Attribute -> a -> 'Span :> a +span_A :: ('Span ??> a, 'Span ?> b) => a -> b -> ('Span :@: a) b span_A = WithAttributes strike_ :: ('Strike ?> a) => a -> 'Strike > a strike_ = Child -strike_A :: ('Strike ?> a) => Attribute -> a -> 'Strike :> a +strike_A :: ('Strike ??> a, 'Strike ?> b) => a -> b -> ('Strike :@: a) b strike_A = WithAttributes strong_ :: ('Strong ?> a) => a -> 'Strong > a strong_ = Child -strong_A :: ('Strong ?> a) => Attribute -> a -> 'Strong :> a +strong_A :: ('Strong ??> a, 'Strong ?> b) => a -> b -> ('Strong :@: a) b strong_A = WithAttributes style_ :: ('Style ?> a) => a -> 'Style > a style_ = Child -style_A :: ('Style ?> a) => Attribute -> a -> 'Style :> a +style_A :: ('Style ??> a, 'Style ?> b) => a -> b -> ('Style :@: a) b style_A = WithAttributes sub_ :: ('Sub ?> a) => a -> 'Sub > a sub_ = Child -sub_A :: ('Sub ?> a) => Attribute -> a -> 'Sub :> a +sub_A :: ('Sub ??> a, 'Sub ?> b) => a -> b -> ('Sub :@: a) b sub_A = WithAttributes summary_ :: ('Summary ?> a) => a -> 'Summary > a summary_ = Child -summary_A :: ('Summary ?> a) => Attribute -> a -> 'Summary :> a +summary_A :: ('Summary ??> a, 'Summary ?> b) => a -> b -> ('Summary :@: a) b summary_A = WithAttributes sup_ :: ('Sup ?> a) => a -> 'Sup > a sup_ = Child -sup_A :: ('Sup ?> a) => Attribute -> a -> 'Sup :> a +sup_A :: ('Sup ??> a, 'Sup ?> b) => a -> b -> ('Sup :@: a) b sup_A = WithAttributes svg_ :: ('Svg ?> a) => a -> 'Svg > a svg_ = Child -svg_A :: ('Svg ?> a) => Attribute -> a -> 'Svg :> a +svg_A :: ('Svg ??> a, 'Svg ?> b) => a -> b -> ('Svg :@: a) b svg_A = WithAttributes table_ :: ('Table ?> a) => a -> 'Table > a table_ = Child -table_A :: ('Table ?> a) => Attribute -> a -> 'Table :> a +table_A :: ('Table ??> a, 'Table ?> b) => a -> b -> ('Table :@: a) b table_A = WithAttributes tbody_ :: ('Tbody ?> a) => a -> 'Tbody > a tbody_ = Child -tbody_A :: ('Tbody ?> a) => Attribute -> a -> 'Tbody :> a +tbody_A :: ('Tbody ??> a, 'Tbody ?> b) => a -> b -> ('Tbody :@: a) b tbody_A = WithAttributes td_ :: ('Td ?> a) => a -> 'Td > a td_ = Child -td_A :: ('Td ?> a) => Attribute -> a -> 'Td :> a +td_A :: ('Td ??> a, 'Td ?> b) => a -> b -> ('Td :@: a) b td_A = WithAttributes template_ :: ('Template ?> a) => a -> 'Template > a template_ = Child -template_A :: ('Template ?> a) => Attribute -> a -> 'Template :> a +template_A :: ('Template ??> a, 'Template ?> b) => a -> b -> ('Template :@: a) b template_A = WithAttributes textarea_ :: ('Textarea ?> a) => a -> 'Textarea > a textarea_ = Child -textarea_A :: ('Textarea ?> a) => Attribute -> a -> 'Textarea :> a +textarea_A :: ('Textarea ??> a, 'Textarea ?> b) => a -> b -> ('Textarea :@: a) b textarea_A = WithAttributes tfoot_ :: ('Tfoot ?> a) => a -> 'Tfoot > a tfoot_ = Child -tfoot_A :: ('Tfoot ?> a) => Attribute -> a -> 'Tfoot :> a +tfoot_A :: ('Tfoot ??> a, 'Tfoot ?> b) => a -> b -> ('Tfoot :@: a) b tfoot_A = WithAttributes th_ :: ('Th ?> a) => a -> 'Th > a th_ = Child -th_A :: ('Th ?> a) => Attribute -> a -> 'Th :> a +th_A :: ('Th ??> a, 'Th ?> b) => a -> b -> ('Th :@: a) b th_A = WithAttributes thead_ :: ('Thead ?> a) => a -> 'Thead > a thead_ = Child -thead_A :: ('Thead ?> a) => Attribute -> a -> 'Thead :> a +thead_A :: ('Thead ??> a, 'Thead ?> b) => a -> b -> ('Thead :@: a) b thead_A = WithAttributes time_ :: ('Time ?> a) => a -> 'Time > a time_ = Child -time_A :: ('Time ?> a) => Attribute -> a -> 'Time :> a +time_A :: ('Time ??> a, 'Time ?> b) => a -> b -> ('Time :@: a) b time_A = WithAttributes title_ :: ('Title ?> a) => a -> 'Title > a title_ = Child -title_A :: ('Title ?> a) => Attribute -> a -> 'Title :> a +title_A :: ('Title ??> a, 'Title ?> b) => a -> b -> ('Title :@: a) b title_A = WithAttributes tr_ :: ('Tr ?> a) => a -> 'Tr > a tr_ = Child -tr_A :: ('Tr ?> a) => Attribute -> a -> 'Tr :> a +tr_A :: ('Tr ??> a, 'Tr ?> b) => a -> b -> ('Tr :@: a) b tr_A = WithAttributes track_ :: 'Track > () track_ = Child () -track_A :: Attribute -> 'Track :> () +track_A :: 'Track ??> a => a -> ('Track :@: a) () track_A = flip WithAttributes () tt_ :: ('Tt ?> a) => a -> 'Tt > a tt_ = Child -tt_A :: ('Tt ?> a) => Attribute -> a -> 'Tt :> a +tt_A :: ('Tt ??> a, 'Tt ?> b) => a -> b -> ('Tt :@: a) b tt_A = WithAttributes u_ :: ('U ?> a) => a -> 'U > a u_ = Child -u_A :: ('U ?> a) => Attribute -> a -> 'U :> a +u_A :: ('U ??> a, 'U ?> b) => a -> b -> ('U :@: a) b u_A = WithAttributes ul_ :: ('Ul ?> a) => a -> 'Ul > a ul_ = Child -ul_A :: ('Ul ?> a) => Attribute -> a -> 'Ul :> a +ul_A :: ('Ul ??> a, 'Ul ?> b) => a -> b -> ('Ul :@: a) b ul_A = WithAttributes var_ :: ('Var ?> a) => a -> 'Var > a var_ = Child -var_A :: ('Var ?> a) => Attribute -> a -> 'Var :> a +var_A :: ('Var ??> a, 'Var ?> b) => a -> b -> ('Var :@: a) b var_A = WithAttributes video_ :: ('Video ?> a) => a -> 'Video > a video_ = Child -video_A :: ('Video ?> a) => Attribute -> a -> 'Video :> a +video_A :: ('Video ??> a, 'Video ?> b) => a -> b -> ('Video :@: a) b video_A = WithAttributes wbr_ :: 'Wbr > () wbr_ = Child () -wbr_A :: Attribute -> 'Wbr :> () +wbr_A :: 'Wbr ??> a => a -> ('Wbr :@: a) () wbr_A = flip WithAttributes () xmp_ :: ('Xmp ?> a) => a -> 'Xmp > a xmp_ = Child -xmp_A :: ('Xmp ?> a) => Attribute -> a -> 'Xmp :> a +xmp_A :: ('Xmp ??> a, 'Xmp ?> b) => a -> b -> ('Xmp :@: a) b xmp_A = WithAttributes diff --git a/src/Html/Reify.hs b/src/Html/Reify.hs --- a/src/Html/Reify.hs +++ b/src/Html/Reify.hs @@ -16,17 +16,18 @@ import GHC.TypeLits import Data.Proxy -import Data.Semigroup +import Data.Semigroup ((<>)) -import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy as T import qualified Data.Text.Lazy.Encoding as T -import qualified Data.ByteString.Lazy as B +import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Builder as B +-- | Render a html document to a Builder. {-# INLINE renderBuilder #-} renderBuilder :: forall a. Document a => a -> B.Builder -renderBuilder x = renderchunks (Tagged x :: Tagged (Symbols a) a ()) - <> unConv (convert (Proxy @ (Last' (Symbols a)))) +renderBuilder x = renderchunks (Tagged x :: Tagged (Symbols a) a) + <> unConv (convert (Proxy @ (Last (Symbols a)))) -- | Render a html document to a String. {-# INLINE renderString #-} @@ -44,67 +45,68 @@ renderByteString = B.toLazyByteString . renderBuilder type Document a = - ( Renderchunks (Tagged (Symbols a) a ()) - , KnownSymbol (Last' (Symbols a)) + ( Renderchunks (Tagged (Symbols a) a) + , KnownSymbol (Last (Symbols a)) ) class Renderchunks a where renderchunks :: a -> B.Builder -instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a) nex) where +instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a)) where {-# INLINE renderchunks #-} renderchunks _ = mempty -instance Renderchunks (Tagged prox () nex) where +instance Renderchunks (Tagged prox ()) where {-# INLINE renderchunks #-} renderchunks _ = mempty -instance {-# OVERLAPPABLE #-} +instance {-# INCOHERENT #-} ( Convert val - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox val nex) where + ) => Renderchunks (Tagged ("" ': ss) val) where {-# INLINE renderchunks #-} renderchunks (Tagged x) - = unConv (convert (Proxy @ (HeadL prox))) + = unConv (convert x) + +instance {-# INCOHERENT #-} + ( Convert val + , KnownSymbol s + ) => Renderchunks (Tagged (s ': ss) val) where + {-# INLINE renderchunks #-} + renderchunks (Tagged x) + = unConv (convert (Proxy @ s)) <> unConv (convert x) instance - ( t ~ Tagged prox b (Close a) - , Renderchunks t - ) => Renderchunks (Tagged prox (a > b) nex) where + ( Renderchunks (Tagged prox b) + ) => Renderchunks (Tagged prox (a > b)) where {-# INLINE renderchunks #-} - renderchunks (Tagged ~(Child b)) = renderchunks (Tagged b :: t) + renderchunks (Tagged ~(Child b)) = renderchunks (Tagged b :: Tagged prox b) instance - ( t ~ Tagged (Drop 1 prox) b (Close a) - , Renderchunks t - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox (a :> b) nex) where + ( Renderchunks (Tagged (Take (CountContent b) prox) b) + , Renderchunks (Tagged (Drop (CountContent b) prox) c) + ) => Renderchunks (Tagged prox ((a :@: b) c)) where {-# INLINE renderchunks #-} - renderchunks (Tagged ~(WithAttributes (Attribute x) b)) - = unConv (convert (Proxy @ (HeadL prox))) - <> x - <> renderchunks (Tagged b :: t) + renderchunks (Tagged ~(WithAttributes b c)) + = renderchunks (Tagged b :: Tagged (Take (CountContent b) prox) b) + <> renderchunks (Tagged c :: Tagged (Drop (CountContent b) prox) c) instance - ( t1 ~ Tagged (Take (CountContent a) prox) a b - , t2 ~ Tagged (Drop (CountContent a) prox) b nex - , Renderchunks t1 - , Renderchunks t2 - ) => Renderchunks (Tagged prox (a # b) nex) where + ( Renderchunks (Tagged (Take (CountContent a) prox) a) + , Renderchunks (Tagged (Drop (CountContent a) prox) b) + ) => Renderchunks (Tagged prox (a # b)) where {-# INLINE renderchunks #-} renderchunks (Tagged ~(a :#: b)) - = renderchunks (Tagged a :: t1) <> renderchunks (Tagged b :: t2) + = renderchunks (Tagged a :: Tagged (Take (CountContent a) prox) a) + <> renderchunks (Tagged b :: Tagged (Drop (CountContent a) prox) b) instance - ( t1 ~ Tagged t2 (a `f` b) () - , t2 ~ Symbols (Next (a `f` b) nex) - , Renderchunks t1 - , KnownSymbol (Last' t2) - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox [a `f` b] nex) where + ( Renderchunks (Tagged (Symbols (a `f` b)) (a `f` b)) + , KnownSymbol (Last (Symbols (a `f` b))) + , KnownSymbol s + ) => Renderchunks (Tagged (s ': ss) [a `f` b]) where {-# INLINE renderchunks #-} renderchunks (Tagged xs) - = unConv (convert (Proxy @ (HeadL prox))) - <> foldMap (\x -> renderchunks (Tagged x :: t1) <> closing) xs - where closing = unConv (convert (Proxy @ (Last' t2))) - {-# INLINE closing #-} + = unConv (convert (Proxy @ s)) + <> foldMap (\x -> renderchunks (Tagged x :: Tagged (Symbols (a `f` b)) (a `f` b)) <> closing) xs + where closing = unConv (convert (Proxy @ (Last (Symbols (a `f` b))))) + diff --git a/src/Html/Type.hs b/src/Html/Type.hs --- a/src/Html/Type.hs +++ b/src/Html/Type.hs @@ -5,18 +5,15 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} module Html.Type where -import qualified Data.ByteString.Builder as B - import GHC.TypeLits import GHC.Exts import Data.Proxy import Data.Type.Bool -import qualified Data.Semigroup as S -import qualified Data.Monoid as M {-# DEPRECATED @@ -199,38 +196,161 @@ | Wbr | Xmp +data Attribute + = AcceptA + | AcceptCharsetA + | AccesskeyA + | ActionA + | AlignA + | AltA + | AsyncA + | AutocompleteA + | AutofocusA + | AutoplayA + | AutosaveA + | BgcolorA + | BorderA + | BufferedA + | ChallengeA + | CharsetA + | CheckedA + | CiteA + | ClassA + | CodeA + | CodebaseA + | ColorA + | ColsA + | ColspanA + | ContentA + | ContenteditableA + | ContextmenuA + | ControlsA + | CoordsA + | CrossoriginA + | DataA + | Data'A + | DatetimeA + | DefaultA + | DeferA + | DirA + | DirnameA + | DisabledA + | DownloadA + | DraggableA + | DropzoneA + | EnctypeA + | ForA + | FormA + | FormactionA + | HeadersA + | HeightA + | HiddenA + | HighA + | HrefA + | HreflangA + | HttpEquivA + | IconA + | IdA + | IntegrityA + | IsmapA + | ItempropA + | KeytypeA + | KindA + | LabelA + | LangA + | LanguageA + | ListA + | LoopA + | LowA + | ManifestA + | MaxA + | MaxlengthA + | MinlengthA + | MediaA + | MethodA + | MinA + | MultipleA + | MutedA + | NameA + | NovalidateA + | OpenA + | OptimumA + | PatternA + | PingA + | PlaceholderA + | PosterA + | PreloadA + | RadiogroupA + | ReadonlyA + | RelA + | RequiredA + | ReversedA + | RowsA + | RowspanA + | SandboxA + | ScopeA + | ScopedA + | SeamlessA + | SelectedA + | ShapeA + | SizeA + | SizesA + | SlotA + | SpanA + | SpellcheckA + | SrcA + | SrcdocA + | SrclangA + | SrcsetA + | StartA + | StepA + | StyleA + | SummaryA + | TabindexA + | TargetA + | TitleA + | TypeA + | UsemapA + | ValueA + | WidthA + | WrapA + +newtype (:=) (a :: Attribute) b = AT b + -- | 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 > ()) ---
--- --- >>> undefined :: 'Div > ('Html > Proxy "a") ---
a
--- --- >>> undefined :: 'Div > ('Html > String) ---
*** 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 + 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) d) = a ?> (b > d) + 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. +type family Null xs where + Null '[] = True + Null _ = False + +type family (a :: Element) ??> b :: Constraint where + a ??> (b # c) = (a ??> b, a ??> c) + a ??> (b := _) = If (Elem a (GetAttributeInfo b) || Null (GetAttributeInfo b)) + (() :: Constraint) + (TypeError (ShowType b :<>: Text " is not a valid attribute of " :<>: ShowType a)) + a ??> b = TypeError (ShowType b :<>: Text " is not an attribute.") + +-- | Combine two elements or attributes sequentially. -- --- >>> render (i_ () # div_ ()) :: String --- "
" +-- >>> i_ () # div_ () +--
+-- +-- >>> i_A (A.id_ "a" # A.class_ "b") "c" +-- c data (#) a b = (:#:) a b {-# INLINE (#) #-} (#) :: a -> b -> a # b @@ -251,11 +371,11 @@ -- | Decorate an element with attributes and descend to a valid child. -- --- >>> WithAttributes [A.class_ "bar"] "a" :: 'Div :> String +-- >>> WithAttributes (A.class_ "bar") "a" :: 'Div :> String --
a
-data (:>) (a :: Element) b where - WithAttributes :: (a ?> b) => Attribute -> b -> a :> b -infixr 8 :> +data (:@:) (a :: Element) b c where + WithAttributes :: (a ??> b, a ?> c) => b -> c -> (a :@: b) c +infixr 8 :@: -- | Wrapper for types which won't be escaped. newtype Raw a = Raw a @@ -264,8 +384,6 @@ -- internal code -- ------------------- -newtype Attribute = Attribute B.Builder deriving (M.Monoid, S.Semigroup) - type family ShowElement e where ShowElement DOCTYPE = "!DOCTYPE html" ShowElement A = "a" @@ -415,6 +533,125 @@ ShowElement Wbr = "wbr" ShowElement Xmp = "xmp" +type family ShowAttribute (x :: Attribute) where + ShowAttribute AcceptA = "accept" + ShowAttribute AcceptCharsetA = "accept-charset" + ShowAttribute AccesskeyA = "accesskey" + ShowAttribute ActionA = "action" + ShowAttribute AlignA = "align" + ShowAttribute AltA = "alt" + ShowAttribute AsyncA = "async" + ShowAttribute AutocompleteA = "autocomplete" + ShowAttribute AutofocusA = "autofocus" + ShowAttribute AutoplayA = "autoplay" + ShowAttribute AutosaveA = "autosave" + ShowAttribute BgcolorA = "bgcolor" + ShowAttribute BorderA = "border" + ShowAttribute BufferedA = "buffered" + ShowAttribute ChallengeA = "challenge" + ShowAttribute CharsetA = "charset" + ShowAttribute CheckedA = "checked" + ShowAttribute CiteA = "cite" + ShowAttribute ClassA = "class" + ShowAttribute CodeA = "code" + ShowAttribute CodebaseA = "codebase" + ShowAttribute ColorA = "color" + ShowAttribute ColsA = "cols" + ShowAttribute ColspanA = "colspan" + ShowAttribute ContentA = "content" + ShowAttribute ContenteditableA = "contenteditable" + ShowAttribute ContextmenuA = "contextmenu" + ShowAttribute ControlsA = "controls" + ShowAttribute CoordsA = "coords" + ShowAttribute CrossoriginA = "crossorigin" + ShowAttribute DataA = "data" + ShowAttribute Data'A = "data'" + ShowAttribute DatetimeA = "datetime" + ShowAttribute DefaultA = "default" + ShowAttribute DeferA = "defer" + ShowAttribute DirA = "dir" + ShowAttribute DirnameA = "dirname" + ShowAttribute DisabledA = "disabled" + ShowAttribute DownloadA = "download" + ShowAttribute DraggableA = "draggable" + ShowAttribute DropzoneA = "dropzone" + ShowAttribute EnctypeA = "enctype" + ShowAttribute ForA = "for" + ShowAttribute FormA = "form" + ShowAttribute FormactionA = "formaction" + ShowAttribute HeadersA = "headers" + ShowAttribute HeightA = "height" + ShowAttribute HiddenA = "hidden" + ShowAttribute HighA = "high" + ShowAttribute HrefA = "href" + ShowAttribute HreflangA = "hreflang" + ShowAttribute HttpEquivA = "httpequiv" + ShowAttribute IconA = "icon" + ShowAttribute IdA = "id" + ShowAttribute IntegrityA = "integrity" + ShowAttribute IsmapA = "ismap" + ShowAttribute ItempropA = "itemprop" + ShowAttribute KeytypeA = "keytype" + ShowAttribute KindA = "kind" + ShowAttribute LabelA = "label" + ShowAttribute LangA = "lang" + ShowAttribute LanguageA = "language" + ShowAttribute ListA = "list" + ShowAttribute LoopA = "loop" + ShowAttribute LowA = "low" + ShowAttribute ManifestA = "manifest" + ShowAttribute MaxA = "max" + ShowAttribute MaxlengthA = "maxlength" + ShowAttribute MinlengthA = "minlength" + ShowAttribute MediaA = "media" + ShowAttribute MethodA = "method" + ShowAttribute MinA = "min" + ShowAttribute MultipleA = "multiple" + ShowAttribute MutedA = "muted" + ShowAttribute NameA = "name" + ShowAttribute NovalidateA = "novalidate" + ShowAttribute OpenA = "open" + ShowAttribute OptimumA = "optimum" + ShowAttribute PatternA = "pattern" + ShowAttribute PingA = "ping" + ShowAttribute PlaceholderA = "placeholder" + ShowAttribute PosterA = "poster" + ShowAttribute PreloadA = "preload" + ShowAttribute RadiogroupA = "radiogroup" + ShowAttribute ReadonlyA = "readonly" + ShowAttribute RelA = "rel" + ShowAttribute RequiredA = "required" + ShowAttribute ReversedA = "reversed" + ShowAttribute RowsA = "rows" + ShowAttribute RowspanA = "rowspan" + ShowAttribute SandboxA = "sandbox" + ShowAttribute ScopeA = "scope" + ShowAttribute ScopedA = "scoped" + ShowAttribute SeamlessA = "seamless" + ShowAttribute SelectedA = "selected" + ShowAttribute ShapeA = "shape" + ShowAttribute SizeA = "size" + ShowAttribute SizesA = "sizes" + ShowAttribute SlotA = "slot" + ShowAttribute SpanA = "span" + ShowAttribute SpellcheckA = "spellcheck" + ShowAttribute SrcA = "src" + ShowAttribute SrcdocA = "srcdoc" + ShowAttribute SrclangA = "srclang" + ShowAttribute SrcsetA = "srcset" + ShowAttribute StartA = "start" + ShowAttribute StepA = "step" + ShowAttribute StyleA = "style" + ShowAttribute SummaryA = "summary" + ShowAttribute TabindexA = "tabindex" + ShowAttribute TargetA = "target" + ShowAttribute TitleA = "title" + ShowAttribute TypeA = "type" + ShowAttribute UsemapA = "usemap" + ShowAttribute ValueA = "value" + ShowAttribute WidthA = "width" + ShowAttribute WrapA = "wrap" + type family OpenTag e where OpenTag e = AppendSymbol (AppendSymbol "<" (ShowElement e)) ">" @@ -422,105 +659,84 @@ CloseTag e = AppendSymbol (AppendSymbol "" 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 + CountContent (a # b) = CountContent a + CountContent b + CountContent (_ > b) = CountContent b + CountContent ((_ :@: b) c) = CountContent b + CountContent c + 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 (() # b) = ToTypeList b + ToTypeList (a # ()) = ToTypeList a 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, (Attribute, (EndOfOpen, Close a))) (OpenAttr a, (Attribute, EndOfOpen)) - ToTypeList (a > b) = Append (Open a, ToTypeList b) (Close a) - ToTypeList (a :> b) = Append (OpenAttr a, (Attribute, (EndOfOpen, ToTypeList b))) (Close a) - ToTypeList x = x + ToTypeList (a > ()) = If (HasContent (GetInfo a)) '[Just (AppendSymbol (OpenTag a) (CloseTag a))] '[Just (OpenTag a)] + ToTypeList ((a :@: b) ()) = Append (Just (AppendSymbol "<" (ShowElement a)) ': ToTypeList b) (If (HasContent (GetInfo a)) '[Just (AppendSymbol ">" (CloseTag a))] '[Just ">"]) + ToTypeList (a > b) = Append (Just (OpenTag a) ': ToTypeList b) '[Just (CloseTag a)] + ToTypeList ((a :@: b) c) = Append (Just (AppendSymbol "<" (ShowElement a)) ': ToTypeList b) (Append (Just ">" ': ToTypeList c) '[Just (CloseTag a)]) + ToTypeList (a := b) = '[Just (AppendSymbol (AppendSymbol " " (ShowAttribute a)) "=\""), Nothing, Just "\""] + ToTypeList (Proxy x) = '[Just x] + ToTypeList () = '[] + ToTypeList x = '[Nothing] -- | Append two type lists. -type family Append a b where - Append (a, b) c = (a, Append b c) - Append a b = (a, b) +type family Append xs ys :: [k] where + Append xs '[] = xs --- | Check whether an element may have content. -type family HasContent a where - HasContent (ElementInfo _ NoContent _) = False - HasContent _ = True + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': Append xs ys --- | 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 + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': Append xs ys -data Next v nex + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': Append xs ys -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) + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': Append xs ys --- Base case - IsOmittableL _head val _last next = val + Append (x1 ': x2 ': x3 ': x4 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': Append xs ys -type family IsOmittable2 head list last next where - IsOmittable2 - (Open head) - val - (ElementInfo _ _ (LastChildOrFollowedBy (head ': _))) -- last - (Close next) - = Init val + Append (x1 ': x2 ': xs) ys + = x1 ': x2 ': Append xs ys - IsOmittable2 - (Open head) - val - (ElementInfo a b (LastChildOrFollowedBy (_ ': xs))) -- last - (Close next) - = IsOmittable2 (Open head) val (ElementInfo a b (LastChildOrFollowedBy xs)) (Close next) + Append (x1 ': xs) ys + = x1 ': Append xs ys --- Base case - IsOmittable2 - _head - val - _last - next - = val + Append '[] ys = ys --- | 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 +-- | Check whether an element may have content. +type family HasContent a where + HasContent (ElementInfo _ NoContent) = False + HasContent _ = True --- | Fuse neighbouring type level strings. +-- | Fuse neighbouring non empty 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 = '[""] + Fuse '[Just a, Nothing] = '[a, ""] + Fuse (Just x1 ': Nothing ': Just x2 ': Nothing ': x ': xs) = x1 ': x2 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Nothing ': Just x3 ': Nothing ': x ': xs) = AppendSymbol x1 x2 ': x3 ': Fuse (x ': xs) + Fuse (Just x1 ': Nothing ': Just x2 ': Just x3 ': Nothing ': x ': xs) = x1 ': AppendSymbol x2 x3 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Nothing ': Just x4 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 x3) ': x4 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Nothing ': Just x3 ': Just x4 ': Nothing ': x ': xs) = AppendSymbol x1 x2 ': AppendSymbol x3 x4 ': Fuse (x ': xs) + Fuse (Just x1 ': Nothing ': Just x2 ': Just x3 ': Just x4 ': Nothing ': x ': xs) = x1 ': AppendSymbol x2 (AppendSymbol x3 x4) ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Just x4 ': Nothing ': Just x5 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 (AppendSymbol x3 x4)) ': x5 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Nothing ': Just x4 ': Just x5 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 x3) ': AppendSymbol x4 x5 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Nothing ': Just x3 ': Just x4 ': Just x5 ': Nothing ': x ': xs) = AppendSymbol x1 x2 ': AppendSymbol x3 (AppendSymbol x4 x5) ': Fuse (x ': xs) + Fuse (Just x1 ': Nothing ': Just x2 ': Just x3 ': Just x4 ': Just x5 ': Nothing ': x ': xs) = x1 ': AppendSymbol x2 (AppendSymbol x3 (AppendSymbol x4 x5)) ': Fuse (x ': xs) + Fuse (Just x1 ': Nothing ': xs) = x1 ': Fuse xs + Fuse (Just x1 ': Just x2 ': Nothing ': x ': xs) = AppendSymbol x1 x2 ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 x3) ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Just x4 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 (AppendSymbol x3 x4)) ': Fuse (x ': xs) + Fuse (Just x1 ': Just x2 ': Just x3 ': Just x4 ': Just x5 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 (AppendSymbol x3 (AppendSymbol x4 x5))) ': Fuse (x ': xs) + + Fuse (Just x1 ': Just x2 ': xs) = Fuse (Just (AppendSymbol x1 x2) ': xs) + Fuse (Just a ': xs) = '[a] + Fuse (Nothing ': xs) = "" ': Fuse xs + Fuse '[] = '[] + type family Drop n xs :: [Symbol] where Drop 0 xs = xs Drop 1 (_ ': xs) = xs @@ -532,62 +748,27 @@ 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 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) +type family Last (xs :: [Symbol]) where + Last (_ ': _ ': _ ': _ ': _ ': _ ': _ ': _ ': x ': xs) = Last (x ': xs) + Last (_ ': _ ': _ ': _ ': x ': xs) = Last (x ': xs) + Last (_ ': _ ': x ': xs) = Last (x ': xs) + Last (_ ': x ': xs) = Last (x ': xs) + Last (x ': xs) = x + Last _ = "" -- | 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) + 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 @@ -597,7 +778,7 @@ -- | 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)) + CheckString a = If (TestPaternity OnlyText (GetInfo a) (ElementInfo '[FlowContent, PhrasingContent] NoContent)) (() :: Constraint) (TypeError (ShowType a :<>: Text " can't contain a string")) @@ -628,591 +809,592 @@ 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 +type family Elem (a :: k) (xs :: [k]) where Elem a (a : xs) = True Elem a (_ : xs) = Elem a xs Elem a '[] = False -newtype Tagged (proxies :: [Symbol]) target (next :: *) = Tagged target +newtype Tagged (proxies :: [Symbol]) target = Tagged target -type Symbols a = Fuse (RenderTags (PruneTags (ToTypeList a))) +type Symbols a = Fuse (ToTypeList a) +type family GetAttributeInfo a where + GetAttributeInfo AcceptA = '[Form, Input] + GetAttributeInfo AcceptCharsetA = '[Form] + GetAttributeInfo AccesskeyA = '[] + GetAttributeInfo ActionA = '[Form] + GetAttributeInfo AlignA = '[Applet, Caption, Col, Colgroup, Hr, Iframe, Img, Table, Tbody, Td, Tfoot, Th, Thead, Tr] + GetAttributeInfo AltA = '[Applet, Area, Img, Input] + GetAttributeInfo AsyncA = '[Script] + GetAttributeInfo AutocompleteA = '[Form, Input] + GetAttributeInfo AutofocusA = '[Button, Input, Keygen, Select, Textarea] + GetAttributeInfo AutoplayA = '[Audio, Video] + GetAttributeInfo AutosaveA = '[Input] + GetAttributeInfo BgcolorA = '[Body, Col, Colgroup, Marquee, Table, Tbody, Tfoot, Td, Th, Tr] + GetAttributeInfo BorderA = '[Img, Object, Table] + GetAttributeInfo BufferedA = '[Audio, Video] + GetAttributeInfo ChallengeA = '[Keygen] + GetAttributeInfo CharsetA = '[Meta, Script] + GetAttributeInfo CheckedA = '[Command, Input] + GetAttributeInfo CiteA = '[Blockquote, Del, Ins, Q] + GetAttributeInfo ClassA = '[] + GetAttributeInfo CodeA = '[Applet] + GetAttributeInfo CodebaseA = '[Applet] + GetAttributeInfo ColorA = '[Basefont, Font, Hr] + GetAttributeInfo ColsA = '[Textarea] + GetAttributeInfo ColspanA = '[Td, Th] + GetAttributeInfo ContentA = '[Meta] + GetAttributeInfo ContenteditableA = '[] + GetAttributeInfo ContextmenuA = '[] + GetAttributeInfo ControlsA = '[Audio, Video] + GetAttributeInfo CoordsA = '[Area] + GetAttributeInfo CrossoriginA = '[Audio, Img, Link, Script, Video] + GetAttributeInfo DataA = '[Object] + GetAttributeInfo DatetimeA = '[Del, Ins, Time] + GetAttributeInfo DefaultA = '[Track] + GetAttributeInfo DeferA = '[Script] + GetAttributeInfo DirA = '[] + GetAttributeInfo DirnameA = '[Input, Textarea] + GetAttributeInfo DisabledA = '[Button, Command, Fieldset, Input, Keygen, Optgroup, Option, Select, Textarea] + GetAttributeInfo DownloadA = '[A, Area] + GetAttributeInfo DraggableA = '[] + GetAttributeInfo DropzoneA = '[] + GetAttributeInfo EnctypeA = '[Form] + GetAttributeInfo ForA = '[Label, Output] + GetAttributeInfo FormA = '[Button, Fieldset, Input, Keygen, Label, Meter, Object, Output, Progress, Select, Textarea] + GetAttributeInfo FormactionA = '[Input, Button] + GetAttributeInfo HeadersA = '[Td, Th] + GetAttributeInfo HeightA = '[Canvas, Embed, Iframe, Img, Input, Object, Video] + GetAttributeInfo HiddenA = '[] + GetAttributeInfo HighA = '[Meter] + GetAttributeInfo HrefA = '[A, Area, Base, Link] + GetAttributeInfo HreflangA = '[A, Area, Link] + GetAttributeInfo HttpEquivA = '[Meta] + GetAttributeInfo IconA = '[Command] + GetAttributeInfo IdA = '[] + GetAttributeInfo IntegrityA = '[Link, Script] + GetAttributeInfo IsmapA = '[Img] + GetAttributeInfo ItempropA = '[] + GetAttributeInfo KeytypeA = '[Keygen] + GetAttributeInfo KindA = '[Track] + GetAttributeInfo LabelA = '[Track] + GetAttributeInfo LangA = '[] + GetAttributeInfo LanguageA = '[Script] + GetAttributeInfo ListA = '[Input] + GetAttributeInfo LoopA = '[Audio, Bgsound, Marquee, Video] + GetAttributeInfo LowA = '[Meter] + GetAttributeInfo ManifestA = '[Html] + GetAttributeInfo MaxA = '[Input, Meter, Progress] + GetAttributeInfo MaxlengthA = '[Input, Textarea] + GetAttributeInfo MinlengthA = '[Input, Textarea] + GetAttributeInfo MediaA = '[A, Area, Link, Source, Style] + GetAttributeInfo MethodA = '[Form] + GetAttributeInfo MinA = '[Input, Meter] + GetAttributeInfo MultipleA = '[Input, Select] + GetAttributeInfo MutedA = '[Video] + GetAttributeInfo NameA = '[Button, Form, Fieldset, Iframe, Input, Keygen, Object, Output, Select, Textarea, Map, Meta, Param] + GetAttributeInfo NovalidateA = '[Form] + GetAttributeInfo OpenA = '[Details] + GetAttributeInfo OptimumA = '[Meter] + GetAttributeInfo PatternA = '[Input] + GetAttributeInfo PingA = '[A, Area] + GetAttributeInfo PlaceholderA = '[Input, Textarea] + GetAttributeInfo PosterA = '[Video] + GetAttributeInfo PreloadA = '[Audio, Video] + GetAttributeInfo RadiogroupA = '[Command] + GetAttributeInfo ReadonlyA = '[Input, Textarea] + GetAttributeInfo RelA = '[A, Area, Link] + GetAttributeInfo RequiredA = '[Input, Select, Textarea] + GetAttributeInfo ReversedA = '[Ol] + GetAttributeInfo RowsA = '[Textarea] + GetAttributeInfo RowspanA = '[Td, Th] + GetAttributeInfo SandboxA = '[Iframe] + GetAttributeInfo ScopeA = '[Th] + GetAttributeInfo ScopedA = '[Style] + GetAttributeInfo SeamlessA = '[Iframe] + GetAttributeInfo SelectedA = '[Option] + GetAttributeInfo ShapeA = '[A, Area] + GetAttributeInfo SizeA = '[Input, Select] + GetAttributeInfo SizesA = '[Link, Img, Source] + GetAttributeInfo SlotA = '[] + GetAttributeInfo SpanA = '[Col, Colgroup] + GetAttributeInfo SpellcheckA = '[] + GetAttributeInfo SrcA = '[Audio, Embed, Iframe, Img, Input, Script, Source, Track, Video] + GetAttributeInfo SrcdocA = '[Iframe] + GetAttributeInfo SrclangA = '[Track] + GetAttributeInfo SrcsetA = '[Img] + GetAttributeInfo StartA = '[Ol] + GetAttributeInfo StepA = '[Input] + GetAttributeInfo StyleA = '[] + GetAttributeInfo SummaryA = '[Table] + GetAttributeInfo TabindexA = '[] + GetAttributeInfo TargetA = '[A, Area, Base, Form] + GetAttributeInfo TitleA = '[] + GetAttributeInfo TypeA = '[Button, Input, Command, Embed, Object, Script, Source, Style, Menu] + GetAttributeInfo UsemapA = '[Img, Input, Object] + GetAttributeInfo ValueA = '[Button, Option, Input, Li, Meter, Progress, Param] + GetAttributeInfo WidthA = '[Canvas, Embed, Iframe, Img, Input, Object, Video] + GetAttributeInfo WrapA = '[Textarea] + -- | 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 + NoContent 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]) 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 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 + (MetadataContent :|: FlowContent) 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 diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -112,23 +112,6 @@ shouldBe "" - 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 - "" - - allT (tr_ $ td_ ()) - shouldBe - "" - - allT (table_ . tr_ $ td_ ()) - shouldBe - "
" - it "handles trailing text" $ do property $ \(Escaped x) (Escaped y) -> allT (td_ x # y) @@ -167,49 +150,15 @@ it "handles tags in a list with parallel elements" $ do - allT [td_ "a" # td_ "b"] - shouldBe - "ab" - - 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 - "abc" - - allT ([td_ "a" # td_ "b"] # div_ "c") - shouldBe - "ab
c
" - - allT ([div_ "a" # td_ "b"] # td_ "c") - shouldBe - "
a
bc" - - it "handles tags in a list when the list is the last child" $ do - - allT (tr_ [td_ "a" # td_ "b"]) + allT [div_ "a" # i_ "b"] shouldBe - "ab" + "
a
b" it "handles nested lists" $ do - allT (table_ [tr_ [td_ (4 :: Int)]]) - shouldBe - "
4
" - - it "handles tags before a list" $ do - - pendingWith "This is a not yet implemented optimization" - - allT (td_ "a" # [td_ "b"] # table_ ()) - shouldBe - "ab
" - - allT (td_ "a" # [td_ "b"] # td_ "c") + allT (div_ [div_ [div_ (4 :: Int)]]) shouldBe - "abc" + "
4
" it "handles utf8 correctly" $ do @@ -220,75 +169,3 @@ allT (img_A (A.id_ "a ä € 𝄞")) shouldBe "" - - it "computes its result lazily (String)" $ do - - pending - - renderString (errorWithoutStackTrace "1) not lazy" :: 'Img > ()) - `shouldBe` - "" - - take 5 (renderString (div_ (errorWithoutStackTrace "2) not lazy" :: String))) - `shouldBe` - "
" - - take 5 (renderString (errorWithoutStackTrace "3) not lazy" :: 'Div > String)) - `shouldBe` - "
" - - take 12 (renderString (div_ "a" # (errorWithoutStackTrace "4) not lazy" :: String))) - `shouldBe` - "
a
" - - take 17 (renderString (div_ "a" # [img_ # (errorWithoutStackTrace "5) not lazy" :: String)])) - `shouldBe` - "
a
" - - it "computes its result lazily (Text)" $ do - - pending - - T.unpack (renderText (errorWithoutStackTrace "1) not lazy" :: 'Img > ())) - `shouldBe` - "" - - take 5 (T.unpack (renderText (div_ (errorWithoutStackTrace "2) not lazy" :: String)))) - `shouldBe` - "
" - - take 5 (T.unpack (renderText (errorWithoutStackTrace "3) not lazy" :: 'Div > String))) - `shouldBe` - "
" - - take 12 (T.unpack (renderText (div_ "a" # (errorWithoutStackTrace "4) not lazy" :: String)))) - `shouldBe` - "
a
" - - take 17 (T.unpack (renderText (div_ "a" # [img_ # (errorWithoutStackTrace "5) not lazy" :: String)]))) - `shouldBe` - "
a
" - - it "computes its result lazily (ByteString)" $ do - - pending - - T.unpack (decodeUtf8 (renderByteString (errorWithoutStackTrace "1) not lazy" :: 'Img > ()))) - `shouldBe` - "" - - take 5 (T.unpack (decodeUtf8 (renderByteString (div_ (errorWithoutStackTrace "2) not lazy" :: String))))) - `shouldBe` - "
" - - take 5 (T.unpack (decodeUtf8 (renderByteString (errorWithoutStackTrace "3) not lazy" :: 'Div > String)))) - `shouldBe` - "
" - - take 12 (T.unpack (decodeUtf8 (renderByteString (div_ "a" # (errorWithoutStackTrace "4) not lazy" :: String))))) - `shouldBe` - "
a
" - - take 17 (T.unpack (decodeUtf8 (renderByteString (div_ "a" # [img_ # (errorWithoutStackTrace "5) not lazy" :: String)])))) - `shouldBe` - "
a
" diff --git a/type-of-html.cabal b/type-of-html.cabal --- a/type-of-html.cabal +++ b/type-of-html.cabal @@ -1,5 +1,5 @@ name: type-of-html -version: 0.4.1.1 +version: 0.5.0.0 synopsis: High performance type driven html generation. description: This library makes most invalid html documents compile time errors and uses advanced type level features to realise compile time computations. license: BSD3