type-of-html 1.0.1.1 → 1.1.0.0

raw patch · 11 files changed

+409/−239 lines, 11 filesdep ~basePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Readme.md +123/−13
• src/Html.hs +0/−2
• src/Html/Attribute.hs +2/−2
• src/Html/Convert.hs +22/−1
• src/Html/Element.hs +147/−147
• src/Html/Reify.hs +9/−13
• src/Html/Type.hs +1/−1
• src/Html/Type/Internal.hs +14/−56
• src/Html/Type/Internal/GHC.hs +79/−0
• type-of-html.cabal +6/−4

@@ -1,5 +1,11 @@ # Revision history for type-of-html +## 1.1.0.0  -- 2017-11-04++* add support for ghc 802+* simplify types+* set up ci+ ## 1.0.1.0  -- 2017-10-29  * export Document

@@ -6,7 +6,7 @@ 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.+Note that you need at least ghc 8.0.  ## Typesafety @@ -149,12 +149,14 @@  ![type-of-html](https://user-images.githubusercontent.com/5609565/30524978-229dd21c-9bfe-11e7-8404-1f69b93cec22.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.+To look at the exact code of this benchmark look into 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. +If you use ghc 802 performance will be about 20% slower compared to+newer ghcs, but obviously still a lot faster than blaze.+ 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 and attributes as kinds and map these@@ -319,28 +321,136 @@     ( body_       ( h1_         ( img_-        # strong_ "0"+        # strong_ "foo"         )       # div_-        ( div_ "1"+        ( div_ "bar"         )       # div_         ( form_           ( fieldset_             ( div_               ( div_-                ( label_ "a"+                ( label_ "zot"                 # select_-                  ( option_ "b"-                  # option_ "c"+                  ( option_ 'b'+                  # option_ 'c'                   )-                # div_ "d"+                # map div_ [1..5 :: Int]                 )               )-            # button_ (i_ "e")+            # button_ (i_ ())             )           )         )       )     ) ```++## FAQ++### Why don't you provide a pretty printer?++It's sadly not possible to pretty print html source in a semantic preserving way.+If you add before every tag a newline and indentation, the following happens:++```html+<i>a</i><em>b</em>+```++```html+<i>+  a+</i>+<em>+  b+</em>+```++This would add a space when rendering.  So perhaps we'll avoid all+these text modifying tags, but now look at `<pre>`. Every whitespace+and newline within is semantically important.  And even if we avoid+modifying stuff within `<pre>`, there is the nasty css property+`white-space: pre;`. With this, all bets are off to modify any+indenting, because we can't know which css will apply to the document:+- It may include a link, so it would be dynamic.+- There might be meddling javascript.+- The user of the browser is free to activate a custom css.++If we go creative, there is still one option:++```html+<div+  ><div+    >Hello World!<+  /div><+/div>+```++Or++```html+<+div+  ><+  div+    >Hello World!<+  /div+  ><+/div+>+```++Or++```html+<+div        ><+  div      >Hello <+    i      >World!<+    /i     ><+  /div     ><+/div+>+```++++These styles would be semantically correct, but would they be pretty?+Personally, I think the third style is quite interesting, it seperates+structure from content with a table layout and indicates explicitly+the lack of content.++I recommend, that if you want to debug html, use mozilla fire bug, so+you can as well fold trees and look at the rendering.++### Why don't you keep track of appended tag lengths at compile time?+Well, it's true that we could improve performance a miniscule by that:+by knowing the length of the string, we could just use internal+bytestring functions to copy over the addr#.  This would avoid a ccall+to determine the length of the addr# more or less per tag.++At the other hand, luckily ghc moves all these bytestrings to the+toplevel in core, so we have this cost only the first time we use this+bytestring.  Considering that most webpages have a lot more than one+visitor, this dwarfs the cost (about 3 nanoseconds) a lot.++The negative side of doing this would be a severe complication for the+typechecker, which is already quite stressed with this library.++Besides, there is a ghc ticket about replacing compile time strings+(addr#) with bytearray#, which contains it's length. So in some+future, we'll have this for free.++### Wouldn't it be more efficient to append all compile time stuff to one huge Symbol and use '[(Nat,Nat)] to slice it?+Cool idea, but no.  This would reduce memory fragmentation and avoid a+terminating null more or less per tag at the cost of the lost of+sharing. Being unable to inspect a Symbol, we would end up with a lot+of repetitions, which are at the moment shared.  Even the bytestring,+which is used for the Symbol, is shared of equal Symbols.++### Isn't there any performance tweak left?+At the moment, string literals are handled well, but not optimal.  The+escaping of string literals is done everytime when rendering the html+document, ideally we convince GHC to float the escaped string literal+to top level.  I guess, that would make things a lot faster.

@@ -25,8 +25,6 @@ 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) 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

@@ -353,5 +353,5 @@ wrap_ :: a -> 'WrapA := a wrap_ = AT -addAttributes :: (a ??> b, a ?> c) => b -> a > c -> (a :@: b) c-addAttributes b (Child c) = WithAttributes b c+addAttributes :: (a ??> (b # b'), a ?> c) => b' -> (a :@: b) c -> (a :@: (b # b')) c+addAttributes b' (WithAttributes b c) = WithAttributes (b # b') c

@@ -1,8 +1,12 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE FlexibleContexts           #-}+{-# LANGUAGE KindSignatures             #-} {-# LANGUAGE TypeOperators              #-} {-# LANGUAGE BangPatterns               #-} {-# LANGUAGE MagicHash                  #-}+{-# LANGUAGE DataKinds                  #-}  module Html.Convert   ( Converted(..)@@ -106,7 +110,7 @@     <> if vegetarian then "oranges." else "meat."  john :: Person-john = Person {name = "John", age = 52, vegetarian = True}+john = Person {name = \"John\", age = 52, vegetarian = True}  main :: IO () main = print (div_ john)@@ -115,6 +119,9 @@ class Convert a where   convert :: a -> Converted +instance Convert () where+  {-# INLINE convert #-}+  convert _ = mempty instance Convert b => Convert (a := b) where   {-# INLINE convert #-}   convert (AT x) = convert x@@ -163,6 +170,20 @@ instance KnownSymbol a => Convert (Proxy a) where   {-# INLINE convert #-}   convert = Converted . U.byteStringCopy . fromString . symbolVal+instance ConcatSymbol xs => Convert (Proxy (xs :: [Symbol])) where+  {-# INLINE convert #-}+  convert = Converted . U.byteStringCopy . fromString . concatSymbol++class ConcatSymbol (xs :: [Symbol]) where+  concatSymbol :: Proxy xs -> String++instance (KnownSymbol x, ConcatSymbol xs) => ConcatSymbol (x ': xs) where+  {-# INLINE concatSymbol #-}+  concatSymbol _ = symbolVal (Proxy :: Proxy x) ++ concatSymbol (Proxy :: Proxy xs)++instance ConcatSymbol '[] where+  {-# INLINE concatSymbol #-}+  concatSymbol _ = mempty  {-# INLINE builderCString# #-} builderCString# :: BP.BoundedPrim Word8 -> Addr# -> Converted

@@ -8,880 +8,880 @@ import Html.Type  doctype_ :: 'DOCTYPE > ()-doctype_ = Child ()+doctype_ = WithAttributes () ()  a_ :: ('A ?> a) => a -> 'A > a-a_ = Child+a_ = WithAttributes ()  a_A :: ('A ??> a, 'A ?> b) => a -> b -> ('A :@: a) b a_A = WithAttributes  abbr_ :: ('Abbr ?> a) => a -> 'Abbr > a-abbr_ = Child+abbr_ = WithAttributes ()  abbr_A :: ('Abbr ??> a, 'Abbr ?> b) => a -> b -> ('Abbr :@: a) b abbr_A = WithAttributes  acronym_ :: ('Acronym ?> a) => a -> 'Acronym > a-acronym_ = Child+acronym_ = WithAttributes ()  acronym_A :: ('Acronym ??> a, 'Acronym ?> b) => a -> b -> ('Acronym :@: a) b acronym_A = WithAttributes  address_ :: ('Address ?> a) => a -> 'Address > a-address_ = Child+address_ = WithAttributes ()  address_A :: ('Address ??> a, 'Address ?> b) => a -> b -> ('Address :@: a) b address_A = WithAttributes  applet_ :: ('Applet ?> a) => a -> 'Applet > a-applet_ = Child+applet_ = WithAttributes ()  applet_A :: ('Applet ??> a, 'Applet ?> b) => a -> b -> ('Applet :@: a) b applet_A = WithAttributes  area_ :: 'Area > ()-area_ = Child ()+area_ = WithAttributes () ()  area_A :: 'Area ??> a => a -> ('Area :@: a) () area_A = flip WithAttributes ()  article_ :: ('Article ?> a) => a -> 'Article > a-article_ = Child+article_ = WithAttributes ()  article_A :: ('Article ??> a, 'Article ?> b) => a -> b -> ('Article :@: a) b article_A = WithAttributes  aside_ :: ('Aside ?> a) => a -> 'Aside > a-aside_ = Child+aside_ = WithAttributes ()  aside_A :: ('Aside ??> a, 'Aside ?> b) => a -> b -> ('Aside :@: a) b aside_A = WithAttributes  audio_ :: ('Audio ?> a) => a -> 'Audio > a-audio_ = Child+audio_ = WithAttributes ()  audio_A :: ('Audio ??> a, 'Audio ?> b) => a -> b -> ('Audio :@: a) b audio_A = WithAttributes  b_ :: ('B ?> a) => a -> 'B > a-b_ = Child+b_ = WithAttributes ()  b_A :: ('B ??> a, 'B ?> b) => a -> b -> ('B :@: a) b b_A = WithAttributes  base_ :: 'Base > ()-base_ = Child ()+base_ = WithAttributes () ()  base_A :: 'Base ??> a => a -> ('Base :@: a) () base_A = flip WithAttributes ()  basefont_ :: ('Basefont ?> a) => a -> 'Basefont > a-basefont_ = Child+basefont_ = WithAttributes ()  basefont_A :: ('Basefont ??> a, 'Basefont ?> b) => a -> b -> ('Basefont :@: a) b basefont_A = WithAttributes  bdi_ :: ('Bdi ?> a) => a -> 'Bdi > a-bdi_ = Child+bdi_ = WithAttributes ()  bdi_A :: ('Bdi ??> a, 'Bdi ?> b) => a -> b -> ('Bdi :@: a) b bdi_A = WithAttributes  bdo_ :: ('Bdo ?> a) => a -> 'Bdo > a-bdo_ = Child+bdo_ = WithAttributes ()  bdo_A :: ('Bdo ??> a, 'Bdo ?> b) => a -> b -> ('Bdo :@: a) b bdo_A = WithAttributes  bgsound_ :: ('Bgsound ?> a) => a -> 'Bgsound > a-bgsound_ = Child+bgsound_ = WithAttributes ()  bgsound_A :: ('Bgsound ??> a, 'Bgsound ?> b) => a -> b -> ('Bgsound :@: a) b bgsound_A = WithAttributes  big_ :: ('Big ?> a) => a -> 'Big > a-big_ = Child+big_ = WithAttributes ()  big_A :: ('Big ??> a, 'Big ?> b) => a -> b -> ('Big :@: a) b big_A = WithAttributes  blink_ :: ('Blink ?> a) => a -> 'Blink > a-blink_ = Child+blink_ = WithAttributes ()  blink_A :: ('Blink ??> a, 'Blink ?> b) => a -> b -> ('Blink :@: a) b blink_A = WithAttributes  blockquote_ :: ('Blockquote ?> a) => a -> 'Blockquote > a-blockquote_ = Child+blockquote_ = WithAttributes ()  blockquote_A :: ('Blockquote ??> a, 'Blockquote ?> b) => a -> b -> ('Blockquote :@: a) b blockquote_A = WithAttributes  body_ :: ('Body ?> a) => a -> 'Body > a-body_ = Child+body_ = WithAttributes ()  body_A :: ('Body ??> a, 'Body ?> b) => a -> b -> ('Body :@: a) b body_A = WithAttributes  br_ :: 'Br > ()-br_ = Child ()+br_ = WithAttributes () ()  br_A :: 'Br ??> a => a -> ('Br :@: a) () br_A = flip WithAttributes ()  button_ :: ('Button ?> a) => a -> 'Button > a-button_ = Child+button_ = WithAttributes ()  button_A :: ('Button ??> a, 'Button ?> b) => a -> b -> ('Button :@: a) b button_A = WithAttributes  canvas_ :: ('Canvas ?> a) => a -> 'Canvas > a-canvas_ = Child+canvas_ = WithAttributes ()  canvas_A :: ('Canvas ??> a, 'Canvas ?> b) => a -> b -> ('Canvas :@: a) b canvas_A = WithAttributes  caption_ :: ('Caption ?> a) => a -> 'Caption > a-caption_ = Child+caption_ = WithAttributes ()  caption_A :: ('Caption ??> a, 'Caption ?> b) => a -> b -> ('Caption :@: a) b caption_A = WithAttributes  center_ :: ('Center ?> a) => a -> 'Center > a-center_ = Child+center_ = WithAttributes ()  center_A :: ('Center ??> a, 'Center ?> b) => a -> b -> ('Center :@: a) b center_A = WithAttributes  cite_ :: ('Cite ?> a) => a -> 'Cite > a-cite_ = Child+cite_ = WithAttributes ()  cite_A :: ('Cite ??> a, 'Cite ?> b) => a -> b -> ('Cite :@: a) b cite_A = WithAttributes  code_ :: ('Code ?> a) => a -> 'Code > a-code_ = Child+code_ = WithAttributes ()  code_A :: ('Code ??> a, 'Code ?> b) => a -> b -> ('Code :@: a) b code_A = WithAttributes  col_ :: 'Col > ()-col_ = Child ()+col_ = WithAttributes () ()  col_A :: 'Col ??> a => a -> ('Col :@: a) () col_A = flip WithAttributes ()  colgroup_ :: ('Colgroup ?> a) => a -> 'Colgroup > a-colgroup_ = Child+colgroup_ = WithAttributes ()  colgroup_A :: ('Colgroup ??> a, 'Colgroup ?> b) => a -> b -> ('Colgroup :@: a) b colgroup_A = WithAttributes  command_ :: ('Command ?> a) => a -> 'Command > a-command_ = Child+command_ = WithAttributes ()  command_A :: ('Command ??> a, 'Command ?> b) => a -> b -> ('Command :@: a) b command_A = WithAttributes  content_ :: ('Content ?> a) => a -> 'Content > a-content_ = Child+content_ = WithAttributes ()  content_A :: ('Content ??> a, 'Content ?> b) => a -> b -> ('Content :@: a) b content_A = WithAttributes  data_ :: ('Data ?> a) => a -> 'Data > a-data_ = Child+data_ = WithAttributes ()  data_A :: ('Data ??> a, 'Data ?> b) => a -> b -> ('Data :@: a) b data_A = WithAttributes  datalist_ :: ('Datalist ?> a) => a -> 'Datalist > a-datalist_ = Child+datalist_ = WithAttributes ()  datalist_A :: ('Datalist ??> a, 'Datalist ?> b) => a -> b -> ('Datalist :@: a) b datalist_A = WithAttributes  dd_ :: ('Dd ?> a) => a -> 'Dd > a-dd_ = Child+dd_ = WithAttributes ()  dd_A :: ('Dd ??> a, 'Dd ?> b) => a -> b -> ('Dd :@: a) b dd_A = WithAttributes  del_ :: ('Del ?> a) => a -> 'Del > a-del_ = Child+del_ = WithAttributes ()  del_A :: ('Del ??> a, 'Del ?> b) => a -> b -> ('Del :@: a) b del_A = WithAttributes  details_ :: ('Details ?> a) => a -> 'Details > a-details_ = Child+details_ = WithAttributes ()  details_A :: ('Details ??> a, 'Details ?> b) => a -> b -> ('Details :@: a) b details_A = WithAttributes  dfn_ :: ('Dfn ?> a) => a -> 'Dfn > a-dfn_ = Child+dfn_ = WithAttributes ()  dfn_A :: ('Dfn ??> a, 'Dfn ?> b) => a -> b -> ('Dfn :@: a) b dfn_A = WithAttributes  dialog_ :: ('Dialog ?> a) => a -> 'Dialog > a-dialog_ = Child+dialog_ = WithAttributes ()  dialog_A :: ('Dialog ??> a, 'Dialog ?> b) => a -> b -> ('Dialog :@: a) b dialog_A = WithAttributes  dir_ :: ('Dir ?> a) => a -> 'Dir > a-dir_ = Child+dir_ = WithAttributes ()  dir_A :: ('Dir ??> a, 'Dir ?> b) => a -> b -> ('Dir :@: a) b dir_A = WithAttributes  div_ :: ('Div ?> a) => a -> 'Div > a-div_ = Child+div_ = WithAttributes ()  div_A :: ('Div ??> a, 'Div ?> b) => a -> b -> ('Div :@: a) b div_A = WithAttributes  dl_ :: ('Dl ?> a) => a -> 'Dl > a-dl_ = Child+dl_ = WithAttributes ()  dl_A :: ('Dl ??> a, 'Dl ?> b) => a -> b -> ('Dl :@: a) b dl_A = WithAttributes  dt_ :: ('Dt ?> a) => a -> 'Dt > a-dt_ = Child+dt_ = WithAttributes ()  dt_A :: ('Dt ??> a, 'Dt ?> b) => a -> b -> ('Dt :@: a) b dt_A = WithAttributes  element_ :: ('Element ?> a) => a -> 'Element > a-element_ = Child+element_ = WithAttributes ()  element_A :: ('Element ??> a, 'Element ?> b) => a -> b -> ('Element :@: a) b element_A = WithAttributes  em_ :: ('Em ?> a) => a -> 'Em > a-em_ = Child+em_ = WithAttributes ()  em_A :: ('Em ??> a, 'Em ?> b) => a -> b -> ('Em :@: a) b em_A = WithAttributes  embed_ :: 'Embed > ()-embed_ = Child ()+embed_ = WithAttributes () ()  embed_A :: 'Embed ??> a => a -> ('Embed :@: a) () embed_A = flip WithAttributes ()  fieldset_ :: ('Fieldset ?> a) => a -> 'Fieldset > a-fieldset_ = Child+fieldset_ = WithAttributes ()  fieldset_A :: ('Fieldset ??> a, 'Fieldset ?> b) => a -> b -> ('Fieldset :@: a) b fieldset_A = WithAttributes  figcaption_ :: ('Figcaption ?> a) => a -> 'Figcaption > a-figcaption_ = Child+figcaption_ = WithAttributes ()  figcaption_A :: ('Figcaption ??> a, 'Figcaption ?> b) => a -> b -> ('Figcaption :@: a) b figcaption_A = WithAttributes  figure_ :: ('Figure ?> a) => a -> 'Figure > a-figure_ = Child+figure_ = WithAttributes ()  figure_A :: ('Figure ??> a, 'Figure ?> b) => a -> b -> ('Figure :@: a) b figure_A = WithAttributes  font_ :: ('Font ?> a) => a -> 'Font > a-font_ = Child+font_ = WithAttributes ()  font_A :: ('Font ??> a, 'Font ?> b) => a -> b -> ('Font :@: a) b font_A = WithAttributes  footer_ :: ('Footer ?> a) => a -> 'Footer > a-footer_ = Child+footer_ = WithAttributes ()  footer_A :: ('Footer ??> a, 'Footer ?> b) => a -> b -> ('Footer :@: a) b footer_A = WithAttributes  form_ :: ('Form ?> a) => a -> 'Form > a-form_ = Child+form_ = WithAttributes ()  form_A :: ('Form ??> a, 'Form ?> b) => a -> b -> ('Form :@: a) b form_A = WithAttributes  frame_ :: ('Frame ?> a) => a -> 'Frame > a-frame_ = Child+frame_ = WithAttributes ()  frame_A :: ('Frame ??> a, 'Frame ?> b) => a -> b -> ('Frame :@: a) b frame_A = WithAttributes  frameset_ :: ('Frameset ?> a) => a -> 'Frameset > a-frameset_ = Child+frameset_ = WithAttributes ()  frameset_A :: ('Frameset ??> a, 'Frameset ?> b) => a -> b -> ('Frameset :@: a) b frameset_A = WithAttributes  h1_ :: ('H1 ?> a) => a -> 'H1 > a-h1_ = Child+h1_ = WithAttributes ()  h1_A :: ('H1 ??> a, 'H1 ?> b) => a -> b -> ('H1 :@: a) b h1_A = WithAttributes  h2_ :: ('H2 ?> a) => a -> 'H2 > a-h2_ = Child+h2_ = WithAttributes ()  h2_A :: ('H2 ??> a, 'H2 ?> b) => a -> b -> ('H2 :@: a) b h2_A = WithAttributes  h3_ :: ('H3 ?> a) => a -> 'H3 > a-h3_ = Child+h3_ = WithAttributes ()  h3_A :: ('H3 ??> a, 'H3 ?> b) => a -> b -> ('H3 :@: a) b h3_A = WithAttributes  h4_ :: ('H4 ?> a) => a -> 'H4 > a-h4_ = Child+h4_ = WithAttributes ()  h4_A :: ('H4 ??> a, 'H4 ?> b) => a -> b -> ('H4 :@: a) b h4_A = WithAttributes  h5_ :: ('H5 ?> a) => a -> 'H5 > a-h5_ = Child+h5_ = WithAttributes ()  h5_A :: ('H5 ??> a, 'H5 ?> b) => a -> b -> ('H5 :@: a) b h5_A = WithAttributes  h6_ :: ('H6 ?> a) => a -> 'H6 > a-h6_ = Child+h6_ = WithAttributes ()  h6_A :: ('H6 ??> a, 'H6 ?> b) => a -> b -> ('H6 :@: a) b h6_A = WithAttributes  head_ :: ('Head ?> a) => a -> 'Head > a-head_ = Child+head_ = WithAttributes ()  head_A :: ('Head ??> a, 'Head ?> b) => a -> b -> ('Head :@: a) b head_A = WithAttributes  header_ :: ('Header ?> a) => a -> 'Header > a-header_ = Child+header_ = WithAttributes ()  header_A :: ('Header ??> a, 'Header ?> b) => a -> b -> ('Header :@: a) b header_A = WithAttributes  hgroup_ :: ('Hgroup ?> a) => a -> 'Hgroup > a-hgroup_ = Child+hgroup_ = WithAttributes ()  hgroup_A :: ('Hgroup ??> a, 'Hgroup ?> b) => a -> b -> ('Hgroup :@: a) b hgroup_A = WithAttributes  hr_ :: 'Hr > ()-hr_ = Child ()+hr_ = WithAttributes () ()  hr_A :: 'Hr ??> a => a -> ('Hr :@: a) () hr_A = flip WithAttributes ()  html_ :: ('Html ?> a) => a -> 'Html > a-html_ = Child+html_ = WithAttributes ()  html_A :: ('Html ??> a, 'Html ?> b) => a -> b -> ('Html :@: a) b html_A = WithAttributes  i_ :: ('I ?> a) => a -> 'I > a-i_ = Child+i_ = WithAttributes ()  i_A :: ('I ??> a, 'I ?> b) => a -> b -> ('I :@: a) b i_A = WithAttributes  iframe_ :: 'Iframe > ()-iframe_ = Child ()+iframe_ = WithAttributes () ()  iframe_A :: 'Iframe ??> a => a -> ('Iframe :@: a) () iframe_A = flip WithAttributes ()  image_ :: ('Image ?> a) => a -> 'Image > a-image_ = Child+image_ = WithAttributes ()  image_A :: ('Image ??> a, 'Image ?> b) => a -> b -> ('Image :@: a) b image_A = WithAttributes  img_ :: 'Img > ()-img_ = Child ()+img_ = WithAttributes () ()  img_A :: 'Img ??> a => a -> ('Img :@: a) () img_A = flip WithAttributes ()  input_ :: ('Input ?> a) => a -> 'Input > a-input_ = Child+input_ = WithAttributes ()  input_A :: ('Input ??> a, 'Input ?> b) => a -> b -> ('Input :@: a) b input_A = WithAttributes  ins_ :: ('Ins ?> a) => a -> 'Ins > a-ins_ = Child+ins_ = WithAttributes ()  ins_A :: ('Ins ??> a, 'Ins ?> b) => a -> b -> ('Ins :@: a) b ins_A = WithAttributes  isindex_ :: ('Isindex ?> a) => a -> 'Isindex > a-isindex_ = Child+isindex_ = WithAttributes ()  isindex_A :: ('Isindex ??> a, 'Isindex ?> b) => a -> b -> ('Isindex :@: a) b isindex_A = WithAttributes  kbd_ :: ('Kbd ?> a) => a -> 'Kbd > a-kbd_ = Child+kbd_ = WithAttributes ()  kbd_A :: ('Kbd ??> a, 'Kbd ?> b) => a -> b -> ('Kbd :@: a) b kbd_A = WithAttributes  keygen_ :: ('Keygen ?> a) => a -> 'Keygen > a-keygen_ = Child+keygen_ = WithAttributes ()  keygen_A :: ('Keygen ??> a, 'Keygen ?> b) => a -> b -> ('Keygen :@: a) b keygen_A = WithAttributes  label_ :: ('Label ?> a) => a -> 'Label > a-label_ = Child+label_ = WithAttributes ()  label_A :: ('Label ??> a, 'Label ?> b) => a -> b -> ('Label :@: a) b label_A = WithAttributes  legend_ :: ('Legend ?> a) => a -> 'Legend > a-legend_ = Child+legend_ = WithAttributes ()  legend_A :: ('Legend ??> a, 'Legend ?> b) => a -> b -> ('Legend :@: a) b legend_A = WithAttributes  li_ :: ('Li ?> a) => a -> 'Li > a-li_ = Child+li_ = WithAttributes ()  li_A :: ('Li ??> a, 'Li ?> b) => a -> b -> ('Li :@: a) b li_A = WithAttributes  link_ :: 'Link > ()-link_ = Child ()+link_ = WithAttributes () ()  link_A :: 'Link ??> a => a -> ('Link :@: a) () link_A = flip WithAttributes ()  listing_ :: ('Listing ?> a) => a -> 'Listing > a-listing_ = Child+listing_ = WithAttributes ()  listing_A :: ('Listing ??> a, 'Listing ?> b) => a -> b -> ('Listing :@: a) b listing_A = WithAttributes  main_ :: ('Main ?> a) => a -> 'Main > a-main_ = Child+main_ = WithAttributes ()  main_A :: ('Main ??> a, 'Main ?> b) => a -> b -> ('Main :@: a) b main_A = WithAttributes  map_ :: ('Map ?> a) => a -> 'Map > a-map_ = Child+map_ = WithAttributes ()  map_A :: ('Map ??> a, 'Map ?> b) => a -> b -> ('Map :@: a) b map_A = WithAttributes  mark_ :: ('Mark ?> a) => a -> 'Mark > a-mark_ = Child+mark_ = WithAttributes ()  mark_A :: ('Mark ??> a, 'Mark ?> b) => a -> b -> ('Mark :@: a) b mark_A = WithAttributes  marquee_ :: ('Marquee ?> a) => a -> 'Marquee > a-marquee_ = Child+marquee_ = WithAttributes ()  marquee_A :: ('Marquee ??> a, 'Marquee ?> b) => a -> b -> ('Marquee :@: a) b marquee_A = WithAttributes  math_ :: ('Math ?> a) => a -> 'Math > a-math_ = Child+math_ = WithAttributes ()  math_A :: ('Math ??> a, 'Math ?> b) => a -> b -> ('Math :@: a) b math_A = WithAttributes  menu_ :: ('Menu ?> a) => a -> 'Menu > a-menu_ = Child+menu_ = WithAttributes ()  menu_A :: ('Menu ??> a, 'Menu ?> b) => a -> b -> ('Menu :@: a) b menu_A = WithAttributes  menuitem_ :: 'Menuitem > ()-menuitem_ = Child ()+menuitem_ = WithAttributes () ()  menuitem_A :: 'Menuitem ??> a => a -> ('Menuitem :@: a) () menuitem_A = flip WithAttributes ()  meta_ :: 'Meta > ()-meta_ = Child ()+meta_ = WithAttributes () ()  meta_A :: 'Meta ??> a => a -> ('Meta :@: a) () meta_A = flip WithAttributes ()  meter_ :: ('Meter ?> a) => a -> 'Meter > a-meter_ = Child+meter_ = WithAttributes ()  meter_A :: ('Meter ??> a, 'Meter ?> b) => a -> b -> ('Meter :@: a) b meter_A = WithAttributes  multicol_ :: ('Multicol ?> a) => a -> 'Multicol > a-multicol_ = Child+multicol_ = WithAttributes ()  multicol_A :: ('Multicol ??> a, 'Multicol ?> b) => a -> b -> ('Multicol :@: a) b multicol_A = WithAttributes  nav_ :: ('Nav ?> a) => a -> 'Nav > a-nav_ = Child+nav_ = WithAttributes ()  nav_A :: ('Nav ??> a, 'Nav ?> b) => a -> b -> ('Nav :@: a) b nav_A = WithAttributes  nextid_ :: ('Nextid ?> a) => a -> 'Nextid > a-nextid_ = Child+nextid_ = WithAttributes ()  nextid_A :: ('Nextid ??> a, 'Nextid ?> b) => a -> b -> ('Nextid :@: a) b nextid_A = WithAttributes  nobr_ :: ('Nobr ?> a) => a -> 'Nobr > a-nobr_ = Child+nobr_ = WithAttributes ()  nobr_A :: ('Nobr ??> a, 'Nobr ?> b) => a -> b -> ('Nobr :@: a) b nobr_A = WithAttributes  noembed_ :: ('Noembed ?> a) => a -> 'Noembed > a-noembed_ = Child+noembed_ = WithAttributes ()  noembed_A :: ('Noembed ??> a, 'Noembed ?> b) => a -> b -> ('Noembed :@: a) b noembed_A = WithAttributes  noframes_ :: ('Noframes ?> a) => a -> 'Noframes > a-noframes_ = Child+noframes_ = WithAttributes ()  noframes_A :: ('Noframes ??> a, 'Noframes ?> b) => a -> b -> ('Noframes :@: a) b noframes_A = WithAttributes  noscript_ :: ('Noscript ?> a) => a -> 'Noscript > a-noscript_ = Child+noscript_ = WithAttributes ()  noscript_A :: ('Noscript ??> a, 'Noscript ?> b) => a -> b -> ('Noscript :@: a) b noscript_A = WithAttributes  object_ :: ('Object ?> a) => a -> 'Object > a-object_ = Child+object_ = WithAttributes ()  object_A :: ('Object ??> a, 'Object ?> b) => a -> b -> ('Object :@: a) b object_A = WithAttributes  ol_ :: ('Ol ?> a) => a -> 'Ol > a-ol_ = Child+ol_ = WithAttributes ()  ol_A :: ('Ol ??> a, 'Ol ?> b) => a -> b -> ('Ol :@: a) b ol_A = WithAttributes  optgroup_ :: ('Optgroup ?> a) => a -> 'Optgroup > a-optgroup_ = Child+optgroup_ = WithAttributes ()  optgroup_A :: ('Optgroup ??> a, 'Optgroup ?> b) => a -> b -> ('Optgroup :@: a) b optgroup_A = WithAttributes  option_ :: ('Option ?> a) => a -> 'Option > a-option_ = Child+option_ = WithAttributes ()  option_A :: ('Option ??> a, 'Option ?> b) => a -> b -> ('Option :@: a) b option_A = WithAttributes  output_ :: ('Output ?> a) => a -> 'Output > a-output_ = Child+output_ = WithAttributes ()  output_A :: ('Output ??> a, 'Output ?> b) => a -> b -> ('Output :@: a) b output_A = WithAttributes  p_ :: ('P ?> a) => a -> 'P > a-p_ = Child+p_ = WithAttributes ()  p_A :: ('P ??> a, 'P ?> b) => a -> b -> ('P :@: a) b p_A = WithAttributes  param_ :: 'Param > ()-param_ = Child ()+param_ = WithAttributes () ()  param_A :: 'Param ??> a => a -> ('Param :@: a) () param_A = flip WithAttributes ()  picture_ :: ('Picture ?> a) => a -> 'Picture > a-picture_ = Child+picture_ = WithAttributes ()  picture_A :: ('Picture ??> a, 'Picture ?> b) => a -> b -> ('Picture :@: a) b picture_A = WithAttributes  plaintext_ :: ('Plaintext ?> a) => a -> 'Plaintext > a-plaintext_ = Child+plaintext_ = WithAttributes ()  plaintext_A :: ('Plaintext ??> a, 'Plaintext ?> b) => a -> b -> ('Plaintext :@: a) b plaintext_A = WithAttributes  pre_ :: ('Pre ?> a) => a -> 'Pre > a-pre_ = Child+pre_ = WithAttributes ()  pre_A :: ('Pre ??> a, 'Pre ?> b) => a -> b -> ('Pre :@: a) b pre_A = WithAttributes  progress_ :: ('Progress ?> a) => a -> 'Progress > a-progress_ = Child+progress_ = WithAttributes ()  progress_A :: ('Progress ??> a, 'Progress ?> b) => a -> b -> ('Progress :@: a) b progress_A = WithAttributes  q_ :: ('Q ?> a) => a -> 'Q > a-q_ = Child+q_ = WithAttributes ()  q_A :: ('Q ??> a, 'Q ?> b) => a -> b -> ('Q :@: a) b q_A = WithAttributes  rp_ :: ('Rp ?> a) => a -> 'Rp > a-rp_ = Child+rp_ = WithAttributes ()  rp_A :: ('Rp ??> a, 'Rp ?> b) => a -> b -> ('Rp :@: a) b rp_A = WithAttributes  rt_ :: ('Rt ?> a) => a -> 'Rt > a-rt_ = Child+rt_ = WithAttributes ()  rt_A :: ('Rt ??> a, 'Rt ?> b) => a -> b -> ('Rt :@: a) b rt_A = WithAttributes  rtc_ :: ('Rtc ?> a) => a -> 'Rtc > a-rtc_ = Child+rtc_ = WithAttributes ()  rtc_A :: ('Rtc ??> a, 'Rtc ?> b) => a -> b -> ('Rtc :@: a) b rtc_A = WithAttributes  ruby_ :: ('Ruby ?> a) => a -> 'Ruby > a-ruby_ = Child+ruby_ = WithAttributes ()  ruby_A :: ('Ruby ??> a, 'Ruby ?> b) => a -> b -> ('Ruby :@: a) b ruby_A = WithAttributes  s_ :: ('S ?> a) => a -> 'S > a-s_ = Child+s_ = WithAttributes ()  s_A :: ('S ??> a, 'S ?> b) => a -> b -> ('S :@: a) b s_A = WithAttributes  samp_ :: ('Samp ?> a) => a -> 'Samp > a-samp_ = Child+samp_ = WithAttributes ()  samp_A :: ('Samp ??> a, 'Samp ?> b) => a -> b -> ('Samp :@: a) b samp_A = WithAttributes  script_ :: ('Script ?> a) => a -> 'Script > a-script_ = Child+script_ = WithAttributes ()  script_A :: ('Script ??> a, 'Script ?> b) => a -> b -> ('Script :@: a) b script_A = WithAttributes  section_ :: ('Section ?> a) => a -> 'Section > a-section_ = Child+section_ = WithAttributes ()  section_A :: ('Section ??> a, 'Section ?> b) => a -> b -> ('Section :@: a) b section_A = WithAttributes  select_ :: ('Select ?> a) => a -> 'Select > a-select_ = Child+select_ = WithAttributes ()  select_A :: ('Select ??> a, 'Select ?> b) => a -> b -> ('Select :@: a) b select_A = WithAttributes  shadow_ :: ('Shadow ?> a) => a -> 'Shadow > a-shadow_ = Child+shadow_ = WithAttributes ()  shadow_A :: ('Shadow ??> a, 'Shadow ?> b) => a -> b -> ('Shadow :@: a) b shadow_A = WithAttributes  slot_ :: ('Slot ?> a) => a -> 'Slot > a-slot_ = Child+slot_ = WithAttributes ()  slot_A :: ('Slot ??> a, 'Slot ?> b) => a -> b -> ('Slot :@: a) b slot_A = WithAttributes  small_ :: ('Small ?> a) => a -> 'Small > a-small_ = Child+small_ = WithAttributes ()  small_A :: ('Small ??> a, 'Small ?> b) => a -> b -> ('Small :@: a) b small_A = WithAttributes  source_ :: 'Source > ()-source_ = Child ()+source_ = WithAttributes () ()  source_A :: 'Source ??> a => a -> ('Source :@: a) () source_A = flip WithAttributes ()  spacer_ :: ('Spacer ?> a) => a -> 'Spacer > a-spacer_ = Child+spacer_ = WithAttributes ()  spacer_A :: ('Spacer ??> a, 'Spacer ?> b) => a -> b -> ('Spacer :@: a) b spacer_A = WithAttributes  span_ :: ('Span ?> a) => a -> 'Span > a-span_ = Child+span_ = WithAttributes ()  span_A :: ('Span ??> a, 'Span ?> b) => a -> b -> ('Span :@: a) b span_A = WithAttributes  strike_ :: ('Strike ?> a) => a -> 'Strike > a-strike_ = Child+strike_ = WithAttributes ()  strike_A :: ('Strike ??> a, 'Strike ?> b) => a -> b -> ('Strike :@: a) b strike_A = WithAttributes  strong_ :: ('Strong ?> a) => a -> 'Strong > a-strong_ = Child+strong_ = WithAttributes ()  strong_A :: ('Strong ??> a, 'Strong ?> b) => a -> b -> ('Strong :@: a) b strong_A = WithAttributes  style_ :: ('Style ?> a) => a -> 'Style > a-style_ = Child+style_ = WithAttributes ()  style_A :: ('Style ??> a, 'Style ?> b) => a -> b -> ('Style :@: a) b style_A = WithAttributes  sub_ :: ('Sub ?> a) => a -> 'Sub > a-sub_ = Child+sub_ = WithAttributes ()  sub_A :: ('Sub ??> a, 'Sub ?> b) => a -> b -> ('Sub :@: a) b sub_A = WithAttributes  summary_ :: ('Summary ?> a) => a -> 'Summary > a-summary_ = Child+summary_ = WithAttributes ()  summary_A :: ('Summary ??> a, 'Summary ?> b) => a -> b -> ('Summary :@: a) b summary_A = WithAttributes  sup_ :: ('Sup ?> a) => a -> 'Sup > a-sup_ = Child+sup_ = WithAttributes ()  sup_A :: ('Sup ??> a, 'Sup ?> b) => a -> b -> ('Sup :@: a) b sup_A = WithAttributes  svg_ :: ('Svg ?> a) => a -> 'Svg > a-svg_ = Child+svg_ = WithAttributes ()  svg_A :: ('Svg ??> a, 'Svg ?> b) => a -> b -> ('Svg :@: a) b svg_A = WithAttributes  table_ :: ('Table ?> a) => a -> 'Table > a-table_ = Child+table_ = WithAttributes ()  table_A :: ('Table ??> a, 'Table ?> b) => a -> b -> ('Table :@: a) b table_A = WithAttributes  tbody_ :: ('Tbody ?> a) => a -> 'Tbody > a-tbody_ = Child+tbody_ = WithAttributes ()  tbody_A :: ('Tbody ??> a, 'Tbody ?> b) => a -> b -> ('Tbody :@: a) b tbody_A = WithAttributes  td_ :: ('Td ?> a) => a -> 'Td > a-td_ = Child+td_ = WithAttributes ()  td_A :: ('Td ??> a, 'Td ?> b) => a -> b -> ('Td :@: a) b td_A = WithAttributes  template_ :: ('Template ?> a) => a -> 'Template > a-template_ = Child+template_ = WithAttributes ()  template_A :: ('Template ??> a, 'Template ?> b) => a -> b -> ('Template :@: a) b template_A = WithAttributes  textarea_ :: ('Textarea ?> a) => a -> 'Textarea > a-textarea_ = Child+textarea_ = WithAttributes ()  textarea_A :: ('Textarea ??> a, 'Textarea ?> b) => a -> b -> ('Textarea :@: a) b textarea_A = WithAttributes  tfoot_ :: ('Tfoot ?> a) => a -> 'Tfoot > a-tfoot_ = Child+tfoot_ = WithAttributes ()  tfoot_A :: ('Tfoot ??> a, 'Tfoot ?> b) => a -> b -> ('Tfoot :@: a) b tfoot_A = WithAttributes  th_ :: ('Th ?> a) => a -> 'Th > a-th_ = Child+th_ = WithAttributes ()  th_A :: ('Th ??> a, 'Th ?> b) => a -> b -> ('Th :@: a) b th_A = WithAttributes  thead_ :: ('Thead ?> a) => a -> 'Thead > a-thead_ = Child+thead_ = WithAttributes ()  thead_A :: ('Thead ??> a, 'Thead ?> b) => a -> b -> ('Thead :@: a) b thead_A = WithAttributes  time_ :: ('Time ?> a) => a -> 'Time > a-time_ = Child+time_ = WithAttributes ()  time_A :: ('Time ??> a, 'Time ?> b) => a -> b -> ('Time :@: a) b time_A = WithAttributes  title_ :: ('Title ?> a) => a -> 'Title > a-title_ = Child+title_ = WithAttributes ()  title_A :: ('Title ??> a, 'Title ?> b) => a -> b -> ('Title :@: a) b title_A = WithAttributes  tr_ :: ('Tr ?> a) => a -> 'Tr > a-tr_ = Child+tr_ = WithAttributes ()  tr_A :: ('Tr ??> a, 'Tr ?> b) => a -> b -> ('Tr :@: a) b tr_A = WithAttributes  track_ :: 'Track > ()-track_ = Child ()+track_ = WithAttributes () ()  track_A :: 'Track ??> a => a -> ('Track :@: a) () track_A = flip WithAttributes ()  tt_ :: ('Tt ?> a) => a -> 'Tt > a-tt_ = Child+tt_ = WithAttributes ()  tt_A :: ('Tt ??> a, 'Tt ?> b) => a -> b -> ('Tt :@: a) b tt_A = WithAttributes  u_ :: ('U ?> a) => a -> 'U > a-u_ = Child+u_ = WithAttributes ()  u_A :: ('U ??> a, 'U ?> b) => a -> b -> ('U :@: a) b u_A = WithAttributes  ul_ :: ('Ul ?> a) => a -> 'Ul > a-ul_ = Child+ul_ = WithAttributes ()  ul_A :: ('Ul ??> a, 'Ul ?> b) => a -> b -> ('Ul :@: a) b ul_A = WithAttributes  var_ :: ('Var ?> a) => a -> 'Var > a-var_ = Child+var_ = WithAttributes ()  var_A :: ('Var ??> a, 'Var ?> b) => a -> b -> ('Var :@: a) b var_A = WithAttributes  video_ :: ('Video ?> a) => a -> 'Video > a-video_ = Child+video_ = WithAttributes ()  video_A :: ('Video ??> a, 'Video ?> b) => a -> b -> ('Video :@: a) b video_A = WithAttributes  wbr_ :: 'Wbr > ()-wbr_ = Child ()+wbr_ = WithAttributes () ()  wbr_A :: 'Wbr ??> a => a -> ('Wbr :@: a) () wbr_A = flip WithAttributes ()  xmp_ :: ('Xmp ?> a) => a -> 'Xmp > a-xmp_ = Child+xmp_ = WithAttributes ()  xmp_A :: ('Xmp ??> a, 'Xmp ?> b) => a -> b -> ('Xmp :@: a) b xmp_A = WithAttributes

@@ -12,6 +12,7 @@ module Html.Reify where  import Html.Type.Internal+import Html.Type.Internal.GHC import Html.Convert  import GHC.TypeLits@@ -55,16 +56,17 @@ class Renderchunks a where   renderchunks :: a -> B.Builder -instance KnownSymbol a => Renderchunks (Tagged (prox :: [Symbol]) (Proxy a)) where+instance KnownSymbol a => Renderchunks (Tagged (prox :: [k]) (Proxy a)) where   {-# INLINE renderchunks #-}   renderchunks _ = mempty-instance Renderchunks (Tagged (prox :: [Symbol]) ()) where++instance Renderchunks (Tagged prox ()) where   {-# INLINE renderchunks #-}   renderchunks _ = mempty  instance {-# INCOHERENT #-}   ( Convert val-  ) => Renderchunks (Tagged '[""] val) where+  ) => Renderchunks (Tagged '[ EmptySym ] val) where   {-# INLINE renderchunks #-}   renderchunks (Tagged x)     = unConv (convert x)@@ -76,7 +78,7 @@  instance {-# INCOHERENT #-}   ( Convert val-  , KnownSymbol s+  , Convert (Proxy s)   ) => Renderchunks (Tagged '[s] val) where   {-# INLINE renderchunks #-}   renderchunks (Tagged x)@@ -85,14 +87,14 @@  instance {-# INCOHERENT #-}   ( Renderchunks (Tagged xs val)-  ) => Renderchunks (Tagged ('FingerTree xs "") val) where+  ) => Renderchunks (Tagged (NoTail xs) val) where   {-# INLINE renderchunks #-}   renderchunks (Tagged t)     = renderchunks (Tagged t :: Tagged xs val)  instance {-# INCOHERENT #-}   ( Renderchunks (Tagged xs val)-  , KnownSymbol x+  , Convert (Proxy x)   ) => Renderchunks (Tagged ('FingerTree xs x) val) where   {-# INLINE renderchunks #-}   renderchunks (Tagged t)@@ -100,12 +102,6 @@     <> unConv (convert (Proxy @ x))  instance-  ( Renderchunks (Tagged prox b)-  ) => Renderchunks (Tagged prox (a > b)) where-  {-# INLINE renderchunks #-}-  renderchunks (Tagged ~(Child b)) = renderchunks (Tagged b :: Tagged prox b)--instance   ( Renderchunks (Tagged (Take (CountContent b) prox) b)   , Renderchunks (Tagged (Drop (CountContent b) prox) c)   ) => Renderchunks (Tagged prox ((a :@: b) c)) where@@ -125,7 +121,7 @@  instance   ( Renderchunks (Tagged (ToTypeList (a `f` b)) (a `f` b))-  , KnownSymbol s+  , Convert (Proxy s)   ) => Renderchunks (Tagged (s ': ss) [a `f` b]) where   {-# INLINE renderchunks #-}   renderchunks (Tagged xs)

@@ -1,7 +1,7 @@ {-# LANGUAGE ExplicitNamespaces #-}  module Html.Type-  ( type (>)(..)+  ( type (>)   , type (:@:)(..)   , type (#)(..)   , (#)

@@ -320,18 +320,17 @@ -- every child is lawful. 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) d) = a ?> (b > d)+  a ?> f ((b :@: c) d) = a ?> (b :@: c) d   a ?> f (b # c)       = a ?> (b # c)   a ?> ()              = ()   a ?> (b -> c)        = TypeError (Text "Html elements can't contain functions")   a ?> b               = CheckString a b  type family (a :: Element) ??> b :: Constraint where+  a ??> () = ()   a ??> (b # c)  = (a ??> b, a ??> c)   a ??> (b := _) = If (Elem a (GetAttributeInfo b) || Null (GetAttributeInfo b))                    (() :: Constraint)@@ -351,17 +350,8 @@ (#) = (:#:) infixr 5 # --- | Descend to a valid child of an element.--- It is recommended to use the predefined elements.------ >>> Child "a" :: 'Div > String--- <div>a</div>------ >>> div_ "a"--- <div>a</div>-data (>) (a :: Element) b where-  Child :: (a ?> b) => b -> a > b-infixr 8 >+-- | Type synonym for elements without attributes.+type (>) a b = (:@:) a () b  -- | Decorate an element with attributes and descend to a valid child. -- It is recommended to use the predefined elements.@@ -371,6 +361,9 @@ -- -- >>> div_A (A.class_ "bar") "a" -- <div class="bar">a</div>+--+-- >>> div_ "a"+-- <div>a</div> data (:@:) (a :: Element) b c where   WithAttributes :: (a ??> b, a ?> c) => b -> c -> (a :@: b) c infixr 8 :@:@@ -653,55 +646,25 @@   ShowAttribute WidthA           = " width=\""   ShowAttribute WrapA            = " wrap=\"" -type family OpenTag e where-  OpenTag e = AppendSymbol "<" (AppendSymbol (ShowElement e) ">")--type family CloseTag e where-  CloseTag e = AppendSymbol "</" (AppendSymbol (ShowElement e) ">")- type family CountContent c where   CountContent (a # b)       = CountContent a + CountContent b-  CountContent (_ > b)       = CountContent b   CountContent ((_ :@: b) c) = CountContent b + CountContent c   CountContent (_ := b)      = CountContent b   CountContent ()            = 0   CountContent (Proxy _)     = 0   CountContent _             = 1 --- | We need efficient cons, snoc and append.  This API has cons(O1)--- and snoc(O1) but append(On).  Optimal would be a real 2-3--- FingerTree.-data FingerTree = FingerTree [Symbol] Symbol--type family (<|) (s :: Symbol) (t :: FingerTree) :: FingerTree where-  (<|) l ('FingerTree (s ': ss) r) = 'FingerTree (AppendSymbol l s ': ss) r-  (<|) l ('FingerTree '[] r) = 'FingerTree '[] (AppendSymbol l r)--type family (|>) (t :: FingerTree) (s :: Symbol) :: FingerTree where-  (|>) ('FingerTree ss r) rr = 'FingerTree ss (AppendSymbol r rr)--type family (><) (t1 :: FingerTree) (t2 :: FingerTree) :: FingerTree where-  (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (AppendSymbol r s ': ss2)) r2-  (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (AppendSymbol r r2)---- | Flatten a document into a type list of tags.-type family ToTypeList a :: FingerTree where-  ToTypeList (a # b)        = ToTypeList a >< ToTypeList b-  ToTypeList (a > ())       = 'FingerTree '[] (If (HasContent (GetInfo a)) (AppendSymbol (OpenTag a) (CloseTag a)) (OpenTag a))-  ToTypeList ((a :@: b) ()) = AppendSymbol "<" (ShowElement a) <| ToTypeList b |> If (HasContent (GetInfo a)) (AppendSymbol ">" (CloseTag a)) ">"-  ToTypeList (a > b)        = OpenTag a <| ToTypeList b |> CloseTag a-  ToTypeList ((a :@: b) c)  = (AppendSymbol "<" (ShowElement a) <| ToTypeList b) >< (">" <| ToTypeList c |> CloseTag a)-  ToTypeList (a := b)       = ShowAttribute a <| ToTypeList b |> "\""-  ToTypeList ()             = 'FingerTree '[] ""-  ToTypeList (Proxy x)      = 'FingerTree '[] x-  ToTypeList x              = 'FingerTree '[""] ""+-- | Check whether an element may have content.+type family HasContent a where+  HasContent (ElementInfo _ NoContent) = False+  HasContent _                         = True  -- | Append two type lists. -- -- Note that this definition is that ugly to reduce compiletimes. -- Please check whether the context reduction stack or compiletimes of -- a big html page get bigger if you try to refactor.-type family Append xs ys :: [Symbol] where+type family Append xs ys :: [k] where    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@@ -727,17 +690,12 @@   Append '[] ys         = ys --- | Check whether an element may have content.-type family HasContent a where-  HasContent (ElementInfo _ NoContent) = False-  HasContent _                         = True- -- | Type level drop. -- -- Note that this definition is that ugly to reduce compiletimes. -- Please check whether the context reduction stack or compiletimes of -- a big html page get bigger if you try to refactor.-type family Drop n xs :: [Symbol] where+type family Drop n xs :: [k] where   Drop 0 xs = xs   Drop 1 (_ ': xs) = xs   Drop 2 (_ ': _ ': xs) = xs@@ -750,7 +708,7 @@ -- Note that this definition is that ugly to reduce compiletimes. -- Please check whether the context reduction stack or compiletimes of -- a big html page get bigger if you try to refactor.-type family Take n xs :: [Symbol] where+type family Take n xs :: [k] where   Take 0 _ = '[]   Take 1 (x1 ': _) = '[x1]   Take 2 (x1 ': x2 ': _) = '[x1, x2]

@@ -0,0 +1,79 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE PolyKinds            #-}+{-# LANGUAGE CPP                  #-}++module Html.Type.Internal.GHC where++import Html.Type.Internal++import Data.Proxy+import Data.Type.Bool+import GHC.TypeLits++-- | We need efficient cons, snoc and append.  This API has cons(O1)+-- and snoc(O1) but append(On).  Optimal would be a real 2-3+-- FingerTree.+data FingerTree = FingerTree [Sym] Sym+type Empty = 'FingerTree '[] EmptySym+type Split = 'FingerTree '[EmptySym] EmptySym+type NoTail xs = 'FingerTree xs EmptySym+type Singleton = 'FingerTree '[]++type family (<|) s t :: FingerTree where+  (<|) l ('FingerTree (s ': ss) r) = 'FingerTree (AppendSymbol l s ': ss) r+  (<|) l ('FingerTree '[] r) = 'FingerTree '[] (AppendSymbol l r)++type family (|>) t s :: FingerTree where+  (|>) ('FingerTree ss r) rr = 'FingerTree ss (AppendSymbol r rr)++type family (><) t1 t2 :: FingerTree where+  (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (AppendSymbol r s ': ss2)) r2+  (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (AppendSymbol r r2)++#if __GLASGOW_HASKELL__ >= 802+type family OpenTag e where+  OpenTag e = AppendSymbol "<" (AppendSymbol (ShowElement e) ">")++type family CloseTag e where+  CloseTag e = AppendSymbol "</" (AppendSymbol (ShowElement e) ">")++-- | Flatten a document into a type list of tags.+type family ToTypeList a :: FingerTree where+  ToTypeList (a # b)         = ToTypeList a >< ToTypeList b+  ToTypeList ((a :@: ()) ()) = Singleton (If (HasContent (GetInfo a)) (AppendSymbol (OpenTag a) (CloseTag a)) (OpenTag a))+  ToTypeList ((a :@: b) ())  = AppendSymbol "<" (ShowElement a) <| ToTypeList b |> If (HasContent (GetInfo a)) (AppendSymbol ">" (CloseTag a)) ">"+  ToTypeList ((a :@: ()) b)  = OpenTag a <| ToTypeList b |> CloseTag a+  ToTypeList ((a :@: b) c)   = (AppendSymbol "<" (ShowElement a) <| ToTypeList b) >< (">" <| ToTypeList c |> CloseTag a)+  ToTypeList (a := b)        = ShowAttribute a <| ToTypeList b |> "\""+  ToTypeList ()              = Empty+  ToTypeList (Proxy x)       = Singleton x+  ToTypeList x               = Split++type Sym = Symbol+type EmptySym = ""+#else+type family OpenTag e where+  OpenTag e = ["<", ShowElement e, ">"]++type family CloseTag e where+  CloseTag e = ["</", ShowElement e, ">"]++-- | Flatten a document into a type list of tags.+type family ToTypeList a :: FingerTree where+  ToTypeList (a # b)         = ToTypeList a >< ToTypeList b+  ToTypeList ((a :@: ()) ()) = Singleton (If (HasContent (GetInfo a)) (Append (OpenTag a) (CloseTag a)) (OpenTag a))+  ToTypeList ((a :@: b) ())  = '["<", ShowElement a] <| ToTypeList b |> If (HasContent (GetInfo a)) (">" ': CloseTag a) '[">"]+  ToTypeList ((a :@: ()) b)  = OpenTag a <| ToTypeList b |> CloseTag a+  ToTypeList ((a :@: b) c)   = ('["<", ShowElement a] <| ToTypeList b) >< ('[">"] <| ToTypeList c |> CloseTag a)+  ToTypeList (a := b)        = '[ShowAttribute a] <| ToTypeList b |> '["\""]+  ToTypeList ()              = Empty+  ToTypeList (Proxy x)       = Singleton '[x]+  ToTypeList x               = Split++type AppendSymbol xs ys = Append xs ys+type Sym = [Symbol]+type EmptySym = '[]+#endif

@@ -1,5 +1,5 @@ name:                 type-of-html-version:              1.0.1.1+version:              1.1.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@@ -8,6 +8,7 @@ maintainer:           fknupfer@gmail.com homepage:             https://github.com/knupfer/type-of-html tested-with:          GHC == 8.2.1+                    , GHC == 8.0.2 copyright:            2017, Florian Knupfer category:             Language build-type:           Simple@@ -25,11 +26,12 @@                     , Html.Element                     , Html.Attribute   other-modules:      Html.Type.Internal+                    , Html.Type.Internal.GHC                     , Html.Reify   hs-source-dirs:     src   default-language:   Haskell2010   ghc-options:        -Wall-  build-depends:      base >= 4.10 && < 4.11+  build-depends:      base >= 4.9 && < 4.11                     , text                     , bytestring                     , ghc-prim@@ -41,7 +43,7 @@   hs-source-dirs:     test   ghc-options:        -Wall -O0   default-language:   Haskell2010-  build-depends:      base >= 4.10 && < 4.11+  build-depends:      base >= 4.9 && < 4.11                     , type-of-html                     , QuickCheck                     , hspec@@ -56,7 +58,7 @@   hs-source-dirs:     bench   ghc-options:        -Wall -O2   default-language:   Haskell2010-  build-depends:      base >= 4.10 && < 4.11+  build-depends:      base >= 4.9 && < 4.11                     , type-of-html                     , text                     , bytestring