diff --git a/ChangeLog.md b/ChangeLog.md
--- a/ChangeLog.md
+++ b/ChangeLog.md
@@ -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
diff --git a/Readme.md b/Readme.md
--- a/Readme.md
+++ b/Readme.md
@@ -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 @@
-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
+ab
+```
+
+```html
+
+ a
+
+
+ b
+
+```
+
+This would add a space when rendering. So perhaps we'll avoid all
+these text modifying tags, but now look at ``. Every whitespace
+and newline within is semantically important. And even if we avoid
+modifying stuff within ``, 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
+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.
diff --git a/src/Html.hs b/src/Html.hs
--- a/src/Html.hs
+++ b/src/Html.hs
@@ -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
diff --git a/src/Html/Attribute.hs b/src/Html/Attribute.hs
--- a/src/Html/Attribute.hs
+++ b/src/Html/Attribute.hs
@@ -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
diff --git a/src/Html/Convert.hs b/src/Html/Convert.hs
--- a/src/Html/Convert.hs
+++ b/src/Html/Convert.hs
@@ -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
diff --git a/src/Html/Element.hs b/src/Html/Element.hs
--- a/src/Html/Element.hs
+++ b/src/Html/Element.hs
@@ -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
diff --git a/src/Html/Reify.hs b/src/Html/Reify.hs
--- a/src/Html/Reify.hs
+++ b/src/Html/Reify.hs
@@ -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)
diff --git a/src/Html/Type.hs b/src/Html/Type.hs
--- a/src/Html/Type.hs
+++ b/src/Html/Type.hs
@@ -1,7 +1,7 @@
{-# LANGUAGE ExplicitNamespaces #-}
module Html.Type
- ( type (>)(..)
+ ( type (>)
, type (:@:)(..)
, type (#)(..)
, (#)
diff --git a/src/Html/Type/Internal.hs b/src/Html/Type/Internal.hs
--- a/src/Html/Type/Internal.hs
+++ b/src/Html/Type/Internal.hs
@@ -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
---
a
---
--- >>> div_ "a"
---
a
-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"
--
a
+--
+-- >>> div_ "a"
+--
a
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 "")
-
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]
diff --git a/src/Html/Type/Internal/GHC.hs b/src/Html/Type/Internal/GHC.hs
new file mode 100644
--- /dev/null
+++ b/src/Html/Type/Internal/GHC.hs
@@ -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 "")
+
+-- | 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 = [""]
+
+-- | 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
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: 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