diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,13 @@ # Revision history for type-of-html +## 0.3.0.0 -- 2017-09-05 + +* Overhaul of api +** Monomorphic render functions +** Remove inefficient builders +** Predifined attributes +** Single polymorphic implementation for all renderers + ## 0.2.1.0 -- 2017-08-04 * Escape strings diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,71 +1,68 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DataKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} module Main where import Html +import qualified Html.Attribute as A import Data.String import Control.Monad +import Criterion.Main -import Data.Text.Lazy.Builder (Builder, toLazyText) import Text.Blaze.Html5 ((!)) - -import Data.ByteString.Lazy (ByteString) - -import qualified Data.Text as S -import qualified Data.Text.Lazy as L -import qualified Text.Blaze.Html5 as B -import qualified Text.Blaze.Html5.Attributes as B (class_, id) -import qualified Text.Blaze.Html.Renderer.Text as RT -import qualified Text.Blaze.Html.Renderer.Utf8 as RB +import Text.Blaze.Html.Renderer.Utf8 -import Criterion.Main +import qualified Text.Blaze.Html5 as B +import qualified Text.Blaze.Html5.Attributes as BA main :: IO () main = defaultMain [ bgroup "minimal" - [ bench "blaze.text" $ nf (RT.renderHtml . blazeMinimal :: B.Html -> L.Text) "TEST" - , bench "blaze.utf8" $ nf (RB.renderHtml . blazeMinimal :: B.Html -> ByteString) "TEST" - , bench "string" $ nf (render . minimal :: String -> String) "TEST" - , bench "strict text" $ nf (render . minimal :: S.Text -> S.Text) "TEST" - , bench "lazy text" $ nf (render . minimal :: L.Text -> L.Text) "TEST" - , bench "builder" $ nf (toLazyText . render . minimal :: Builder -> L.Text) "TEST" + [ bench "blaze.utf8" $ nf (renderHtml . blazeMinimal) (fromString "TEST") + , bench "string" $ nf (renderString . minimal) "TEST" + , bench "bytestring" $ nf (renderByteString . minimal) "TEST" + , bench "text" $ nf (renderText . minimal) "TEST" ] , bgroup "hello world" - [ bench "blaze.text" $ nf (RT.renderHtml . blazeHelloWorld :: B.Html -> L.Text) "TEST" - , bench "blaze.utf8" $ nf (RB.renderHtml . blazeHelloWorld :: B.Html -> ByteString) "TEST" - , bench "string" $ nf (render . helloWorld :: String -> String) "TEST" - , bench "strict text" $ nf (render . helloWorld :: S.Text -> S.Text) "TEST" - , bench "lazy text" $ nf (render . helloWorld :: L.Text -> L.Text) "TEST" - , bench "builder" $ nf (toLazyText . render . helloWorld :: Builder -> L.Text) "TEST" + [ bench "blaze.utf8" $ nf (renderHtml . blazeHelloWorld) (fromString "TEST") + , bench "string" $ nf (renderString . helloWorld) "TEST" + , bench "bytestring" $ nf (renderByteString . helloWorld) "TEST" + , bench "text" $ nf (renderText . helloWorld) "TEST" ] + , bgroup "attributes short" + [ bench "blaze.utf8" $ nf (renderHtml . blazeAttrShort) (fromString "TEST") + , bench "string" $ nf (renderString . attrShort) "TEST" + , bench "bytestring" $ nf (renderByteString . attrShort) "TEST" + , bench "text" $ nf (renderText . attrShort) "TEST" + ] + , bgroup "attributes long" + [ bench "blaze.utf8" $ nf (renderHtml . blazeAttrLong) (fromString "TEST") + , bench "string" $ nf (renderString . attrLong) "TEST" + , bench "bytestring" $ nf (renderByteString . attrLong) "TEST" + , bench "text" $ nf (renderText . attrLong) "TEST" + ] , bgroup "big page" - [ bench "blaze.text" $ nf (RT.renderHtml . blazeBigPage :: B.Html -> L.Text) "TEST" - , bench "blaze.utf8" $ nf (RB.renderHtml . blazeBigPage :: B.Html -> ByteString) "TEST" - , bench "string" $ nf (render . bigPage :: String -> String) "TEST" - , bench "strict text" $ nf (render . bigPage :: S.Text -> S.Text) "TEST" - , bench "lazy text" $ nf (render . bigPage :: L.Text -> L.Text) "TEST" - , bench "builder" $ nf (toLazyText . render . bigPage :: Builder -> L.Text) "TEST" + [ bench "blaze.utf8" $ nf (renderHtml . blazeBigPage) (fromString "TEST") + , bench "string" $ nf (renderString . bigPage) "TEST" + , bench "bytestring" $ nf (renderByteString . bigPage) "TEST" + , bench "text" $ nf (renderText . bigPage) "TEST" ] , bgroup "big page with attributes" - [ bench "blaze.text" $ nf (RT.renderHtml . blazeBigPageA :: B.Html -> L.Text) "TEST" - , bench "blaze.utf8" $ nf (RB.renderHtml . blazeBigPageA :: B.Html -> ByteString) "TEST" - , bench "string" $ nf (render . bigPageA :: String -> String) "TEST" - , bench "strict text" $ nf (render . bigPageA :: S.Text -> S.Text) "TEST" - , bench "lazy text" $ nf (render . bigPageA :: L.Text -> L.Text) "TEST" - , bench "builder" $ nf (toLazyText . render . bigPageA :: Builder -> L.Text) "TEST" + [ bench "blaze.utf8" $ nf (renderHtml . blazeBigPageA) (fromString "TEST") + , bench "string" $ nf (renderString . bigPageA) "TEST" + , bench "bytestring" $ nf (renderByteString . bigPageA) "TEST" + , bench "text" $ nf (renderText . bigPageA) "TEST" ] , bgroup "big table" - [ bench "blaze.text" $ nf (RT.renderHtml . blazeBigTable :: (Int, Int) -> L.Text) (4,4) - , bench "blaze.utf8" $ nf (RB.renderHtml . blazeBigTable :: (Int, Int) -> ByteString) (4,4) - , bench "string" $ nf (render . bigTable :: (Int, Int) -> String) (4,4) - , bench "strict text" $ nf (render . bigTable :: (Int, Int) -> S.Text) (4,4) - , bench "lazy text" $ nf (render . bigTable :: (Int, Int) -> L.Text) (4,4) - , bench "builder" $ nf (toLazyText . render . bigTable :: (Int, Int) -> L.Text) (4,4) + [ bench "blaze.utf8" $ nf (renderHtml . blazeBigTable) (4,4) + , bench "string" $ nf (renderString . bigTable) (4,4) + , bench "bytestring" $ nf (renderByteString . bigTable) (4,4) + , bench "text" $ nf (renderText . bigTable) (4,4) ] ] @@ -80,7 +77,7 @@ B.head $ do B.title x B.body $ do - B.p "Hello World!" + B.p $ fromString "Hello World!" blazeBigPage :: B.Html -> B.Html blazeBigPage x = @@ -88,43 +85,63 @@ B.body $ do B.h1 $ do B.img - B.strong "0" + B.strong $ fromString "0" B.div $ do - B.div "1" + B.div $ fromString "1" B.div $ do B.form $ do B.fieldset $ do B.div $ do B.div $ do - B.label "a" + B.label $ fromString "a" B.select $ do - B.option "b" - B.option "c" - B.div "d" + B.option $ fromString "b" + B.option $ fromString "c" + B.div $ fromString "d" B.i x - B.button $ B.i "e" + B.button . B.i $ fromString "e" +blazeAttrShort :: B.Html -> B.Html +blazeAttrShort x + = B.i ! BA.accept (fromString "a") + $ B.i ! BA.acceptCharset (fromString "b") + $ B.i ! BA.accesskey (fromString "c") + $ B.i ! BA.action (fromString "d") + $ B.i ! BA.alt (fromString "f") + $ B.i ! BA.async (fromString "g") + $ x + +blazeAttrLong :: B.Html -> B.Html +blazeAttrLong x + = B.i ! BA.accept (fromString "a") + ! BA.acceptCharset (fromString "b") + ! BA.accesskey (fromString "c") + ! BA.action (fromString "d") + ! BA.alt (fromString "f") + ! BA.async (fromString "g") + $ x + blazeBigPageA :: B.Html -> B.Html blazeBigPageA x = B.html $ do B.body $ do - B.h1 ! B.id "a" $ do + B.h1 ! BA.id (fromString "a") $ do B.img - B.strong ! B.class_ "b" $ "0" + B.strong ! BA.class_ (fromString "b") $ fromString "0" B.div $ do - B.div ! B.id "c" $ "1" + B.div ! BA.id (fromString "c") $ fromString "1" B.div $ do - B.form ! B.class_ "d" $ do + B.form ! BA.class_ (fromString "d") $ do B.fieldset $ do - B.div ! B.id "e" $ do + B.div ! BA.id (fromString "e") $ do B.div $ do - B.label ! B.class_ "f" $ "a" + B.label ! BA.class_ (fromString "f") $ fromString "a" B.select $ do - B.option ! B.id "g" $ "b" - B.option "c" - B.div ! B.class_ "h" $ "d" + B.option ! BA.id (fromString "g") $ fromString "b" + B.option (fromString "c") + B.div ! BA.class_ (fromString "h") $ fromString "d" B.i x - B.button ! B.id "i" $ B.i "e" + B.button ! BA.id (fromString "i") $ B.i $ fromString "e" blazeBigTable :: (Int, Int) -> B.Html blazeBigTable (n, m) @@ -135,141 +152,95 @@ -- Type of Html based functions -minimal :: ('Div ?> a) => a -> 'Div > a minimal = div_ -helloWorld - :: (IsString a, 'Title ?> a) - => a - -> - 'Html > ( 'Head > 'Title > a - # 'Body > 'P > String - ) helloWorld x = html_ ( head_ ( title_ x ) # body_ - ( p_ ("Hello World!" :: String) + ( p_ "Hello World!" ) ) -bigPage - :: ('I ?> a) - => a - -> - 'Html > - ( 'Body > - ( 'H1 > - ( 'Img > () - # 'Strong > String - ) - # 'Div > 'Div > String - # 'Div > 'Form > 'Fieldset > - ( 'Div > - ( 'Div > - ( 'Label > String - # 'Select > - ( 'Option > String - # 'Option > String - ) - # 'Div > String - ) - # 'I > a - ) - # 'Button > 'I > String - ) - ) - ) bigPage x = html_ ( body_ ( h1_ ( img_ - # strong_ ("0" :: String) + # strong_ (0 :: Int) ) # div_ - ( div_ ("1" :: String) + ( div_ (1 :: Int) ) # div_ ( form_ ( fieldset_ ( div_ ( div_ - ( label_ ("a" :: String) + ( label_ "a" # select_ - ( option_ ("b" :: String) - # option_ ("c" :: String) + ( option_ "b" + # option_ "c" ) - # div_ ("d" :: String) + # div_ "d" ) # i_ x ) - # button_ (i_ ("e" :: String)) + # button_ (i_ "e") ) ) ) ) ) -bigPageA - :: ('I ?> a) - => a - -> - 'Html > - ( 'Body > - ( 'H1 :> - ( 'Img > () - # 'Strong :> String - ) - # 'Div > 'Div :> String - # 'Div > 'Form :> 'Fieldset > - ( 'Div :> - ( 'Div > - ( 'Label :> String - # 'Select > - ( 'Option :> String - # 'Option > String - ) - # 'Div :> String - ) - # 'I > a - ) - # 'Button :> 'I > String - ) - ) - ) +attrLong x = + i_A [ A.accept_ "a" + , A.acceptcharset_ "b" + , A.accesskey_ "c" + , A.action_ "d" + , A.alt_ "f" + , A.async_ "g"] x + +attrShort x + = i_A [A.accept_ "a"] + . i_A [A.acceptcharset_ "b"] + . i_A [A.accesskey_ "c"] + . i_A [A.action_ "d"] + . i_A [A.alt_ "f"] + $ i_A [A.async_ "g"] x + + bigPageA x = html_ ( body_ - ( h1_A [("id","a")] + ( h1_A [A.id_ "a"] ( img_ - # strong_A [("class","b")] ("0" :: String) + # strong_A [A.class_ "b"] (0 :: Int) ) # div_ - ( div_A [("id","c")] ("1" :: String) + ( div_A [A.id_ "c"] (1 :: Int) ) # div_ - ( form_A [("class","d")] + ( form_A [A.class_ "d"] ( fieldset_ - ( div_A [("id","e")] + ( div_A [A.id_ "e"] ( div_ - ( label_A [("class","f")] ("a" :: String) + ( label_A [A.class_ "f"] "a" # select_ - ( option_A [("id","g")] ("b" :: String) - # option_ ("c" :: String) + ( option_A [A.id_ "g"] "b" + # option_ "c" ) - # div_A [("class","h")] ("d" :: String) + # div_A [A.class_ "h"] "d" ) # i_ x ) - # button_A [("id","i")] (i_ ("e" :: String)) + # button_A [A.id_ "i"] (i_ "e") ) ) ) ) ) -bigTable :: (Int, Int) -> 'Table > ['Tr > ['Td > Int]] -bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [1..m] +bigTable (n, m) = table_ . replicate n . tr_ $ map td_ [(1::Int)..m] diff --git a/src/Html.hs b/src/Html.hs --- a/src/Html.hs +++ b/src/Html.hs @@ -1,7 +1,15 @@ -{-# LANGUAGE ExplicitNamespaces #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -{-| With type-of-html are three main goals: +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ExplicitNamespaces #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE MonoLocalBinds #-} +{-# LANGUAGE TypeOperators #-} +{-| type-of-html has three main goals: + * Type safety * Modularity @@ -10,19 +18,22 @@ Let's check out the /type safety/ in ghci: -> Html> td_ (tr_ "a") -> -> :1:1: error: -> • 'Tr is not a valid child of 'Td -> • In the expression: td_ (tr_ "a") -> In an equation for ‘it’: it = td_ (tr_ "a") -> -> :1:6: error: -> • 'Tr can't contain a string -> • In the first argument of ‘td_’, namely ‘(tr_ "a")’ -> In the expression: td_ (tr_ "a") -> In an equation for ‘it’: it = td_ (tr_ "a") +>>> td_ (tr_ "a") + +:1:1: error: + • 'Tr is not a valid child of 'Td + • In the expression: td_ (tr_ "a") + In an equation for ‘it’: it = td_ (tr_ "a") + +:1:6: error: + • 'Tr can't contain a string + • In the first argument of ‘td_’, namely ‘(tr_ "a")’ + In the expression: td_ (tr_ "a") + In an equation for ‘it’: it = td_ (tr_ "a") +>>> tr_ (td_ "a") +a + For every child, it is checked if it could possibly be lawful. The checking is a bit lenient at the moment: @@ -31,20 +42,20 @@ * some elements change their permitted content based on attributes: we don't know at compile time the attributes, therefore we always allow content as if all relevant attributes are set. * some elements can't be brethren: we look only at parent child relations, therefore if you don't specify the parent, it'll compile -Never the less: these cases are seldom. In the vast majority of the time you're only allowed to construct valid html. +Never the less: these cases are seldom. In the vast majority of cases you're only allowed to construct valid html. Let's talk about /modularity/: Rosetrees of html are just ordinary haskell values which can be composed or abstracted over: -> Html> let table = table_ . map (tr_ . map td_) -> Html> :t table -> table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]] -> Html> table [["A","B"],["C"]] ->
AB
C
-> Html> import Data.Char -> Html Data.Char> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d'] ->
a97
b98
c99
d100
+>>> let table = table_ . map (tr_ . map td_) +>>> :t table +table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]] +>>> table [["A","B"],["C"]] +
AB
C
+>>> import Data.Char +>>> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d'] +
a97
b98
c99
d100
And here's an example module @@ -56,14 +67,11 @@ import Html -import Data.Text.Lazy.IO as T -import Data.Text.Lazy.Builder as T +import qualified Html.Attribute as A main :: IO () main - = T.putStrLn - . T.toLazyText - . render + = print . page $ map td_ [1..(10::Int)] @@ -71,12 +79,12 @@ :: 'Tr ?> a => a -> 'Div - > ( 'Div > [Char] + :> ( 'Div > [Char] # 'Div > [Char] # 'Table > 'Tr > a ) page tds = - div_ + div_A [A.class_ "qux", A.id_ "baz"] ( div_ "foo" # div_ "bar" # table_ (tr_ tds) @@ -87,12 +95,28 @@ whatever you use to write it for you. If you choose not to write the types, you don't need the language extensions. +All text will be automatically html escaped: + +>>> i_ "&" +& + +>>> div_A [A.id_ ">"] () +
+ +If you want to opt out, wrap your types into the 'Raw' +constructor. This will increase performance, but can be only used with +trusted input. You can use this e.g. to embed some blaze-html code +into type-of-html. + +>>> i_ (Raw "") + + Last and fast: /performance/! Don't look any further, there is no option for faster html -generation. type-of-html up to 10 times faster than blaze-html, which -is until now the fastest generation library and the foundation block -of lucid and shakespeare. +generation. type-of-html is up to 10 times faster than blaze-html, +which was until now the fastest generation library and the foundation +block of lucid and shakespeare. Wait! 10 times faster? How is this possible? We supercompile lots of parts of the generation process. This is possible thanks to the new @@ -106,98 +130,61 @@ For example, if you write: -> render $ div_ "a" +> renderText $ tr_ (td_ "test") -The compiler does actually optimize it to the following: +The compiler does optimize it to the following (we don't know at +compile time if we need to escape the string): -> mconcat [ fromString $ symbolVal (Proxy :: Proxy "
") -> , fromString "a" -> , fromString $ symbolVal (Proxy :: Proxy "
") +> mconcat [ Data.Text.Lazy.unpackCString# ""# +> , escape (Data.Text.Lazy.unpackCString# "test"#) +> , Data.Text.Lazy.unpackCString# ""#) > ] If you write -> render $ div_ (div_ ()) - -The compiler does actually optimize it to the following: - -> mconcat [ fromString $ symbolVal (Proxy :: Proxy "
") ] - -If you write - -> render $ tr_ (td_ "test") - -The compiler does actually optimize it to the following: - -> mconcat [ fromString $ symbolVal (Proxy :: Proxy "") -> , fromString "test" -> , fromString $ symbolVal (Proxy :: Proxy "") -> ] - -Let's look at core: - -We take an extremely simple library - -> module Minimal where -> -> import Html -> -> minimal :: String -> minimal = render -> ( div_ "a" -> # div_ "b" -> # table_ (tr_ (td_ "c")) -> ) - -compile it with - -> ghc -O2 Minimal.hs -ddump-to-file -ddump-simpl -dsuppress-idinfo -dsuppress-module-prefixes -dsuppress-type-applications -dsuppress-uniques +> renderText $ div_ (div_ ()) -and clean up a bit: +The compiler does optimize it to the following: -> minimal1 :: Addr# -> minimal1 = "
a
b
c
"# -> -> minimal :: String -> minimal = unpackCString# minimal1 +> mconcat [ Data.Text.Lazy.unpackCString# "
"# ] -Well, that's a perfect optimization! Not only was *all* overhead -removed, optional ending tags were chopped off (tr, td). This sort of -compiletime optimization isn't for free. Running ghc with -v says -that desugaring resulted in 675 types and 5507 coercions: Compile -times will increase, some medium size html documents will take 10 secs -to compile. +Note that optional ending tags were chopped off (tr, td). This sort of +compiletime optimization isn't for free, it'll increase compilation times. -} module Html - ( render + ( renderString + , renderText + , renderByteString , type (>)(..) , type (:>)(..) , addAttributes , type (#)(..) , (#) , type (?>) + , Raw(..) , Convert(..) - , Escape(..) + , Converted + , Attribute , Element(..) , module Html.Element ) where +import Html.Reify + +import Html.Convert + import Html.Element import Html.Type - ( type (>)(..) - , type (:>)(..) - , type (?>) - , type (#)(..) - , (#) - , Element(..) - ) -import Html.Function - ( render - , addAttributes - , Convert(..) - , Escape(..) - ) +import Html.Attribute (addAttributes) + +-- | Orphan show instances to faciliate ghci development. +instance Document (a > b) String => Show (a > b) where show = renderString +instance {-# OVERLAPPING #-} Document (a > b) String => Show [a > b] where show = renderString +instance Document (a:> b) String => Show (a:> b) where show = renderString +instance {-# OVERLAPPING #-} Document (a:> b) String => Show [a:> b] where show = renderString +instance Document (a # b) String => Show (a # b) where show = renderString +instance {-# OVERLAPPING #-} Document (a # b) String => Show [a # b] where show = renderString diff --git a/src/Html/Attribute.hs b/src/Html/Attribute.hs new file mode 100644 --- /dev/null +++ b/src/Html/Attribute.hs @@ -0,0 +1,476 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeOperators #-} + +module Html.Attribute where + +import Html.Convert +import Html.Type +import Data.Semigroup + +{-# INLINE addAttributes #-} +addAttributes :: (a ?> b) => [Attribute] -> (a > b) -> (a :> b) +addAttributes xs (Child b) = WithAttributes xs b + +{-# INLINE accept_ #-} +accept_ :: Convert a => a -> Attribute +accept_ x = Attribute $ " accept=\"" <> unConv (conv x) <> "\"" + +{-# INLINE acceptcharset_ #-} +acceptcharset_ :: Convert a => a -> Attribute +acceptcharset_ x = Attribute $ " acceptcharset=\"" <> unConv (conv x) <> "\"" + +{-# INLINE accesskey_ #-} +accesskey_ :: Convert a => a -> Attribute +accesskey_ x = Attribute $ " accesskey=\"" <> unConv (conv x) <> "\"" + +{-# INLINE action_ #-} +action_ :: Convert a => a -> Attribute +action_ x = Attribute $ " action=\"" <> unConv (conv x) <> "\"" + +{-# INLINE align_ #-} +align_ :: Convert a => a -> Attribute +align_ x = Attribute $ " align=\"" <> unConv (conv x) <> "\"" + +{-# INLINE alt_ #-} +alt_ :: Convert a => a -> Attribute +alt_ x = Attribute $ " alt=\"" <> unConv (conv x) <> "\"" + +{-# INLINE async_ #-} +async_ :: Convert a => a -> Attribute +async_ x = Attribute $ " async=\"" <> unConv (conv x) <> "\"" + +{-# INLINE autocomplete_ #-} +autocomplete_ :: Convert a => a -> Attribute +autocomplete_ x = Attribute $ " autocomplete=\"" <> unConv (conv x) <> "\"" + +{-# INLINE autofocus_ #-} +autofocus_ :: Convert a => a -> Attribute +autofocus_ x = Attribute $ " autofocus=\"" <> unConv (conv x) <> "\"" + +{-# INLINE autoplay_ #-} +autoplay_ :: Convert a => a -> Attribute +autoplay_ x = Attribute $ " autoplay=\"" <> unConv (conv x) <> "\"" + +{-# INLINE autosave_ #-} +autosave_ :: Convert a => a -> Attribute +autosave_ x = Attribute $ " autosave=\"" <> unConv (conv x) <> "\"" + +{-# INLINE bgcolor_ #-} +bgcolor_ :: Convert a => a -> Attribute +bgcolor_ x = Attribute $ " bgcolor=\"" <> unConv (conv x) <> "\"" + +{-# INLINE border_ #-} +border_ :: Convert a => a -> Attribute +border_ x = Attribute $ " border=\"" <> unConv (conv x) <> "\"" + +{-# INLINE buffered_ #-} +buffered_ :: Convert a => a -> Attribute +buffered_ x = Attribute $ " buffered=\"" <> unConv (conv x) <> "\"" + +{-# INLINE challenge_ #-} +challenge_ :: Convert a => a -> Attribute +challenge_ x = Attribute $ " challenge=\"" <> unConv (conv x) <> "\"" + +{-# INLINE charset_ #-} +charset_ :: Convert a => a -> Attribute +charset_ x = Attribute $ " charset=\"" <> unConv (conv x) <> "\"" + +{-# INLINE checked_ #-} +checked_ :: Convert a => a -> Attribute +checked_ x = Attribute $ " checked=\"" <> unConv (conv x) <> "\"" + +{-# INLINE cite_ #-} +cite_ :: Convert a => a -> Attribute +cite_ x = Attribute $ " cite=\"" <> unConv (conv x) <> "\"" + +{-# INLINE class_ #-} +class_ :: Convert a => a -> Attribute +class_ x = Attribute $ " class=\"" <> unConv (conv x) <> "\"" + +{-# INLINE code_ #-} +code_ :: Convert a => a -> Attribute +code_ x = Attribute $ " code=\"" <> unConv (conv x) <> "\"" + +{-# INLINE codebase_ #-} +codebase_ :: Convert a => a -> Attribute +codebase_ x = Attribute $ " codebase=\"" <> unConv (conv x) <> "\"" + +{-# INLINE color_ #-} +color_ :: Convert a => a -> Attribute +color_ x = Attribute $ " color=\"" <> unConv (conv x) <> "\"" + +{-# INLINE cols_ #-} +cols_ :: Convert a => a -> Attribute +cols_ x = Attribute $ " cols=\"" <> unConv (conv x) <> "\"" + +{-# INLINE colspan_ #-} +colspan_ :: Convert a => a -> Attribute +colspan_ x = Attribute $ " colspan=\"" <> unConv (conv x) <> "\"" + +{-# INLINE content_ #-} +content_ :: Convert a => a -> Attribute +content_ x = Attribute $ " content=\"" <> unConv (conv x) <> "\"" + +{-# INLINE contenteditable_ #-} +contenteditable_ :: Convert a => a -> Attribute +contenteditable_ x = Attribute $ " contenteditable=\"" <> unConv (conv x) <> "\"" + +{-# INLINE contextmenu_ #-} +contextmenu_ :: Convert a => a -> Attribute +contextmenu_ x = Attribute $ " contextmenu=\"" <> unConv (conv x) <> "\"" + +{-# INLINE controls_ #-} +controls_ :: Convert a => a -> Attribute +controls_ x = Attribute $ " controls=\"" <> unConv (conv x) <> "\"" + +{-# INLINE coords_ #-} +coords_ :: Convert a => a -> Attribute +coords_ x = Attribute $ " coords=\"" <> unConv (conv x) <> "\"" + +{-# INLINE crossorigin_ #-} +crossorigin_ :: Convert a => a -> Attribute +crossorigin_ x = Attribute $ " crossorigin=\"" <> unConv (conv x) <> "\"" + +{-# INLINE data_ #-} +data_ :: Convert a => a -> Attribute +data_ x = Attribute $ " data=\"" <> unConv (conv x) <> "\"" + +{-# INLINE datetime_ #-} +datetime_ :: Convert a => a -> Attribute +datetime_ x = Attribute $ " datetime=\"" <> unConv (conv x) <> "\"" + +{-# INLINE default_ #-} +default_ :: Convert a => a -> Attribute +default_ x = Attribute $ " default=\"" <> unConv (conv x) <> "\"" + +{-# INLINE defer_ #-} +defer_ :: Convert a => a -> Attribute +defer_ x = Attribute $ " defer=\"" <> unConv (conv x) <> "\"" + +{-# INLINE dir_ #-} +dir_ :: Convert a => a -> Attribute +dir_ x = Attribute $ " dir=\"" <> unConv (conv x) <> "\"" + +{-# INLINE dirname_ #-} +dirname_ :: Convert a => a -> Attribute +dirname_ x = Attribute $ " dirname=\"" <> unConv (conv x) <> "\"" + +{-# INLINE disabled_ #-} +disabled_ :: Convert a => a -> Attribute +disabled_ x = Attribute $ " disabled=\"" <> unConv (conv x) <> "\"" + +{-# INLINE download_ #-} +download_ :: Convert a => a -> Attribute +download_ x = Attribute $ " download=\"" <> unConv (conv x) <> "\"" + +{-# INLINE draggable_ #-} +draggable_ :: Convert a => a -> Attribute +draggable_ x = Attribute $ " draggable=\"" <> unConv (conv x) <> "\"" + +{-# INLINE dropzone_ #-} +dropzone_ :: Convert a => a -> Attribute +dropzone_ x = Attribute $ " dropzone=\"" <> unConv (conv x) <> "\"" + +{-# INLINE enctype_ #-} +enctype_ :: Convert a => a -> Attribute +enctype_ x = Attribute $ " enctype=\"" <> unConv (conv x) <> "\"" + +{-# INLINE for_ #-} +for_ :: Convert a => a -> Attribute +for_ x = Attribute $ " for=\"" <> unConv (conv x) <> "\"" + +{-# INLINE form_ #-} +form_ :: Convert a => a -> Attribute +form_ x = Attribute $ " form=\"" <> unConv (conv x) <> "\"" + +{-# INLINE formaction_ #-} +formaction_ :: Convert a => a -> Attribute +formaction_ x = Attribute $ " formaction=\"" <> unConv (conv x) <> "\"" + +{-# INLINE headers_ #-} +headers_ :: Convert a => a -> Attribute +headers_ x = Attribute $ " headers=\"" <> unConv (conv x) <> "\"" + +{-# INLINE height_ #-} +height_ :: Convert a => a -> Attribute +height_ x = Attribute $ " height=\"" <> unConv (conv x) <> "\"" + +{-# INLINE hidden_ #-} +hidden_ :: Convert a => a -> Attribute +hidden_ x = Attribute $ " hidden=\"" <> unConv (conv x) <> "\"" + +{-# INLINE high_ #-} +high_ :: Convert a => a -> Attribute +high_ x = Attribute $ " high=\"" <> unConv (conv x) <> "\"" + +{-# INLINE href_ #-} +href_ :: Convert a => a -> Attribute +href_ x = Attribute $ " href=\"" <> unConv (conv x) <> "\"" + +{-# INLINE hreflang_ #-} +hreflang_ :: Convert a => a -> Attribute +hreflang_ x = Attribute $ " hreflang=\"" <> unConv (conv x) <> "\"" + +{-# INLINE httpequiv_ #-} +httpequiv_ :: Convert a => a -> Attribute +httpequiv_ x = Attribute $ " httpequiv=\"" <> unConv (conv x) <> "\"" + +{-# INLINE icon_ #-} +icon_ :: Convert a => a -> Attribute +icon_ x = Attribute $ " icon=\"" <> unConv (conv x) <> "\"" + +{-# INLINE id_ #-} +id_ :: Convert a => a -> Attribute +id_ x = Attribute $ " id=\"" <> unConv (conv x) <> "\"" + +{-# INLINE integrity_ #-} +integrity_ :: Convert a => a -> Attribute +integrity_ x = Attribute $ " integrity=\"" <> unConv (conv x) <> "\"" + +{-# INLINE ismap_ #-} +ismap_ :: Convert a => a -> Attribute +ismap_ x = Attribute $ " ismap=\"" <> unConv (conv x) <> "\"" + +{-# INLINE itemprop_ #-} +itemprop_ :: Convert a => a -> Attribute +itemprop_ x = Attribute $ " itemprop=\"" <> unConv (conv x) <> "\"" + +{-# INLINE keytype_ #-} +keytype_ :: Convert a => a -> Attribute +keytype_ x = Attribute $ " keytype=\"" <> unConv (conv x) <> "\"" + +{-# INLINE kind_ #-} +kind_ :: Convert a => a -> Attribute +kind_ x = Attribute $ " kind=\"" <> unConv (conv x) <> "\"" + +{-# INLINE label_ #-} +label_ :: Convert a => a -> Attribute +label_ x = Attribute $ " label=\"" <> unConv (conv x) <> "\"" + +{-# INLINE lang_ #-} +lang_ :: Convert a => a -> Attribute +lang_ x = Attribute $ " lang=\"" <> unConv (conv x) <> "\"" + +{-# INLINE language_ #-} +language_ :: Convert a => a -> Attribute +language_ x = Attribute $ " language=\"" <> unConv (conv x) <> "\"" + +{-# INLINE list_ #-} +list_ :: Convert a => a -> Attribute +list_ x = Attribute $ " list=\"" <> unConv (conv x) <> "\"" + +{-# INLINE loop_ #-} +loop_ :: Convert a => a -> Attribute +loop_ x = Attribute $ " loop=\"" <> unConv (conv x) <> "\"" + +{-# INLINE low_ #-} +low_ :: Convert a => a -> Attribute +low_ x = Attribute $ " low=\"" <> unConv (conv x) <> "\"" + +{-# INLINE manifest_ #-} +manifest_ :: Convert a => a -> Attribute +manifest_ x = Attribute $ " manifest=\"" <> unConv (conv x) <> "\"" + +{-# INLINE max_ #-} +max_ :: Convert a => a -> Attribute +max_ x = Attribute $ " max=\"" <> unConv (conv x) <> "\"" + +{-# INLINE maxlength_ #-} +maxlength_ :: Convert a => a -> Attribute +maxlength_ x = Attribute $ " maxlength=\"" <> unConv (conv x) <> "\"" + +{-# INLINE minlength_ #-} +minlength_ :: Convert a => a -> Attribute +minlength_ x = Attribute $ " minlength=\"" <> unConv (conv x) <> "\"" + +{-# INLINE media_ #-} +media_ :: Convert a => a -> Attribute +media_ x = Attribute $ " media=\"" <> unConv (conv x) <> "\"" + +{-# INLINE method_ #-} +method_ :: Convert a => a -> Attribute +method_ x = Attribute $ " method=\"" <> unConv (conv x) <> "\"" + +{-# INLINE min_ #-} +min_ :: Convert a => a -> Attribute +min_ x = Attribute $ " min=\"" <> unConv (conv x) <> "\"" + +{-# INLINE multiple_ #-} +multiple_ :: Convert a => a -> Attribute +multiple_ x = Attribute $ " multiple=\"" <> unConv (conv x) <> "\"" + +{-# INLINE muted_ #-} +muted_ :: Convert a => a -> Attribute +muted_ x = Attribute $ " muted=\"" <> unConv (conv x) <> "\"" + +{-# INLINE name_ #-} +name_ :: Convert a => a -> Attribute +name_ x = Attribute $ " name=\"" <> unConv (conv x) <> "\"" + +{-# INLINE novalidate_ #-} +novalidate_ :: Convert a => a -> Attribute +novalidate_ x = Attribute $ " novalidate=\"" <> unConv (conv x) <> "\"" + +{-# INLINE open_ #-} +open_ :: Convert a => a -> Attribute +open_ x = Attribute $ " open=\"" <> unConv (conv x) <> "\"" + +{-# INLINE optimum_ #-} +optimum_ :: Convert a => a -> Attribute +optimum_ x = Attribute $ " optimum=\"" <> unConv (conv x) <> "\"" + +{-# INLINE pattern_ #-} +pattern_ :: Convert a => a -> Attribute +pattern_ x = Attribute $ " pattern=\"" <> unConv (conv x) <> "\"" + +{-# INLINE ping_ #-} +ping_ :: Convert a => a -> Attribute +ping_ x = Attribute $ " ping=\"" <> unConv (conv x) <> "\"" + +{-# INLINE placeholder_ #-} +placeholder_ :: Convert a => a -> Attribute +placeholder_ x = Attribute $ " placeholder=\"" <> unConv (conv x) <> "\"" + +{-# INLINE poster_ #-} +poster_ :: Convert a => a -> Attribute +poster_ x = Attribute $ " poster=\"" <> unConv (conv x) <> "\"" + +{-# INLINE preload_ #-} +preload_ :: Convert a => a -> Attribute +preload_ x = Attribute $ " preload=\"" <> unConv (conv x) <> "\"" + +{-# INLINE radiogroup_ #-} +radiogroup_ :: Convert a => a -> Attribute +radiogroup_ x = Attribute $ " radiogroup=\"" <> unConv (conv x) <> "\"" + +{-# INLINE readonly_ #-} +readonly_ :: Convert a => a -> Attribute +readonly_ x = Attribute $ " readonly=\"" <> unConv (conv x) <> "\"" + +{-# INLINE rel_ #-} +rel_ :: Convert a => a -> Attribute +rel_ x = Attribute $ " rel=\"" <> unConv (conv x) <> "\"" + +{-# INLINE required_ #-} +required_ :: Convert a => a -> Attribute +required_ x = Attribute $ " required=\"" <> unConv (conv x) <> "\"" + +{-# INLINE reversed_ #-} +reversed_ :: Convert a => a -> Attribute +reversed_ x = Attribute $ " reversed=\"" <> unConv (conv x) <> "\"" + +{-# INLINE rows_ #-} +rows_ :: Convert a => a -> Attribute +rows_ x = Attribute $ " rows=\"" <> unConv (conv x) <> "\"" + +{-# INLINE rowspan_ #-} +rowspan_ :: Convert a => a -> Attribute +rowspan_ x = Attribute $ " rowspan=\"" <> unConv (conv x) <> "\"" + +{-# INLINE sandbox_ #-} +sandbox_ :: Convert a => a -> Attribute +sandbox_ x = Attribute $ " sandbox=\"" <> unConv (conv x) <> "\"" + +{-# INLINE scope_ #-} +scope_ :: Convert a => a -> Attribute +scope_ x = Attribute $ " scope=\"" <> unConv (conv x) <> "\"" + +{-# INLINE scoped_ #-} +scoped_ :: Convert a => a -> Attribute +scoped_ x = Attribute $ " scoped=\"" <> unConv (conv x) <> "\"" + +{-# INLINE seamless_ #-} +seamless_ :: Convert a => a -> Attribute +seamless_ x = Attribute $ " seamless=\"" <> unConv (conv x) <> "\"" + +{-# INLINE selected_ #-} +selected_ :: Convert a => a -> Attribute +selected_ x = Attribute $ " selected=\"" <> unConv (conv x) <> "\"" + +{-# INLINE shape_ #-} +shape_ :: Convert a => a -> Attribute +shape_ x = Attribute $ " shape=\"" <> unConv (conv x) <> "\"" + +{-# INLINE size_ #-} +size_ :: Convert a => a -> Attribute +size_ x = Attribute $ " size=\"" <> unConv (conv x) <> "\"" + +{-# INLINE sizes_ #-} +sizes_ :: Convert a => a -> Attribute +sizes_ x = Attribute $ " sizes=\"" <> unConv (conv x) <> "\"" + +{-# INLINE slot_ #-} +slot_ :: Convert a => a -> Attribute +slot_ x = Attribute $ " slot=\"" <> unConv (conv x) <> "\"" + +{-# INLINE span_ #-} +span_ :: Convert a => a -> Attribute +span_ x = Attribute $ " span=\"" <> unConv (conv x) <> "\"" + +{-# INLINE spellcheck_ #-} +spellcheck_ :: Convert a => a -> Attribute +spellcheck_ x = Attribute $ " spellcheck=\"" <> unConv (conv x) <> "\"" + +{-# INLINE src_ #-} +src_ :: Convert a => a -> Attribute +src_ x = Attribute $ " src=\"" <> unConv (conv x) <> "\"" + +{-# INLINE srcdoc_ #-} +srcdoc_ :: Convert a => a -> Attribute +srcdoc_ x = Attribute $ " srcdoc=\"" <> unConv (conv x) <> "\"" + +{-# INLINE srclang_ #-} +srclang_ :: Convert a => a -> Attribute +srclang_ x = Attribute $ " srclang=\"" <> unConv (conv x) <> "\"" + +{-# INLINE srcset_ #-} +srcset_ :: Convert a => a -> Attribute +srcset_ x = Attribute $ " srcset=\"" <> unConv (conv x) <> "\"" + +{-# INLINE start_ #-} +start_ :: Convert a => a -> Attribute +start_ x = Attribute $ " start=\"" <> unConv (conv x) <> "\"" + +{-# INLINE step_ #-} +step_ :: Convert a => a -> Attribute +step_ x = Attribute $ " step=\"" <> unConv (conv x) <> "\"" + +{-# INLINE style_ #-} +style_ :: Convert a => a -> Attribute +style_ x = Attribute $ " style=\"" <> unConv (conv x) <> "\"" + +{-# INLINE summary_ #-} +summary_ :: Convert a => a -> Attribute +summary_ x = Attribute $ " summary=\"" <> unConv (conv x) <> "\"" + +{-# INLINE tabindex_ #-} +tabindex_ :: Convert a => a -> Attribute +tabindex_ x = Attribute $ " tabindex=\"" <> unConv (conv x) <> "\"" + +{-# INLINE target_ #-} +target_ :: Convert a => a -> Attribute +target_ x = Attribute $ " target=\"" <> unConv (conv x) <> "\"" + +{-# INLINE title_ #-} +title_ :: Convert a => a -> Attribute +title_ x = Attribute $ " title=\"" <> unConv (conv x) <> "\"" + +{-# INLINE type_ #-} +type_ :: Convert a => a -> Attribute +type_ x = Attribute $ " type=\"" <> unConv (conv x) <> "\"" + +{-# INLINE usemap_ #-} +usemap_ :: Convert a => a -> Attribute +usemap_ x = Attribute $ " usemap=\"" <> unConv (conv x) <> "\"" + +{-# INLINE value_ #-} +value_ :: Convert a => a -> Attribute +value_ x = Attribute $ " value=\"" <> unConv (conv x) <> "\"" + +{-# INLINE width_ #-} +width_ :: Convert a => a -> Attribute +width_ x = Attribute $ " width=\"" <> unConv (conv x) <> "\"" + +{-# INLINE wrap_ #-} +wrap_ :: Convert a => a -> Attribute +wrap_ x = Attribute $ " wrap=\"" <> unConv (conv x) <> "\"" diff --git a/src/Html/Convert.hs b/src/Html/Convert.hs new file mode 100644 --- /dev/null +++ b/src/Html/Convert.hs @@ -0,0 +1,163 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE LambdaCase #-} + +module Html.Convert where + +import Data.Proxy +import Data.String +import GHC.TypeLits +import Html.Type + +import qualified Data.Text.Lazy as T +import qualified Data.Text.Lazy.Encoding as T +import qualified Data.Text.Lazy.Builder as TB +import qualified Data.Text.Lazy.Builder.Int as TB +import qualified Data.Text.Lazy.Builder.RealFloat as TB +import qualified Data.ByteString.Lazy.Char8 as B + +{-# INLINE escapeString #-} +escapeString :: String -> String +escapeString = concatMap $ escape pure + +{-# INLINE escapeText #-} +escapeText :: T.Text -> T.Text +escapeText = T.concatMap $ escape T.singleton + +{-# INLINE escapeByteString #-} +escapeByteString :: B.ByteString -> B.ByteString +escapeByteString = B.concatMap $ escape B.singleton + +{-# INLINE escape #-} +escape :: IsString a => (Char -> a) -> Char -> a +escape f = \case + '<' -> "<" + '>' -> ">" + '&' -> "&" + '"' -> """ + '\'' -> "'" + x -> f x + +class Conv b where + conv :: Convert a => a -> Converted b + +instance Conv String where + {-# INLINE conv #-} + conv = convertString +instance Conv T.Text where + {-# INLINE conv #-} + conv = convertText +instance Conv B.ByteString where + {-# INLINE conv #-} + conv = convertByteString + +{-| Convert a type efficienctly to different string like types. Add + instances if you want use custom types in your document. + +@ +{\-\# LANGUAGE RecordWildCards \#-\} + +module Main where + +import Html + +data Person + = Person + { name :: String + , age :: Int + , vegetarian :: Bool + } + +-- | This is not efficient, but understandable. +-- The call to convertText is needed for escaping. +-- This is enforced by a newtype. Wrap it in Raw if you don't want to escape. +instance Convert Person where + convertText (Person{..}) + = convertText + $ name + ++ " is " + ++ show age + ++ " years old and likes " + ++ if vegetarian then "oranges." else "meat." + +john :: Person +john = Person {name = "John", age = 52, vegetarian = True} + +main :: IO () +main = print (div_ john) +@ +-} +class Convert a where + + {-# MINIMAL convertText #-} + + convertString :: a -> Converted String + {-# INLINE convertString #-} + convertString = Converted . T.unpack . unConv . convertText + + convertText :: a -> Converted T.Text + + convertByteString :: a -> Converted B.ByteString + {-# INLINE convertByteString #-} + convertByteString = Converted . T.encodeUtf8 . unConv . convertText + +instance Convert (Raw String) where + {-# INLINE convertText #-} + convertText (Raw x) = Converted (T.pack x) +instance Convert (Raw T.Text) where + {-# INLINE convertText #-} + convertText (Raw x) = Converted x +instance Convert (Raw B.ByteString) where + {-# INLINE convertText #-} + convertText (Raw x) = Converted (T.decodeUtf8 x) + {-# INLINE convertByteString #-} + convertByteString (Raw x) = Converted x +instance Convert String where + {-# INLINE convertString #-} + convertString = Converted . escapeString + {-# INLINE convertText #-} + convertText = Converted . escapeText . T.pack +instance Convert T.Text where + {-# INLINE convertText #-} + convertText = Converted . escapeText +instance Convert Int where + {-# INLINE convertString #-} + convertString = Converted . show + {-# INLINE convertText #-} + convertText = Converted . TB.toLazyText . TB.decimal + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . show +instance Convert Integer where + {-# INLINE convertString #-} + convertString = Converted . show + {-# INLINE convertText #-} + convertText = Converted . TB.toLazyText . TB.decimal + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . show +instance Convert Float where + {-# INLINE convertString #-} + convertString = Converted . show + {-# INLINE convertText #-} + convertText = Converted . TB.toLazyText . TB.realFloat + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . show +instance Convert Double where + convertString = Converted . show + {-# INLINE convertText #-} + convertText = Converted . TB.toLazyText . TB.realFloat + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . show +instance Convert Word where + {-# INLINE convertString #-} + convertString = Converted . show + {-# INLINE convertText #-} + convertText = Converted . TB.toLazyText . TB.decimal + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . show +instance KnownSymbol a => Convert (Proxy a) where + {-# INLINE convertString #-} + convertString = Converted . symbolVal + {-# INLINE convertText #-} + convertText = Converted . T.pack . symbolVal + {-# INLINE convertByteString #-} + convertByteString = Converted . B.pack . symbolVal diff --git a/src/Html/Element.hs b/src/Html/Element.hs --- a/src/Html/Element.hs +++ b/src/Html/Element.hs @@ -6,7 +6,6 @@ module Html.Element where import Html.Type -import Html.Function (addAttributes) doctype_ :: 'DOCTYPE > () doctype_ = Child () @@ -14,875 +13,875 @@ a_ :: ('A ?> a) => a -> 'A > a a_ = Child -a_A :: ('A ?> a) => [(String, String)] -> a -> 'A :> a -a_A xs = addAttributes xs . Child +a_A :: ('A ?> a) => [Attribute] -> a -> 'A :> a +a_A = WithAttributes abbr_ :: ('Abbr ?> a) => a -> 'Abbr > a abbr_ = Child -abbr_A :: ('Abbr ?> a) => [(String, String)] -> a -> 'Abbr :> a -abbr_A xs = addAttributes xs . Child +abbr_A :: ('Abbr ?> a) => [Attribute] -> a -> 'Abbr :> a +abbr_A = WithAttributes acronym_ :: ('Acronym ?> a) => a -> 'Acronym > a acronym_ = Child -acronym_A :: ('Acronym ?> a) => [(String, String)] -> a -> 'Acronym :> a -acronym_A xs = addAttributes xs . Child +acronym_A :: ('Acronym ?> a) => [Attribute] -> a -> 'Acronym :> a +acronym_A = WithAttributes address_ :: ('Address ?> a) => a -> 'Address > a address_ = Child -address_A :: ('Address ?> a) => [(String, String)] -> a -> 'Address :> a -address_A xs = addAttributes xs . Child +address_A :: ('Address ?> a) => [Attribute] -> a -> 'Address :> a +address_A = WithAttributes applet_ :: ('Applet ?> a) => a -> 'Applet > a applet_ = Child -applet_A :: ('Applet ?> a) => [(String, String)] -> a -> 'Applet :> a -applet_A xs = addAttributes xs . Child +applet_A :: ('Applet ?> a) => [Attribute] -> a -> 'Applet :> a +applet_A = WithAttributes area_ :: 'Area > () area_ = Child () -area_A :: [(String, String)] -> 'Area :> () -area_A xs = addAttributes xs $ Child () +area_A :: [Attribute] -> 'Area :> () +area_A = flip WithAttributes () article_ :: ('Article ?> a) => a -> 'Article > a article_ = Child -article_A :: ('Article ?> a) => [(String, String)] -> a -> 'Article :> a -article_A xs = addAttributes xs . Child +article_A :: ('Article ?> a) => [Attribute] -> a -> 'Article :> a +article_A = WithAttributes aside_ :: ('Aside ?> a) => a -> 'Aside > a aside_ = Child -aside_A :: ('Aside ?> a) => [(String, String)] -> a -> 'Aside :> a -aside_A xs = addAttributes xs . Child +aside_A :: ('Aside ?> a) => [Attribute] -> a -> 'Aside :> a +aside_A = WithAttributes audio_ :: ('Audio ?> a) => a -> 'Audio > a audio_ = Child -audio_A :: ('Audio ?> a) => [(String, String)] -> a -> 'Audio :> a -audio_A xs = addAttributes xs . Child +audio_A :: ('Audio ?> a) => [Attribute] -> a -> 'Audio :> a +audio_A = WithAttributes b_ :: ('B ?> a) => a -> 'B > a b_ = Child -b_A :: ('B ?> a) => [(String, String)] -> a -> 'B :> a -b_A xs = addAttributes xs . Child +b_A :: ('B ?> a) => [Attribute] -> a -> 'B :> a +b_A = WithAttributes base_ :: 'Base > () base_ = Child () -base_A :: [(String, String)] -> 'Base :> () -base_A xs = addAttributes xs $ Child () +base_A :: [Attribute] -> 'Base :> () +base_A = flip WithAttributes () basefont_ :: ('Basefont ?> a) => a -> 'Basefont > a basefont_ = Child -basefont_A :: ('Basefont ?> a) => [(String, String)] -> a -> 'Basefont :> a -basefont_A xs = addAttributes xs . Child +basefont_A :: ('Basefont ?> a) => [Attribute] -> a -> 'Basefont :> a +basefont_A = WithAttributes bdi_ :: ('Bdi ?> a) => a -> 'Bdi > a bdi_ = Child -bdi_A :: ('Bdi ?> a) => [(String, String)] -> a -> 'Bdi :> a -bdi_A xs = addAttributes xs . Child +bdi_A :: ('Bdi ?> a) => [Attribute] -> a -> 'Bdi :> a +bdi_A = WithAttributes bdo_ :: ('Bdo ?> a) => a -> 'Bdo > a bdo_ = Child -bdo_A :: ('Bdo ?> a) => [(String, String)] -> a -> 'Bdo :> a -bdo_A xs = addAttributes xs . Child +bdo_A :: ('Bdo ?> a) => [Attribute] -> a -> 'Bdo :> a +bdo_A = WithAttributes bgsound_ :: ('Bgsound ?> a) => a -> 'Bgsound > a bgsound_ = Child -bgsound_A :: ('Bgsound ?> a) => [(String, String)] -> a -> 'Bgsound :> a -bgsound_A xs = addAttributes xs . Child +bgsound_A :: ('Bgsound ?> a) => [Attribute] -> a -> 'Bgsound :> a +bgsound_A = WithAttributes big_ :: ('Big ?> a) => a -> 'Big > a big_ = Child -big_A :: ('Big ?> a) => [(String, String)] -> a -> 'Big :> a -big_A xs = addAttributes xs . Child +big_A :: ('Big ?> a) => [Attribute] -> a -> 'Big :> a +big_A = WithAttributes blink_ :: ('Blink ?> a) => a -> 'Blink > a blink_ = Child -blink_A :: ('Blink ?> a) => [(String, String)] -> a -> 'Blink :> a -blink_A xs = addAttributes xs . Child +blink_A :: ('Blink ?> a) => [Attribute] -> a -> 'Blink :> a +blink_A = WithAttributes blockquote_ :: ('Blockquote ?> a) => a -> 'Blockquote > a blockquote_ = Child -blockquote_A :: ('Blockquote ?> a) => [(String, String)] -> a -> 'Blockquote :> a -blockquote_A xs = addAttributes xs . Child +blockquote_A :: ('Blockquote ?> a) => [Attribute] -> a -> 'Blockquote :> a +blockquote_A = WithAttributes body_ :: ('Body ?> a) => a -> 'Body > a body_ = Child -body_A :: ('Body ?> a) => [(String, String)] -> a -> 'Body :> a -body_A xs = addAttributes xs . Child +body_A :: ('Body ?> a) => [Attribute] -> a -> 'Body :> a +body_A = WithAttributes br_ :: 'Br > () br_ = Child () -br_A :: [(String, String)] -> 'Br :> () -br_A xs = addAttributes xs $ Child () +br_A :: [Attribute] -> 'Br :> () +br_A = flip WithAttributes () button_ :: ('Button ?> a) => a -> 'Button > a button_ = Child -button_A :: ('Button ?> a) => [(String, String)] -> a -> 'Button :> a -button_A xs = addAttributes xs . Child +button_A :: ('Button ?> a) => [Attribute] -> a -> 'Button :> a +button_A = WithAttributes canvas_ :: ('Canvas ?> a) => a -> 'Canvas > a canvas_ = Child -canvas_A :: ('Canvas ?> a) => [(String, String)] -> a -> 'Canvas :> a -canvas_A xs = addAttributes xs . Child +canvas_A :: ('Canvas ?> a) => [Attribute] -> a -> 'Canvas :> a +canvas_A = WithAttributes caption_ :: ('Caption ?> a) => a -> 'Caption > a caption_ = Child -caption_A :: ('Caption ?> a) => [(String, String)] -> a -> 'Caption :> a -caption_A xs = addAttributes xs . Child +caption_A :: ('Caption ?> a) => [Attribute] -> a -> 'Caption :> a +caption_A = WithAttributes center_ :: ('Center ?> a) => a -> 'Center > a center_ = Child -center_A :: ('Center ?> a) => [(String, String)] -> a -> 'Center :> a -center_A xs = addAttributes xs . Child +center_A :: ('Center ?> a) => [Attribute] -> a -> 'Center :> a +center_A = WithAttributes cite_ :: ('Cite ?> a) => a -> 'Cite > a cite_ = Child -cite_A :: ('Cite ?> a) => [(String, String)] -> a -> 'Cite :> a -cite_A xs = addAttributes xs . Child +cite_A :: ('Cite ?> a) => [Attribute] -> a -> 'Cite :> a +cite_A = WithAttributes code_ :: ('Code ?> a) => a -> 'Code > a code_ = Child -code_A :: ('Code ?> a) => [(String, String)] -> a -> 'Code :> a -code_A xs = addAttributes xs . Child +code_A :: ('Code ?> a) => [Attribute] -> a -> 'Code :> a +code_A = WithAttributes col_ :: 'Col > () col_ = Child () -col_A :: [(String, String)] -> 'Col :> () -col_A xs = addAttributes xs $ Child () +col_A :: [Attribute] -> 'Col :> () +col_A = flip WithAttributes () colgroup_ :: ('Colgroup ?> a) => a -> 'Colgroup > a colgroup_ = Child -colgroup_A :: ('Colgroup ?> a) => [(String, String)] -> a -> 'Colgroup :> a -colgroup_A xs = addAttributes xs . Child +colgroup_A :: ('Colgroup ?> a) => [Attribute] -> a -> 'Colgroup :> a +colgroup_A = WithAttributes command_ :: ('Command ?> a) => a -> 'Command > a command_ = Child -command_A :: ('Command ?> a) => [(String, String)] -> a -> 'Command :> a -command_A xs = addAttributes xs . Child +command_A :: ('Command ?> a) => [Attribute] -> a -> 'Command :> a +command_A = WithAttributes content_ :: ('Content ?> a) => a -> 'Content > a content_ = Child -content_A :: ('Content ?> a) => [(String, String)] -> a -> 'Content :> a -content_A xs = addAttributes xs . Child +content_A :: ('Content ?> a) => [Attribute] -> a -> 'Content :> a +content_A = WithAttributes data_ :: ('Data ?> a) => a -> 'Data > a data_ = Child -data_A :: ('Data ?> a) => [(String, String)] -> a -> 'Data :> a -data_A xs = addAttributes xs . Child +data_A :: ('Data ?> a) => [Attribute] -> a -> 'Data :> a +data_A = WithAttributes datalist_ :: ('Datalist ?> a) => a -> 'Datalist > a datalist_ = Child -datalist_A :: ('Datalist ?> a) => [(String, String)] -> a -> 'Datalist :> a -datalist_A xs = addAttributes xs . Child +datalist_A :: ('Datalist ?> a) => [Attribute] -> a -> 'Datalist :> a +datalist_A = WithAttributes dd_ :: ('Dd ?> a) => a -> 'Dd > a dd_ = Child -dd_A :: ('Dd ?> a) => [(String, String)] -> a -> 'Dd :> a -dd_A xs = addAttributes xs . Child +dd_A :: ('Dd ?> a) => [Attribute] -> a -> 'Dd :> a +dd_A = WithAttributes del_ :: ('Del ?> a) => a -> 'Del > a del_ = Child -del_A :: ('Del ?> a) => [(String, String)] -> a -> 'Del :> a -del_A xs = addAttributes xs . Child +del_A :: ('Del ?> a) => [Attribute] -> a -> 'Del :> a +del_A = WithAttributes details_ :: ('Details ?> a) => a -> 'Details > a details_ = Child -details_A :: ('Details ?> a) => [(String, String)] -> a -> 'Details :> a -details_A xs = addAttributes xs . Child +details_A :: ('Details ?> a) => [Attribute] -> a -> 'Details :> a +details_A = WithAttributes dfn_ :: ('Dfn ?> a) => a -> 'Dfn > a dfn_ = Child -dfn_A :: ('Dfn ?> a) => [(String, String)] -> a -> 'Dfn :> a -dfn_A xs = addAttributes xs . Child +dfn_A :: ('Dfn ?> a) => [Attribute] -> a -> 'Dfn :> a +dfn_A = WithAttributes dialog_ :: ('Dialog ?> a) => a -> 'Dialog > a dialog_ = Child -dialog_A :: ('Dialog ?> a) => [(String, String)] -> a -> 'Dialog :> a -dialog_A xs = addAttributes xs . Child +dialog_A :: ('Dialog ?> a) => [Attribute] -> a -> 'Dialog :> a +dialog_A = WithAttributes dir_ :: ('Dir ?> a) => a -> 'Dir > a dir_ = Child -dir_A :: ('Dir ?> a) => [(String, String)] -> a -> 'Dir :> a -dir_A xs = addAttributes xs . Child +dir_A :: ('Dir ?> a) => [Attribute] -> a -> 'Dir :> a +dir_A = WithAttributes div_ :: ('Div ?> a) => a -> 'Div > a div_ = Child -div_A :: ('Div ?> a) => [(String, String)] -> a -> 'Div :> a -div_A xs = addAttributes xs . Child +div_A :: ('Div ?> a) => [Attribute] -> a -> 'Div :> a +div_A = WithAttributes dl_ :: ('Dl ?> a) => a -> 'Dl > a dl_ = Child -dl_A :: ('Dl ?> a) => [(String, String)] -> a -> 'Dl :> a -dl_A xs = addAttributes xs . Child +dl_A :: ('Dl ?> a) => [Attribute] -> a -> 'Dl :> a +dl_A = WithAttributes dt_ :: ('Dt ?> a) => a -> 'Dt > a dt_ = Child -dt_A :: ('Dt ?> a) => [(String, String)] -> a -> 'Dt :> a -dt_A xs = addAttributes xs . Child +dt_A :: ('Dt ?> a) => [Attribute] -> a -> 'Dt :> a +dt_A = WithAttributes element_ :: ('Element ?> a) => a -> 'Element > a element_ = Child -element_A :: ('Element ?> a) => [(String, String)] -> a -> 'Element :> a -element_A xs = addAttributes xs . Child +element_A :: ('Element ?> a) => [Attribute] -> a -> 'Element :> a +element_A = WithAttributes em_ :: ('Em ?> a) => a -> 'Em > a em_ = Child -em_A :: ('Em ?> a) => [(String, String)] -> a -> 'Em :> a -em_A xs = addAttributes xs . Child +em_A :: ('Em ?> a) => [Attribute] -> a -> 'Em :> a +em_A = WithAttributes embed_ :: 'Embed > () embed_ = Child () -embed_A :: [(String, String)] -> 'Embed :> () -embed_A xs = addAttributes xs $ Child () +embed_A :: [Attribute] -> 'Embed :> () +embed_A = flip WithAttributes () fieldset_ :: ('Fieldset ?> a) => a -> 'Fieldset > a fieldset_ = Child -fieldset_A :: ('Fieldset ?> a) => [(String, String)] -> a -> 'Fieldset :> a -fieldset_A xs = addAttributes xs . Child +fieldset_A :: ('Fieldset ?> a) => [Attribute] -> a -> 'Fieldset :> a +fieldset_A = WithAttributes figcaption_ :: ('Figcaption ?> a) => a -> 'Figcaption > a figcaption_ = Child -figcaption_A :: ('Figcaption ?> a) => [(String, String)] -> a -> 'Figcaption :> a -figcaption_A xs = addAttributes xs . Child +figcaption_A :: ('Figcaption ?> a) => [Attribute] -> a -> 'Figcaption :> a +figcaption_A = WithAttributes figure_ :: ('Figure ?> a) => a -> 'Figure > a figure_ = Child -figure_A :: ('Figure ?> a) => [(String, String)] -> a -> 'Figure :> a -figure_A xs = addAttributes xs . Child +figure_A :: ('Figure ?> a) => [Attribute] -> a -> 'Figure :> a +figure_A = WithAttributes font_ :: ('Font ?> a) => a -> 'Font > a font_ = Child -font_A :: ('Font ?> a) => [(String, String)] -> a -> 'Font :> a -font_A xs = addAttributes xs . Child +font_A :: ('Font ?> a) => [Attribute] -> a -> 'Font :> a +font_A = WithAttributes footer_ :: ('Footer ?> a) => a -> 'Footer > a footer_ = Child -footer_A :: ('Footer ?> a) => [(String, String)] -> a -> 'Footer :> a -footer_A xs = addAttributes xs . Child +footer_A :: ('Footer ?> a) => [Attribute] -> a -> 'Footer :> a +footer_A = WithAttributes form_ :: ('Form ?> a) => a -> 'Form > a form_ = Child -form_A :: ('Form ?> a) => [(String, String)] -> a -> 'Form :> a -form_A xs = addAttributes xs . Child +form_A :: ('Form ?> a) => [Attribute] -> a -> 'Form :> a +form_A = WithAttributes frame_ :: ('Frame ?> a) => a -> 'Frame > a frame_ = Child -frame_A :: ('Frame ?> a) => [(String, String)] -> a -> 'Frame :> a -frame_A xs = addAttributes xs . Child +frame_A :: ('Frame ?> a) => [Attribute] -> a -> 'Frame :> a +frame_A = WithAttributes frameset_ :: ('Frameset ?> a) => a -> 'Frameset > a frameset_ = Child -frameset_A :: ('Frameset ?> a) => [(String, String)] -> a -> 'Frameset :> a -frameset_A xs = addAttributes xs . Child +frameset_A :: ('Frameset ?> a) => [Attribute] -> a -> 'Frameset :> a +frameset_A = WithAttributes h1_ :: ('H1 ?> a) => a -> 'H1 > a h1_ = Child -h1_A :: ('H1 ?> a) => [(String, String)] -> a -> 'H1 :> a -h1_A xs = addAttributes xs . Child +h1_A :: ('H1 ?> a) => [Attribute] -> a -> 'H1 :> a +h1_A = WithAttributes h2_ :: ('H2 ?> a) => a -> 'H2 > a h2_ = Child -h2_A :: ('H2 ?> a) => [(String, String)] -> a -> 'H2 :> a -h2_A xs = addAttributes xs . Child +h2_A :: ('H2 ?> a) => [Attribute] -> a -> 'H2 :> a +h2_A = WithAttributes h3_ :: ('H3 ?> a) => a -> 'H3 > a h3_ = Child -h3_A :: ('H3 ?> a) => [(String, String)] -> a -> 'H3 :> a -h3_A xs = addAttributes xs . Child +h3_A :: ('H3 ?> a) => [Attribute] -> a -> 'H3 :> a +h3_A = WithAttributes h4_ :: ('H4 ?> a) => a -> 'H4 > a h4_ = Child -h4_A :: ('H4 ?> a) => [(String, String)] -> a -> 'H4 :> a -h4_A xs = addAttributes xs . Child +h4_A :: ('H4 ?> a) => [Attribute] -> a -> 'H4 :> a +h4_A = WithAttributes h5_ :: ('H5 ?> a) => a -> 'H5 > a h5_ = Child -h5_A :: ('H5 ?> a) => [(String, String)] -> a -> 'H5 :> a -h5_A xs = addAttributes xs . Child +h5_A :: ('H5 ?> a) => [Attribute] -> a -> 'H5 :> a +h5_A = WithAttributes h6_ :: ('H6 ?> a) => a -> 'H6 > a h6_ = Child -h6_A :: ('H6 ?> a) => [(String, String)] -> a -> 'H6 :> a -h6_A xs = addAttributes xs . Child +h6_A :: ('H6 ?> a) => [Attribute] -> a -> 'H6 :> a +h6_A = WithAttributes head_ :: ('Head ?> a) => a -> 'Head > a head_ = Child -head_A :: ('Head ?> a) => [(String, String)] -> a -> 'Head :> a -head_A xs = addAttributes xs . Child +head_A :: ('Head ?> a) => [Attribute] -> a -> 'Head :> a +head_A = WithAttributes header_ :: ('Header ?> a) => a -> 'Header > a header_ = Child -header_A :: ('Header ?> a) => [(String, String)] -> a -> 'Header :> a -header_A xs = addAttributes xs . Child +header_A :: ('Header ?> a) => [Attribute] -> a -> 'Header :> a +header_A = WithAttributes hgroup_ :: ('Hgroup ?> a) => a -> 'Hgroup > a hgroup_ = Child -hgroup_A :: ('Hgroup ?> a) => [(String, String)] -> a -> 'Hgroup :> a -hgroup_A xs = addAttributes xs . Child +hgroup_A :: ('Hgroup ?> a) => [Attribute] -> a -> 'Hgroup :> a +hgroup_A = WithAttributes hr_ :: 'Hr > () hr_ = Child () -hr_A :: [(String, String)] -> 'Hr :> () -hr_A xs = addAttributes xs $ Child () +hr_A :: [Attribute] -> 'Hr :> () +hr_A = flip WithAttributes () html_ :: ('Html ?> a) => a -> 'Html > a html_ = Child -html_A :: ('Html ?> a) => [(String, String)] -> a -> 'Html :> a -html_A xs = addAttributes xs . Child +html_A :: ('Html ?> a) => [Attribute] -> a -> 'Html :> a +html_A = WithAttributes i_ :: ('I ?> a) => a -> 'I > a i_ = Child -i_A :: ('I ?> a) => [(String, String)] -> a -> 'I :> a -i_A xs = addAttributes xs . Child +i_A :: ('I ?> a) => [Attribute] -> a -> 'I :> a +i_A = WithAttributes iframe_ :: 'Iframe > () iframe_ = Child () -iframe_A :: [(String, String)] -> 'Iframe :> () -iframe_A xs = addAttributes xs $ Child () +iframe_A :: [Attribute] -> 'Iframe :> () +iframe_A = flip WithAttributes () image_ :: ('Image ?> a) => a -> 'Image > a image_ = Child -image_A :: ('Image ?> a) => [(String, String)] -> a -> 'Image :> a -image_A xs = addAttributes xs . Child +image_A :: ('Image ?> a) => [Attribute] -> a -> 'Image :> a +image_A = WithAttributes img_ :: 'Img > () img_ = Child () -img_A :: [(String, String)] -> 'Img :> () -img_A xs = addAttributes xs $ Child () +img_A :: [Attribute] -> 'Img :> () +img_A = flip WithAttributes () input_ :: ('Input ?> a) => a -> 'Input > a input_ = Child -input_A :: ('Input ?> a) => [(String, String)] -> a -> 'Input :> a -input_A xs = addAttributes xs . Child +input_A :: ('Input ?> a) => [Attribute] -> a -> 'Input :> a +input_A = WithAttributes ins_ :: ('Ins ?> a) => a -> 'Ins > a ins_ = Child -ins_A :: ('Ins ?> a) => [(String, String)] -> a -> 'Ins :> a -ins_A xs = addAttributes xs . Child +ins_A :: ('Ins ?> a) => [Attribute] -> a -> 'Ins :> a +ins_A = WithAttributes isindex_ :: ('Isindex ?> a) => a -> 'Isindex > a isindex_ = Child -isindex_A :: ('Isindex ?> a) => [(String, String)] -> a -> 'Isindex :> a -isindex_A xs = addAttributes xs . Child +isindex_A :: ('Isindex ?> a) => [Attribute] -> a -> 'Isindex :> a +isindex_A = WithAttributes kbd_ :: ('Kbd ?> a) => a -> 'Kbd > a kbd_ = Child -kbd_A :: ('Kbd ?> a) => [(String, String)] -> a -> 'Kbd :> a -kbd_A xs = addAttributes xs . Child +kbd_A :: ('Kbd ?> a) => [Attribute] -> a -> 'Kbd :> a +kbd_A = WithAttributes keygen_ :: ('Keygen ?> a) => a -> 'Keygen > a keygen_ = Child -keygen_A :: ('Keygen ?> a) => [(String, String)] -> a -> 'Keygen :> a -keygen_A xs = addAttributes xs . Child +keygen_A :: ('Keygen ?> a) => [Attribute] -> a -> 'Keygen :> a +keygen_A = WithAttributes label_ :: ('Label ?> a) => a -> 'Label > a label_ = Child -label_A :: ('Label ?> a) => [(String, String)] -> a -> 'Label :> a -label_A xs = addAttributes xs . Child +label_A :: ('Label ?> a) => [Attribute] -> a -> 'Label :> a +label_A = WithAttributes legend_ :: ('Legend ?> a) => a -> 'Legend > a legend_ = Child -legend_A :: ('Legend ?> a) => [(String, String)] -> a -> 'Legend :> a -legend_A xs = addAttributes xs . Child +legend_A :: ('Legend ?> a) => [Attribute] -> a -> 'Legend :> a +legend_A = WithAttributes li_ :: ('Li ?> a) => a -> 'Li > a li_ = Child -li_A :: ('Li ?> a) => [(String, String)] -> a -> 'Li :> a -li_A xs = addAttributes xs . Child +li_A :: ('Li ?> a) => [Attribute] -> a -> 'Li :> a +li_A = WithAttributes link_ :: 'Link > () link_ = Child () -link_A :: [(String, String)] -> 'Link :> () -link_A xs = addAttributes xs $ Child () +link_A :: [Attribute] -> 'Link :> () +link_A = flip WithAttributes () listing_ :: ('Listing ?> a) => a -> 'Listing > a listing_ = Child -listing_A :: ('Listing ?> a) => [(String, String)] -> a -> 'Listing :> a -listing_A xs = addAttributes xs . Child +listing_A :: ('Listing ?> a) => [Attribute] -> a -> 'Listing :> a +listing_A = WithAttributes main_ :: ('Main ?> a) => a -> 'Main > a main_ = Child -main_A :: ('Main ?> a) => [(String, String)] -> a -> 'Main :> a -main_A xs = addAttributes xs . Child +main_A :: ('Main ?> a) => [Attribute] -> a -> 'Main :> a +main_A = WithAttributes map_ :: ('Map ?> a) => a -> 'Map > a map_ = Child -map_A :: ('Map ?> a) => [(String, String)] -> a -> 'Map :> a -map_A xs = addAttributes xs . Child +map_A :: ('Map ?> a) => [Attribute] -> a -> 'Map :> a +map_A = WithAttributes mark_ :: ('Mark ?> a) => a -> 'Mark > a mark_ = Child -mark_A :: ('Mark ?> a) => [(String, String)] -> a -> 'Mark :> a -mark_A xs = addAttributes xs . Child +mark_A :: ('Mark ?> a) => [Attribute] -> a -> 'Mark :> a +mark_A = WithAttributes marquee_ :: ('Marquee ?> a) => a -> 'Marquee > a marquee_ = Child -marquee_A :: ('Marquee ?> a) => [(String, String)] -> a -> 'Marquee :> a -marquee_A xs = addAttributes xs . Child +marquee_A :: ('Marquee ?> a) => [Attribute] -> a -> 'Marquee :> a +marquee_A = WithAttributes math_ :: ('Math ?> a) => a -> 'Math > a math_ = Child -math_A :: ('Math ?> a) => [(String, String)] -> a -> 'Math :> a -math_A xs = addAttributes xs . Child +math_A :: ('Math ?> a) => [Attribute] -> a -> 'Math :> a +math_A = WithAttributes menu_ :: ('Menu ?> a) => a -> 'Menu > a menu_ = Child -menu_A :: ('Menu ?> a) => [(String, String)] -> a -> 'Menu :> a -menu_A xs = addAttributes xs . Child +menu_A :: ('Menu ?> a) => [Attribute] -> a -> 'Menu :> a +menu_A = WithAttributes menuitem_ :: 'Menuitem > () menuitem_ = Child () -menuitem_A :: [(String, String)] -> 'Menuitem :> () -menuitem_A xs = addAttributes xs $ Child () +menuitem_A :: [Attribute] -> 'Menuitem :> () +menuitem_A = flip WithAttributes () meta_ :: 'Meta > () meta_ = Child () -meta_A :: [(String, String)] -> 'Meta :> () -meta_A xs = addAttributes xs $ Child () +meta_A :: [Attribute] -> 'Meta :> () +meta_A = flip WithAttributes () meter_ :: ('Meter ?> a) => a -> 'Meter > a meter_ = Child -meter_A :: ('Meter ?> a) => [(String, String)] -> a -> 'Meter :> a -meter_A xs = addAttributes xs . Child +meter_A :: ('Meter ?> a) => [Attribute] -> a -> 'Meter :> a +meter_A = WithAttributes multicol_ :: ('Multicol ?> a) => a -> 'Multicol > a multicol_ = Child -multicol_A :: ('Multicol ?> a) => [(String, String)] -> a -> 'Multicol :> a -multicol_A xs = addAttributes xs . Child +multicol_A :: ('Multicol ?> a) => [Attribute] -> a -> 'Multicol :> a +multicol_A = WithAttributes nav_ :: ('Nav ?> a) => a -> 'Nav > a nav_ = Child -nav_A :: ('Nav ?> a) => [(String, String)] -> a -> 'Nav :> a -nav_A xs = addAttributes xs . Child +nav_A :: ('Nav ?> a) => [Attribute] -> a -> 'Nav :> a +nav_A = WithAttributes nextid_ :: ('Nextid ?> a) => a -> 'Nextid > a nextid_ = Child -nextid_A :: ('Nextid ?> a) => [(String, String)] -> a -> 'Nextid :> a -nextid_A xs = addAttributes xs . Child +nextid_A :: ('Nextid ?> a) => [Attribute] -> a -> 'Nextid :> a +nextid_A = WithAttributes nobr_ :: ('Nobr ?> a) => a -> 'Nobr > a nobr_ = Child -nobr_A :: ('Nobr ?> a) => [(String, String)] -> a -> 'Nobr :> a -nobr_A xs = addAttributes xs . Child +nobr_A :: ('Nobr ?> a) => [Attribute] -> a -> 'Nobr :> a +nobr_A = WithAttributes noembed_ :: ('Noembed ?> a) => a -> 'Noembed > a noembed_ = Child -noembed_A :: ('Noembed ?> a) => [(String, String)] -> a -> 'Noembed :> a -noembed_A xs = addAttributes xs . Child +noembed_A :: ('Noembed ?> a) => [Attribute] -> a -> 'Noembed :> a +noembed_A = WithAttributes noframes_ :: ('Noframes ?> a) => a -> 'Noframes > a noframes_ = Child -noframes_A :: ('Noframes ?> a) => [(String, String)] -> a -> 'Noframes :> a -noframes_A xs = addAttributes xs . Child +noframes_A :: ('Noframes ?> a) => [Attribute] -> a -> 'Noframes :> a +noframes_A = WithAttributes noscript_ :: ('Noscript ?> a) => a -> 'Noscript > a noscript_ = Child -noscript_A :: ('Noscript ?> a) => [(String, String)] -> a -> 'Noscript :> a -noscript_A xs = addAttributes xs . Child +noscript_A :: ('Noscript ?> a) => [Attribute] -> a -> 'Noscript :> a +noscript_A = WithAttributes object_ :: ('Object ?> a) => a -> 'Object > a object_ = Child -object_A :: ('Object ?> a) => [(String, String)] -> a -> 'Object :> a -object_A xs = addAttributes xs . Child +object_A :: ('Object ?> a) => [Attribute] -> a -> 'Object :> a +object_A = WithAttributes ol_ :: ('Ol ?> a) => a -> 'Ol > a ol_ = Child -ol_A :: ('Ol ?> a) => [(String, String)] -> a -> 'Ol :> a -ol_A xs = addAttributes xs . Child +ol_A :: ('Ol ?> a) => [Attribute] -> a -> 'Ol :> a +ol_A = WithAttributes optgroup_ :: ('Optgroup ?> a) => a -> 'Optgroup > a optgroup_ = Child -optgroup_A :: ('Optgroup ?> a) => [(String, String)] -> a -> 'Optgroup :> a -optgroup_A xs = addAttributes xs . Child +optgroup_A :: ('Optgroup ?> a) => [Attribute] -> a -> 'Optgroup :> a +optgroup_A = WithAttributes option_ :: ('Option ?> a) => a -> 'Option > a option_ = Child -option_A :: ('Option ?> a) => [(String, String)] -> a -> 'Option :> a -option_A xs = addAttributes xs . Child +option_A :: ('Option ?> a) => [Attribute] -> a -> 'Option :> a +option_A = WithAttributes output_ :: ('Output ?> a) => a -> 'Output > a output_ = Child -output_A :: ('Output ?> a) => [(String, String)] -> a -> 'Output :> a -output_A xs = addAttributes xs . Child +output_A :: ('Output ?> a) => [Attribute] -> a -> 'Output :> a +output_A = WithAttributes p_ :: ('P ?> a) => a -> 'P > a p_ = Child -p_A :: ('P ?> a) => [(String, String)] -> a -> 'P :> a -p_A xs = addAttributes xs . Child +p_A :: ('P ?> a) => [Attribute] -> a -> 'P :> a +p_A = WithAttributes param_ :: 'Param > () param_ = Child () -param_A :: [(String, String)] -> 'Param :> () -param_A xs = addAttributes xs $ Child () +param_A :: [Attribute] -> 'Param :> () +param_A = flip WithAttributes () picture_ :: ('Picture ?> a) => a -> 'Picture > a picture_ = Child -picture_A :: ('Picture ?> a) => [(String, String)] -> a -> 'Picture :> a -picture_A xs = addAttributes xs . Child +picture_A :: ('Picture ?> a) => [Attribute] -> a -> 'Picture :> a +picture_A = WithAttributes plaintext_ :: ('Plaintext ?> a) => a -> 'Plaintext > a plaintext_ = Child -plaintext_A :: ('Plaintext ?> a) => [(String, String)] -> a -> 'Plaintext :> a -plaintext_A xs = addAttributes xs . Child +plaintext_A :: ('Plaintext ?> a) => [Attribute] -> a -> 'Plaintext :> a +plaintext_A = WithAttributes pre_ :: ('Pre ?> a) => a -> 'Pre > a pre_ = Child -pre_A :: ('Pre ?> a) => [(String, String)] -> a -> 'Pre :> a -pre_A xs = addAttributes xs . Child +pre_A :: ('Pre ?> a) => [Attribute] -> a -> 'Pre :> a +pre_A = WithAttributes progress_ :: ('Progress ?> a) => a -> 'Progress > a progress_ = Child -progress_A :: ('Progress ?> a) => [(String, String)] -> a -> 'Progress :> a -progress_A xs = addAttributes xs . Child +progress_A :: ('Progress ?> a) => [Attribute] -> a -> 'Progress :> a +progress_A = WithAttributes q_ :: ('Q ?> a) => a -> 'Q > a q_ = Child -q_A :: ('Q ?> a) => [(String, String)] -> a -> 'Q :> a -q_A xs = addAttributes xs . Child +q_A :: ('Q ?> a) => [Attribute] -> a -> 'Q :> a +q_A = WithAttributes rp_ :: ('Rp ?> a) => a -> 'Rp > a rp_ = Child -rp_A :: ('Rp ?> a) => [(String, String)] -> a -> 'Rp :> a -rp_A xs = addAttributes xs . Child +rp_A :: ('Rp ?> a) => [Attribute] -> a -> 'Rp :> a +rp_A = WithAttributes rt_ :: ('Rt ?> a) => a -> 'Rt > a rt_ = Child -rt_A :: ('Rt ?> a) => [(String, String)] -> a -> 'Rt :> a -rt_A xs = addAttributes xs . Child +rt_A :: ('Rt ?> a) => [Attribute] -> a -> 'Rt :> a +rt_A = WithAttributes rtc_ :: ('Rtc ?> a) => a -> 'Rtc > a rtc_ = Child -rtc_A :: ('Rtc ?> a) => [(String, String)] -> a -> 'Rtc :> a -rtc_A xs = addAttributes xs . Child +rtc_A :: ('Rtc ?> a) => [Attribute] -> a -> 'Rtc :> a +rtc_A = WithAttributes ruby_ :: ('Ruby ?> a) => a -> 'Ruby > a ruby_ = Child -ruby_A :: ('Ruby ?> a) => [(String, String)] -> a -> 'Ruby :> a -ruby_A xs = addAttributes xs . Child +ruby_A :: ('Ruby ?> a) => [Attribute] -> a -> 'Ruby :> a +ruby_A = WithAttributes s_ :: ('S ?> a) => a -> 'S > a s_ = Child -s_A :: ('S ?> a) => [(String, String)] -> a -> 'S :> a -s_A xs = addAttributes xs . Child +s_A :: ('S ?> a) => [Attribute] -> a -> 'S :> a +s_A = WithAttributes samp_ :: ('Samp ?> a) => a -> 'Samp > a samp_ = Child -samp_A :: ('Samp ?> a) => [(String, String)] -> a -> 'Samp :> a -samp_A xs = addAttributes xs . Child +samp_A :: ('Samp ?> a) => [Attribute] -> a -> 'Samp :> a +samp_A = WithAttributes script_ :: ('Script ?> a) => a -> 'Script > a script_ = Child -script_A :: ('Script ?> a) => [(String, String)] -> a -> 'Script :> a -script_A xs = addAttributes xs . Child +script_A :: ('Script ?> a) => [Attribute] -> a -> 'Script :> a +script_A = WithAttributes section_ :: ('Section ?> a) => a -> 'Section > a section_ = Child -section_A :: ('Section ?> a) => [(String, String)] -> a -> 'Section :> a -section_A xs = addAttributes xs . Child +section_A :: ('Section ?> a) => [Attribute] -> a -> 'Section :> a +section_A = WithAttributes select_ :: ('Select ?> a) => a -> 'Select > a select_ = Child -select_A :: ('Select ?> a) => [(String, String)] -> a -> 'Select :> a -select_A xs = addAttributes xs . Child +select_A :: ('Select ?> a) => [Attribute] -> a -> 'Select :> a +select_A = WithAttributes shadow_ :: ('Shadow ?> a) => a -> 'Shadow > a shadow_ = Child -shadow_A :: ('Shadow ?> a) => [(String, String)] -> a -> 'Shadow :> a -shadow_A xs = addAttributes xs . Child +shadow_A :: ('Shadow ?> a) => [Attribute] -> a -> 'Shadow :> a +shadow_A = WithAttributes slot_ :: ('Slot ?> a) => a -> 'Slot > a slot_ = Child -slot_A :: ('Slot ?> a) => [(String, String)] -> a -> 'Slot :> a -slot_A xs = addAttributes xs . Child +slot_A :: ('Slot ?> a) => [Attribute] -> a -> 'Slot :> a +slot_A = WithAttributes small_ :: ('Small ?> a) => a -> 'Small > a small_ = Child -small_A :: ('Small ?> a) => [(String, String)] -> a -> 'Small :> a -small_A xs = addAttributes xs . Child +small_A :: ('Small ?> a) => [Attribute] -> a -> 'Small :> a +small_A = WithAttributes source_ :: 'Source > () source_ = Child () -source_A :: [(String, String)] -> 'Source :> () -source_A xs = addAttributes xs $ Child () +source_A :: [Attribute] -> 'Source :> () +source_A = flip WithAttributes () spacer_ :: ('Spacer ?> a) => a -> 'Spacer > a spacer_ = Child -spacer_A :: ('Spacer ?> a) => [(String, String)] -> a -> 'Spacer :> a -spacer_A xs = addAttributes xs . Child +spacer_A :: ('Spacer ?> a) => [Attribute] -> a -> 'Spacer :> a +spacer_A = WithAttributes span_ :: ('Span ?> a) => a -> 'Span > a span_ = Child -span_A :: ('Span ?> a) => [(String, String)] -> a -> 'Span :> a -span_A xs = addAttributes xs . Child +span_A :: ('Span ?> a) => [Attribute] -> a -> 'Span :> a +span_A = WithAttributes strike_ :: ('Strike ?> a) => a -> 'Strike > a strike_ = Child -strike_A :: ('Strike ?> a) => [(String, String)] -> a -> 'Strike :> a -strike_A xs = addAttributes xs . Child +strike_A :: ('Strike ?> a) => [Attribute] -> a -> 'Strike :> a +strike_A = WithAttributes strong_ :: ('Strong ?> a) => a -> 'Strong > a strong_ = Child -strong_A :: ('Strong ?> a) => [(String, String)] -> a -> 'Strong :> a -strong_A xs = addAttributes xs . Child +strong_A :: ('Strong ?> a) => [Attribute] -> a -> 'Strong :> a +strong_A = WithAttributes style_ :: ('Style ?> a) => a -> 'Style > a style_ = Child -style_A :: ('Style ?> a) => [(String, String)] -> a -> 'Style :> a -style_A xs = addAttributes xs . Child +style_A :: ('Style ?> a) => [Attribute] -> a -> 'Style :> a +style_A = WithAttributes sub_ :: ('Sub ?> a) => a -> 'Sub > a sub_ = Child -sub_A :: ('Sub ?> a) => [(String, String)] -> a -> 'Sub :> a -sub_A xs = addAttributes xs . Child +sub_A :: ('Sub ?> a) => [Attribute] -> a -> 'Sub :> a +sub_A = WithAttributes summary_ :: ('Summary ?> a) => a -> 'Summary > a summary_ = Child -summary_A :: ('Summary ?> a) => [(String, String)] -> a -> 'Summary :> a -summary_A xs = addAttributes xs . Child +summary_A :: ('Summary ?> a) => [Attribute] -> a -> 'Summary :> a +summary_A = WithAttributes sup_ :: ('Sup ?> a) => a -> 'Sup > a sup_ = Child -sup_A :: ('Sup ?> a) => [(String, String)] -> a -> 'Sup :> a -sup_A xs = addAttributes xs . Child +sup_A :: ('Sup ?> a) => [Attribute] -> a -> 'Sup :> a +sup_A = WithAttributes svg_ :: ('Svg ?> a) => a -> 'Svg > a svg_ = Child -svg_A :: ('Svg ?> a) => [(String, String)] -> a -> 'Svg :> a -svg_A xs = addAttributes xs . Child +svg_A :: ('Svg ?> a) => [Attribute] -> a -> 'Svg :> a +svg_A = WithAttributes table_ :: ('Table ?> a) => a -> 'Table > a table_ = Child -table_A :: ('Table ?> a) => [(String, String)] -> a -> 'Table :> a -table_A xs = addAttributes xs . Child +table_A :: ('Table ?> a) => [Attribute] -> a -> 'Table :> a +table_A = WithAttributes tbody_ :: ('Tbody ?> a) => a -> 'Tbody > a tbody_ = Child -tbody_A :: ('Tbody ?> a) => [(String, String)] -> a -> 'Tbody :> a -tbody_A xs = addAttributes xs . Child +tbody_A :: ('Tbody ?> a) => [Attribute] -> a -> 'Tbody :> a +tbody_A = WithAttributes td_ :: ('Td ?> a) => a -> 'Td > a td_ = Child -td_A :: ('Td ?> a) => [(String, String)] -> a -> 'Td :> a -td_A xs = addAttributes xs . Child +td_A :: ('Td ?> a) => [Attribute] -> a -> 'Td :> a +td_A = WithAttributes template_ :: ('Template ?> a) => a -> 'Template > a template_ = Child -template_A :: ('Template ?> a) => [(String, String)] -> a -> 'Template :> a -template_A xs = addAttributes xs . Child +template_A :: ('Template ?> a) => [Attribute] -> a -> 'Template :> a +template_A = WithAttributes textarea_ :: ('Textarea ?> a) => a -> 'Textarea > a textarea_ = Child -textarea_A :: ('Textarea ?> a) => [(String, String)] -> a -> 'Textarea :> a -textarea_A xs = addAttributes xs . Child +textarea_A :: ('Textarea ?> a) => [Attribute] -> a -> 'Textarea :> a +textarea_A = WithAttributes tfoot_ :: ('Tfoot ?> a) => a -> 'Tfoot > a tfoot_ = Child -tfoot_A :: ('Tfoot ?> a) => [(String, String)] -> a -> 'Tfoot :> a -tfoot_A xs = addAttributes xs . Child +tfoot_A :: ('Tfoot ?> a) => [Attribute] -> a -> 'Tfoot :> a +tfoot_A = WithAttributes th_ :: ('Th ?> a) => a -> 'Th > a th_ = Child -th_A :: ('Th ?> a) => [(String, String)] -> a -> 'Th :> a -th_A xs = addAttributes xs . Child +th_A :: ('Th ?> a) => [Attribute] -> a -> 'Th :> a +th_A = WithAttributes thead_ :: ('Thead ?> a) => a -> 'Thead > a thead_ = Child -thead_A :: ('Thead ?> a) => [(String, String)] -> a -> 'Thead :> a -thead_A xs = addAttributes xs . Child +thead_A :: ('Thead ?> a) => [Attribute] -> a -> 'Thead :> a +thead_A = WithAttributes time_ :: ('Time ?> a) => a -> 'Time > a time_ = Child -time_A :: ('Time ?> a) => [(String, String)] -> a -> 'Time :> a -time_A xs = addAttributes xs . Child +time_A :: ('Time ?> a) => [Attribute] -> a -> 'Time :> a +time_A = WithAttributes title_ :: ('Title ?> a) => a -> 'Title > a title_ = Child -title_A :: ('Title ?> a) => [(String, String)] -> a -> 'Title :> a -title_A xs = addAttributes xs . Child +title_A :: ('Title ?> a) => [Attribute] -> a -> 'Title :> a +title_A = WithAttributes tr_ :: ('Tr ?> a) => a -> 'Tr > a tr_ = Child -tr_A :: ('Tr ?> a) => [(String, String)] -> a -> 'Tr :> a -tr_A xs = addAttributes xs . Child +tr_A :: ('Tr ?> a) => [Attribute] -> a -> 'Tr :> a +tr_A = WithAttributes track_ :: 'Track > () track_ = Child () -track_A :: [(String, String)] -> 'Track :> () -track_A xs = addAttributes xs $ Child () +track_A :: [Attribute] -> 'Track :> () +track_A = flip WithAttributes () tt_ :: ('Tt ?> a) => a -> 'Tt > a tt_ = Child -tt_A :: ('Tt ?> a) => [(String, String)] -> a -> 'Tt :> a -tt_A xs = addAttributes xs . Child +tt_A :: ('Tt ?> a) => [Attribute] -> a -> 'Tt :> a +tt_A = WithAttributes u_ :: ('U ?> a) => a -> 'U > a u_ = Child -u_A :: ('U ?> a) => [(String, String)] -> a -> 'U :> a -u_A xs = addAttributes xs . Child +u_A :: ('U ?> a) => [Attribute] -> a -> 'U :> a +u_A = WithAttributes ul_ :: ('Ul ?> a) => a -> 'Ul > a ul_ = Child -ul_A :: ('Ul ?> a) => [(String, String)] -> a -> 'Ul :> a -ul_A xs = addAttributes xs . Child +ul_A :: ('Ul ?> a) => [Attribute] -> a -> 'Ul :> a +ul_A = WithAttributes var_ :: ('Var ?> a) => a -> 'Var > a var_ = Child -var_A :: ('Var ?> a) => [(String, String)] -> a -> 'Var :> a -var_A xs = addAttributes xs . Child +var_A :: ('Var ?> a) => [Attribute] -> a -> 'Var :> a +var_A = WithAttributes video_ :: ('Video ?> a) => a -> 'Video > a video_ = Child -video_A :: ('Video ?> a) => [(String, String)] -> a -> 'Video :> a -video_A xs = addAttributes xs . Child +video_A :: ('Video ?> a) => [Attribute] -> a -> 'Video :> a +video_A = WithAttributes wbr_ :: 'Wbr > () wbr_ = Child () -wbr_A :: [(String, String)] -> 'Wbr :> () -wbr_A xs = addAttributes xs $ Child () +wbr_A :: [Attribute] -> 'Wbr :> () +wbr_A = flip WithAttributes () xmp_ :: ('Xmp ?> a) => a -> 'Xmp > a xmp_ = Child -xmp_A :: ('Xmp ?> a) => [(String, String)] -> a -> 'Xmp :> a -xmp_A xs = addAttributes xs . Child +xmp_A :: ('Xmp ?> a) => [Attribute] -> a -> 'Xmp :> a +xmp_A = WithAttributes diff --git a/src/Html/Function.hs b/src/Html/Function.hs deleted file mode 100644 --- a/src/Html/Function.hs +++ /dev/null @@ -1,422 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} - -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE ConstraintKinds #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DataKinds #-} - -module Html.Function where - -import Html.Type - -import GHC.Exts -import GHC.TypeLits -import Data.Proxy -import Data.Monoid hiding (Last) - -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Builder as TLB - --- | Render a html document. The resulting type can be a String, --- strict Text, lazy Text, or Builder. For performance it is --- recommended to use a lazy Text or a Builder. --- --- >>> render "a" :: String --- "a" --- --- >>> render (div_ "a") :: Text --- "
a
" --- --- For prototyping, there's as well a Show instance: --- --- >>> i_ "a" --- a --- --- Please note the extra quotes for String when using show: --- --- >>> show "a" == render "a" --- False --- --- >>> show img_ == render img_ --- True - -{-# INLINE render #-} -render :: forall a b. - ( Document a - , Escape b - , Monoid b - , IsString b - ) => a -> b -render x = render_ (Tagged x :: Tagged (Symbols a) a ()) - - ------------------- - -- internal code -- - ------------------- - -type Document a = - ( Renderchunks (Tagged (Symbols a) a ()) - , Renderstring (Tagged (Symbols a) a ()) - , KnownSymbol (Last' (Symbols a)) - ) - -{-# RULES -"render_/renderB" render_ = renderB -"render_/renderS" render_ = renderS -"render_/renderLT" render_ = renderLT -#-} - -{-# INLINE [2] render_ #-} -render_ :: forall b prox val nex. - ( KnownSymbol (Last' prox) - , Renderstring (Tagged prox val nex) - , Renderchunks (Tagged prox val nex) - , Escape b - , Monoid b - , IsString b - ) => Tagged prox val nex -> b -render_ x = mconcat $ renderchunks x ++ [closing] - where closing = convert (Proxy :: Proxy (Last' prox)) - -{-# INLINE renderLT #-} -renderLT :: forall prox val nex. - ( KnownSymbol (Last' prox) - , Renderchunks (Tagged prox val nex) - ) => Tagged prox val nex -> LT.Text -renderLT x = mconcat $ renderchunks x ++ [closing] - where closing = convert (Proxy :: Proxy (Last' prox)) - -{-# INLINE renderS #-} -renderS :: forall prox val nex. - ( KnownSymbol (Last' prox) - , Renderchunks (Tagged prox val nex) - ) => Tagged prox val nex -> String -renderS x = foldr (<>) closing $ renderchunks x - where closing = convert (Proxy :: Proxy (Last' prox)) - -{-# INLINE renderB #-} -renderB :: forall prox val nex. - ( KnownSymbol (Last' prox) - , Renderstring (Tagged prox val nex) - ) => Tagged prox val nex -> TLB.Builder -renderB x = renderstring x <> closing - where closing = convert (Proxy :: Proxy (Last' prox)) - -{-# INLINE addAttributes #-} -addAttributes :: (a ?> b) => [(String, String)] -> (a > b) -> (a :> b) -addAttributes xs (Child b) = WithAttributes (Attributes xs) b - -class Renderchunks a where - renderchunks :: (Escape b, IsString b, Monoid b) => a -> [b] - -instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a) nex) where - {-# INLINE renderchunks #-} - renderchunks _ = [] - -instance {-# OVERLAPPABLE #-} - ( Convert val - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox val nex) where - {-# INLINE renderchunks #-} - renderchunks (Tagged x) - = convert (Proxy :: Proxy (HeadL prox)) - : [convert x] - -instance Renderchunks (Tagged prox () nex) where - {-# INLINE renderchunks #-} - renderchunks _ = [] - -instance - ( Renderchunks (Tagged (Take (CountContent a) prox) a b) - , Renderchunks (Tagged (Drop (CountContent a) prox) b nex) - ) => Renderchunks (Tagged prox (a # b) nex) where - {-# INLINE renderchunks #-} - renderchunks ~(Tagged (a :#: b)) - = renderchunks (Tagged a :: Tagged (Take (CountContent a) prox) a b) - <> renderchunks (Tagged b :: Tagged (Drop (CountContent a) prox) b nex) - -instance {-# OVERLAPPING #-} - ( Renderchunks (Tagged (Drop 1 prox) (a > b) nex) - , KnownSymbol (HeadL prox) - , a ?> b - ) => Renderchunks (Tagged prox (a :> b) nex) where - {-# INLINE renderchunks #-} - renderchunks ~(Tagged (WithAttributes a b)) - = convert (Proxy :: Proxy (HeadL prox)) - : convert a - : renderchunks (Tagged (Child b) :: Tagged (Drop 1 prox) (a > b) nex) - -instance - ( Renderchunks (Tagged prox b (Close a)) - ) => Renderchunks (Tagged prox (a > b) nex) where - {-# INLINE renderchunks #-} - renderchunks ~(Tagged (Child b)) - = renderchunks (Tagged b :: Tagged prox b (Close a)) - -instance - ( Renderchunks (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ()) - , KnownSymbol (Last' (Symbols (Next (a :> b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox [a :> b] nex) where - {-# INLINE renderchunks #-} - renderchunks (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - : concatMap - (\x -> renderchunks - (Tagged x :: Tagged (Symbols (Next (a :> b) nex)) (a :> b) ()) - ++ [closing] - ) xs - where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a :> b) nex)))) - -instance - ( Renderchunks (Tagged (Symbols (Next (a > b) nex)) (a > b) ()) - , KnownSymbol (Last' (Symbols (Next (a > b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox [a > b] nex) where - {-# INLINE renderchunks #-} - renderchunks (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - : concatMap - (\x -> renderchunks - (Tagged x :: Tagged (Symbols (Next (a > b) nex)) (a > b) ()) - ++ [closing] - ) xs - where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a > b) nex)))) - -instance - ( Renderchunks (Tagged (Symbols (Next (a # b) nex)) (a # b) ()) - , KnownSymbol (Last' (Symbols (Next (a # b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderchunks (Tagged prox [a # b] nex) where - {-# INLINE renderchunks #-} - renderchunks (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - : concatMap - (\x -> renderchunks - (Tagged x :: Tagged (Symbols (Next (a # b) nex)) (a # b) ()) - ++ [closing] - ) xs - where closing = convert (Proxy :: Proxy (Last' (Symbols (Next (a # b) nex)))) - -class Renderstring a where - renderstring :: (Escape b, IsString b, Monoid b) => a -> b - -instance KnownSymbol a => Renderstring (Tagged prox (Proxy a) nex) where - {-# INLINE renderstring #-} - renderstring _ = mempty - -instance {-# OVERLAPPABLE #-} - ( Convert val - , KnownSymbol (HeadL prox) - ) => Renderstring (Tagged prox val nex) where - {-# INLINE renderstring #-} - renderstring (Tagged x) - = convert (undefined :: Proxy (HeadL prox)) - <> convert x - -instance Renderstring (Tagged prox () nex) where - {-# INLINE renderstring #-} - renderstring _ = mempty - -instance - ( Renderstring (Tagged (Take (CountContent a) prox) a b) - , Renderstring (Tagged (Drop (CountContent a) prox) b nex) - ) => Renderstring (Tagged prox (a # b) nex) where - {-# INLINE renderstring #-} - renderstring ~(Tagged (a :#: b)) - = renderstring (Tagged a :: Tagged (Take (CountContent a) prox) a b) - <> renderstring (Tagged b :: Tagged (Drop (CountContent a) prox) b nex) - -instance {-# OVERLAPPING #-} - ( Renderstring (Tagged (Drop 1 prox) (a > b) nex) - , KnownSymbol (HeadL prox) - , a ?> b - ) => Renderstring (Tagged prox (a :> b) nex) where - {-# INLINE renderstring #-} - renderstring ~(Tagged (WithAttributes a b)) - = convert (Proxy :: Proxy (HeadL prox)) - <> convert a - <> renderstring (Tagged (Child b) :: Tagged (Drop 1 prox) (a > b) nex) - -instance - ( Renderstring (Tagged prox b (Close a)) - ) => Renderstring (Tagged prox (a > b) nex) where - {-# INLINE renderstring #-} - renderstring ~(Tagged (Child b)) - = renderstring (Tagged b :: Tagged prox b (Close a)) - -instance - ( Renderstring (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ()) - , Renderchunks (Tagged (Symbols (Next (a :> b) nex)) (a :> b) ()) - , KnownSymbol (Last' (Symbols (Next (a :> b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderstring (Tagged prox [a :> b] nex) where - {-# INLINE renderstring #-} - renderstring (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - <> foldMap - (\x -> - render_ - (Tagged x :: Tagged (Symbols (Next (a :> b) nex)) (a :> b) ()) - ) xs - -instance - ( Renderstring (Tagged (Symbols (Next (a > b) nex)) (a > b) ()) - , Renderchunks (Tagged (Symbols (Next (a > b) nex)) (a > b) ()) - , KnownSymbol (Last' (Symbols (Next (a > b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderstring (Tagged prox [a > b] nex) where - {-# INLINE renderstring #-} - renderstring (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - <> foldMap - (\x -> - render_ - (Tagged x :: Tagged (Symbols (Next (a > b) nex)) (a > b) ()) - ) xs - -instance - ( Renderstring (Tagged (Symbols (Next (a # b) nex)) (a # b) ()) - , Renderchunks (Tagged (Symbols (Next (a # b) nex)) (a # b) ()) - , KnownSymbol (Last' (Symbols (Next (a # b) nex))) - , KnownSymbol (HeadL prox) - ) => Renderstring (Tagged prox [a # b] nex) where - {-# INLINE renderstring #-} - renderstring (Tagged xs) - = convert (undefined :: Proxy (HeadL prox)) - <> foldMap - (\x -> - render_ - (Tagged x :: Tagged (Symbols (Next (a # b) nex)) (a # b) ()) - ) xs - -{-# RULES -"fromString_/builder" fromString_ = TLB.fromLazyText . LT.pack - #-} - -{-# INLINE [2] fromString_ #-} -fromString_ :: IsString a => String -> a -fromString_ = fromString - -{-# RULES -"convert/a/a" forall f. convert_ f = escape -"convert/string/builder" forall f. convert_ f = TLB.fromLazyText . escape . LT.pack -"convert/lazy text/builder" forall f. convert_ f = TLB.fromLazyText . escape -"convert/strict text/builder" forall f. convert_ f = TLB.fromText . escape -"convert/builder/lazy text" forall f. convert_ f = escape . TLB.toLazyText -"convert/lazy text/strict text" forall f. convert_ f = LT.toStrict . escape -"convert/strict text/lazy text" forall f. convert_ f = escape . LT.fromStrict - #-} - -{-# INLINE [1] convert_ #-} -convert_ :: (Escape b, IsString a, IsString b) => (a -> b) -> (a -> b) -convert_ f = escape . f - -class (IsString a, Monoid a) => Escape a where - escape :: a -> a - -instance Escape TLB.Builder where - - escape - = TLB.fromLazyText - . escape - . TLB.toLazyText - -instance Escape T.Text where - - escape = T.foldr f mempty - where - f '<' b = "<" <> b - f '>' b = ">" <> b - f '&' b = "&" <> b - f '"' b = """ <> b - f '\'' b = "'" <> b - f x b = T.singleton x <> b - -instance Escape LT.Text where - - escape = foldr (<>) "" . LT.foldr f [] - where - f '<' b = "<" : b - f '>' b = ">" : b - f '&' b = "&" : b - f '"' b = """ : b - f '\'' b = "'" : b - f x b = LT.singleton x : b - -instance Escape String where - - escape = concatMap f - where - f '<' = "<" - f '>' = ">" - f '&' = "&" - f '"' = """ - f '\'' = "'" - f x = [x] - --- | Convert something to a target stringlike thing. -class Convert a where - convert :: (Escape b, IsString b, Monoid b) => a -> b - -instance KnownSymbol a => Convert (Proxy a) where - {-# INLINE convert #-} - convert = fromString_ . symbolVal - -instance Convert a => Convert (Maybe a) where - {-# INLINE convert #-} - convert Nothing = "" - convert (Just x) = convert x - -instance Convert Attributes where - {-# INLINE convert #-} - convert ~(Attributes xs) = fromString $ concat [ ' ' : a ++ "=\"" ++ escape b ++ "\"" | (a,b) <- xs] - -instance Convert String where - {-# INLINE convert #-} - convert = convert_ fromString - -instance Convert T.Text where - {-# INLINE convert #-} - convert = convert_ (fromString . T.unpack) - -instance Convert LT.Text where - {-# INLINE convert #-} - convert = convert_ (fromString . LT.unpack) - -instance Convert TLB.Builder where - {-# INLINE convert #-} - convert = convert_ (fromString . LT.unpack . TLB.toLazyText) - -instance Convert Int where - {-# INLINE convert #-} - convert = fromString . show - -instance Convert Integer where - {-# INLINE convert #-} - convert = fromString . show - -instance Convert Float where - {-# INLINE convert #-} - convert = fromString . show - -instance Convert Double where - {-# INLINE convert #-} - convert = fromString . show - -instance Convert Word where - {-# INLINE convert #-} - convert = fromString . show - --- | Orphan show instances to faciliate ghci development. -instance Document (a # b) => Show (a # b) where show = render -instance {-# OVERLAPPING #-} Document [a # b] => Show [a # b] where show = render -instance Document (a > b) => Show (a > b) where show = render -instance {-# OVERLAPPING #-} Document [a > b] => Show [a > b] where show = render -instance Document (a :> b) => Show (a :> b) where show = render -instance {-# OVERLAPPING #-} Document [a :> b] => Show [a :> b] where show = render diff --git a/src/Html/Reify.hs b/src/Html/Reify.hs new file mode 100644 --- /dev/null +++ b/src/Html/Reify.hs @@ -0,0 +1,117 @@ +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +module Html.Reify where + +import Html.Type +import Html.Convert + +import GHC.TypeLits +import Data.Proxy +import Data.Semigroup +import Data.String + +import qualified Data.Text.Lazy as T +import qualified Data.ByteString.Lazy as B + +{-# INLINE render #-} +render :: forall a b. Document a b => a -> b +render x = mconcat $ renderchunks (Tagged x :: Tagged (Symbols a) a ()) + <> [unConv (conv (Proxy @ (Last' (Symbols a))))] + +-- | Render a html document to a String. +{-# INLINE renderString #-} +renderString :: Document a String => a -> String +renderString = render + +-- | Render a html document to a lazy Text. +{-# INLINE renderText #-} +renderText :: Document a T.Text => a -> T.Text +renderText = render + +-- | Render a html document to a lazy ByteString. +{-# INLINE renderByteString #-} +renderByteString :: Document a B.ByteString => a -> B.ByteString +renderByteString = render + +type Document a b = + ( Renderchunks (Tagged (Symbols a) a ()) b + , KnownSymbol (Last' (Symbols a)) + , Conv b + , Monoid b + ) + +class Renderchunks a b where + renderchunks :: a -> [b] + +instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a) nex) b where + {-# INLINE renderchunks #-} + renderchunks _ = mempty +instance Renderchunks (Tagged prox () nex) b where + {-# INLINE renderchunks #-} + renderchunks _ = mempty + +instance {-# OVERLAPPABLE #-} + ( Convert val + , Conv u + , KnownSymbol (HeadL prox) + ) => Renderchunks (Tagged prox val nex) u where + {-# INLINE renderchunks #-} + renderchunks (Tagged x) + = unConv (conv (Proxy @ (HeadL prox))) + : [unConv (conv x)] + +instance + ( t ~ Tagged prox b (Close a) + , Renderchunks t u + ) => Renderchunks (Tagged prox (a > b) nex) u where + {-# INLINE renderchunks #-} + renderchunks (Tagged ~(Child b)) = renderchunks (Tagged b :: t) + +instance + ( t ~ Tagged (Drop 1 prox) b (Close a) + , Renderchunks t u + , Conv u + , Monoid u + , IsString u + , KnownSymbol (HeadL prox) + ) => Renderchunks (Tagged prox (a :> b) nex) u where + {-# INLINE renderchunks #-} + renderchunks (Tagged (WithAttributes xs b)) + = unConv (conv (Proxy @ (HeadL prox))) + : foldMap (unConv . conv . Raw . (\(Attribute x) -> x)) xs + : renderchunks (Tagged b :: t) + +instance + ( t1 ~ Tagged (Take (CountContent a) prox) a b + , t2 ~ Tagged (Drop (CountContent a) prox) b nex + , Renderchunks t1 u + , Renderchunks t2 u + , Monoid u + ) => Renderchunks (Tagged prox (a # b) nex) u where + {-# INLINE renderchunks #-} + renderchunks (Tagged ~(a :#: b)) + = mconcat (renderchunks (Tagged a :: t1)) : renderchunks (Tagged b :: t2) + +instance + ( t1 ~ Tagged t2 (a `f` b) () + , t2 ~ Symbols (Next (a `f` b) nex) + , Renderchunks t1 u + , Conv u + , KnownSymbol (Last' t2) + , KnownSymbol (HeadL prox) + ) => Renderchunks (Tagged prox [a `f` b] nex) u where + {-# INLINE renderchunks #-} + renderchunks (Tagged xs) + = unConv (conv (Proxy @ (HeadL prox))) + : Prelude.concatMap (\x -> renderchunks (Tagged x :: t1) <> [closing]) xs + where closing = unConv (conv (Proxy @ (Last' t2))) diff --git a/src/Html/Type.hs b/src/Html/Type.hs --- a/src/Html/Type.hs +++ b/src/Html/Type.hs @@ -8,6 +8,8 @@ module Html.Type where +import qualified Data.Text.Lazy as T + import GHC.TypeLits import GHC.Exts import Data.Proxy @@ -227,6 +229,7 @@ -- >>> render (i_ () # div_ ()) :: String -- "
" data (#) a b = (:#:) a b +{-# INLINE (#) #-} (#) :: a -> b -> a # b (#) = (:#:) infixr 5 # @@ -245,16 +248,23 @@ -- | Decorate an element with attributes and descend to a valid child. -- --- >>> WithAttributes [("foo","bar")] "a" :: 'Div :> String ---
a
+-- >>> WithAttributes [A.class_ "bar"] "a" :: 'Div :> String +--
a
data (:>) (a :: Element) b where - WithAttributes :: (a ?> b) => Attributes -> b -> a :> b + WithAttributes :: (a ?> b) => [Attribute] -> b -> a :> b infixr 8 :> +-- | Wrapper for types which won't be escaped. +newtype Raw a = Raw a + +newtype Converted a = Converted {unConv :: a} + ------------------- -- internal code -- ------------------- +newtype Attribute = Attribute T.Text + type family ShowElement e where ShowElement DOCTYPE = "!DOCTYPE html" ShowElement A = "a" @@ -422,9 +432,9 @@ ToTypeList (Next val nex) = Next (ToTypeList val) (ToTypeList nex) ToTypeList (a # b) = Append (ToTypeList a) (ToTypeList b) ToTypeList (a > ()) = If (HasContent (GetInfo a)) (Open a, Close a) (Open a) - ToTypeList (a :> ()) = If (HasContent (GetInfo a)) (OpenAttr a, (Attributes, (EndOfOpen, Close a))) (OpenAttr a, (Attributes, EndOfOpen)) + ToTypeList (a :> ()) = If (HasContent (GetInfo a)) (OpenAttr a, (Attribute, (EndOfOpen, Close a))) (OpenAttr a, (Attribute, EndOfOpen)) ToTypeList (a > b) = Append (Open a, ToTypeList b) (Close a) - ToTypeList (a :> b) = Append (OpenAttr a, (Attributes, (EndOfOpen, ToTypeList b))) (Close a) + ToTypeList (a :> b) = Append (OpenAttr a, (Attribute, (EndOfOpen, ToTypeList b))) (Close a) ToTypeList x = x -- | Append two type lists. @@ -562,7 +572,6 @@ data Open (a :: Element) data OpenAttr (a :: Element) data Close (a :: Element) -newtype Attributes = Attributes [(String, String)] -- | Type of type level information about tags. data ElementInfo @@ -918,7 +927,7 @@ GetInfo Li = ElementInfo '[] FlowContent - (LastChildOrFollowedBy '[Li]) -- if followed by li or no more content + (LastChildOrFollowedBy '[Li]) GetInfo Link = ElementInfo [ MetadataContent, FlowContent, PhrasingContent ] diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,53 +1,54 @@ -{-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-} module Main where import Html -import Test.Hspec +import qualified Html.Attribute as A import Data.Proxy +import Test.Hspec +import Test.QuickCheck -import qualified Data.Text as T -import qualified Data.Text.Lazy as LT -import qualified Data.Text.Lazy.Builder as LT +import Data.Text.Lazy.Encoding +import qualified Data.Text.Lazy as T + +newtype Escaped = Escaped String deriving Show + +instance Arbitrary Escaped where + arbitrary = Escaped <$> arbitrary `suchThat` (\x -> all (`notElem` x) "<>&\"'") + main :: IO () main = hspec spec spec :: Spec -spec = let {-# INLINE allT #-} - allT a b c = b (render a, render a, render a , render a ) - (c , T.pack c, LT.pack c, LT.fromString c) +spec = let allT a b c = b (renderString a, T.unpack $ renderText a, T.unpack . decodeUtf8 $ renderByteString a) + (c, c, c) in parallel $ do describe "render" $ do - it "is id on empty string" $ do + it "is id on strings without escaping chars" $ do - allT "" - shouldBe - "" + property $ \(Escaped x) -> allT x (==) x it "handles single elements" $ do - allT (div_ "a") - shouldBe - "
a
" + property $ \(Escaped x) -> allT (div_ x) (==) ("
" ++ x ++ "
") it "handles nested elements" $ do - allT (div_ (div_ "a")) - shouldBe - "
a
" + property $ \(Escaped x) -> allT (div_ (div_ x)) (==) + ("
" ++ x ++ "
") it "handles parallel elements" $ do - allT (div_ "a" # div_ "b") - shouldBe - "
a
b
" + property $ \(Escaped x) (Escaped y) -> allT (div_ x # div_ y) + (==) + ("
" ++ x ++ "
" ++ y ++ "
") it "doesn't use closing tags for empty elements" $ do @@ -130,9 +131,9 @@ it "handles trailing text" $ do - allT (td_ "a" # "b") - shouldBe - "ab" + property $ \(Escaped x) (Escaped y) -> allT (td_ x # y) + (==) + ("" ++ x ++ "" ++ y) it "handles a single compile time text" $ do @@ -210,24 +211,78 @@ shouldBe "abc" - it "computes its result lazily" $ do + it "handles utf8 correctly" $ do - take 5 (render (div_ (errorWithoutStackTrace "not lazy" :: String))) + allT (div_ "a ä € 𝄞") + shouldBe + "
a ä € 𝄞
" + + allT (img_A [A.id_ "a ä € 𝄞"]) + shouldBe + "" + + it "computes its result lazily (String)" $ do + + renderString (errorWithoutStackTrace "not lazy" :: 'Img > ()) `shouldBe` + "" + + take 5 (renderString (div_ (errorWithoutStackTrace "not lazy" :: String))) + `shouldBe` "
" - take 5 (render (errorWithoutStackTrace "not lazy" :: 'Img > ())) + take 5 (renderString (errorWithoutStackTrace "not lazy" :: 'Div > String)) `shouldBe` + "
" + + take 12 (renderString (div_ "a" # (errorWithoutStackTrace "not lazy" :: String))) + `shouldBe` + "
a
" + + take 17 (renderString (div_ "a" # [img_ # (errorWithoutStackTrace "not lazy" :: String)])) + `shouldBe` + "
a
" + + it "computes its result lazily (Text)" $ do + + T.unpack (renderText (errorWithoutStackTrace "not lazy" :: 'Img > ())) + `shouldBe` "" - take 5 (render (errorWithoutStackTrace "not lazy" :: 'Div > String)) + take 5 (T.unpack (renderText (div_ (errorWithoutStackTrace "not lazy" :: String)))) `shouldBe` "
" - take 12 (render (div_ "a" # (errorWithoutStackTrace "not lazy" :: String))) + take 5 (T.unpack (renderText (errorWithoutStackTrace "not lazy" :: 'Div > String))) `shouldBe` + "
" + + take 12 (T.unpack (renderText (div_ "a" # (errorWithoutStackTrace "not lazy" :: String)))) + `shouldBe` "
a
" - take 17 (render (div_ "a" # [img_ # (errorWithoutStackTrace "not lazy" :: String)])) + take 17 (T.unpack (renderText (div_ "a" # [img_ # (errorWithoutStackTrace "not lazy" :: String)]))) + `shouldBe` + "
a
" + + it "computes its result lazily (ByteString)" $ do + + T.unpack (decodeUtf8 (renderByteString (errorWithoutStackTrace "not lazy" :: 'Img > ()))) + `shouldBe` + "" + + take 5 (T.unpack (decodeUtf8 (renderByteString (div_ (errorWithoutStackTrace "not lazy" :: String))))) + `shouldBe` + "
" + + take 5 (T.unpack (decodeUtf8 (renderByteString (errorWithoutStackTrace "not lazy" :: 'Div > String)))) + `shouldBe` + "
" + + take 12 (T.unpack (decodeUtf8 (renderByteString (div_ "a" # (errorWithoutStackTrace "not lazy" :: String))))) + `shouldBe` + "
a
" + + take 17 (T.unpack (decodeUtf8 (renderByteString (div_ "a" # [img_ # (errorWithoutStackTrace "not lazy" :: String)])))) `shouldBe` "
a
" diff --git a/type-of-html.cabal b/type-of-html.cabal --- a/type-of-html.cabal +++ b/type-of-html.cabal @@ -1,5 +1,5 @@ name: type-of-html -version: 0.2.1.1 +version: 0.3.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 @@ -20,23 +20,27 @@ library exposed-modules: Html + , Html.Attribute other-modules: Html.Type , Html.Element - , Html.Function + , Html.Reify + , Html.Convert hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall build-depends: base >= 4.10 && < 4.11 , text + , bytestring test-suite test type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: test - ghc-options: -Wall -threaded -O2 -rtsopts -with-rtsopts=-N + ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4.10 && < 4.11 , type-of-html + , QuickCheck , hspec , text @@ -44,7 +48,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench - ghc-options: -Wall -O2 + ghc-options: -Wall default-language: Haskell2010 build-depends: base >= 4.10 && < 4.11 , type-of-html