diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Revision history for type-of-html +## 1.6.0.0 -- 2020-11-06 + +* major overhaul +* encode more info at the type level +* use constructors of Element and Attribute directly +* reduce amount of value level functions + ## 1.5.2.0 -- 2020-10-10 * make error messages nicer diff --git a/Readme.md b/Readme.md --- a/Readme.md +++ b/Readme.md @@ -16,34 +16,35 @@ Let's check out the /type safety/ in ghci: ```haskell ->>> td_ (tr_ "a") +>>> Td :> Tr :> "a" :1:1: error: - • is not a valid child of - • In the expression: td_ (tr_ "a") - In an equation for ‘it’: it = td_ (tr_ "a") + • 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: - • 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") +:1:7: error: + • Char is not a valid child of tr. + • In the second argument of ‘(:>)’, namely ‘Tr :> "a"’ + In the expression: Td :> Tr :> "a" + In an equation for ‘it’: it = Td :> Tr :> "a" ->>> tr_ (td_ "a") +>>> Tr :> Td :> "a" a ``` And ```haskell ->>> td_A (A.coords_ "a") "b" +>>> Td :@ CoordsA := "a" :> "b" :1:1: error: - • coords is not a valid attribute of - • In the expression: td_A (A.coords_ "a") "b" - In an equation for ‘it’: it = td_A (A.coords_ "a") "b" + • coords is not a valid attribute of td. + • In the first argument of ‘(:>)’, namely ‘Td :@ CoordsA := "a"’ + In the expression: Td :@ CoordsA := "a" :> "b" + In an equation for ‘it’: it = Td :@ CoordsA := "a" :> "b" ->>> td_A (A.id_ "a") "b" +>>> Td :@ IdA := "a" :> "b" b ``` @@ -66,62 +67,49 @@ Html documents are just ordinary haskell values which can be composed or abstracted over: ```haskell ->>> let table = table_ . map (tr_ . map td_) ->>> :t table -table :: ('Td ?> a) => [[a]] -> 'Table > ['Tr > ['Td > a]] +>>> let table xxs = Table :> map (\xs -> Tr :> map (\x -> Td :> x) xs) xxs + >>> table [["A","B"],["C"]]
AB
C
>>> import Data.Char ->>> html_ . body_ . table $ map (\c -> [[c], show $ ord c]) ['a'..'d'] +>>> Html :> Body :> table (map (\c -> [[c], show $ ord c]) ['a'..'d'])
a97
b98
c99
d100
``` And here's an example module: ```haskell -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DataKinds #-} - module Main where import Html -import qualified Html.Attribute as A - main :: IO () main = print . page - $ map td_ [1..(10::Int)] - -page - :: 'Tr ?> a - => a - -> ('Div :@: ('ClassA := String # 'IdA := String)) - ( 'Div > String - # 'Div > String - # 'Table > 'Tr > a - ) -page tds = - div_A (A.class_ "qux" # A.id_ "baz") - ( div_ "foo" - # div_ "bar" - # table_ (tr_ tds) - ) + $ map (Td :>) [1..(10::Int)] + where page tds = + Div :@ (ClassA:="qux" # IdA:="baz") + :> ( Div :> "foo" + # Div :> "bar" + # Table :> Tr :> tds + ) ``` -Please note that the type of `page` is inferable, so ask ghc-mod or -whatever you use to write it for you. If you choose not to write the -types, you don't need the language extensions. I strongly suggest -that you don't write type signatures for `type-of-html`. +Please note that the type of `page` is inferable and quite +complicated. I strongly suggest that you don't write type signatures +for `type-of-html`. Define your `type-of-html` related functions in an +extra module in which you deactivate missing to signature +warnings. For smaller tasks you can easily define your page in a where +clause like above. All text will be automatically html escaped: ```haskell ->>> i_ "&" +>>> I :> "&" & ->>> div_A (A.id_ ">") () +>>> Div :@ IdA:=">" :> ()
``` @@ -131,7 +119,7 @@ into type-of-html. ```haskell ->>> i_ (Raw "") +>>> I :> Raw "" ``` @@ -140,16 +128,16 @@ You can use Either and Maybe in your documents: ```haskell ->>> div_ (Just (div_ "a")) +>>> Div :> Just (Div :> "a")
a
->>> div_ (if True then Nothing else Just (div_ "b")) +>>> Div :> if True then Nothing else Just (Div :> "b")
->>> div_ (if True then Left (div_ "a") else Right "b") +>>> Div :> if True then Left (Div :> "a") else Right "b"
a
->>> div_A (if True then Right (A.id_ "a") else Left (A.class_ "a")) "b" +>>> Div :@ (if True then Right (IdA:="a") else Left (ClassA:="a")) :> "b"
b
``` @@ -191,7 +179,7 @@ For example, if you write: ```haskell -renderText $ tr_ (td_ "test") +renderText $ Tr :> Td :> "test" ``` The compiler does optimize it to the following (well, unpackCString# @@ -211,7 +199,7 @@ allocated bytestring. ```haskell -renderByteString $ tr_ (td_ "teſt") +renderByteString $ Tr :> Td :> "teſt" ``` Results in @@ -227,7 +215,7 @@ If you write ```haskell -renderBuilder $ div_ (div_ ()) +renderBuilder $ Div :> Div ``` The compiler does optimize it to the following: @@ -256,7 +244,7 @@ know the length at compile time. ```haskell -div_ 'a' +Div :> 'a' ``` If you know for sure that you don't need escaping, use `Raw`. @@ -265,7 +253,7 @@ don't need to escape. ```haskell -div_ (Raw "abc") +Div :> Raw "abc" ``` If you've got numeric attributes or contents, don't convert it to a @@ -275,16 +263,16 @@ don't need to escape and don't need to handle utf8. ```haskell -div_ (42 :: Int) +Div :> (42 :: Int) ``` -If you know that an attribute or content is empty, use `()`. +If you know that an attribute or child is empty, use `()` or omit it altogether. This allows for more compile time appending and avoids two runtime appends. ```haskell -div_ () +Div :> () ``` If you know for sure a string at compile time which doesn't need @@ -294,7 +282,7 @@ appends, escaping and conversion to a builder. ```haskell -div_ (Proxy @"hello") +Div :> (Proxy @"hello") ``` These techniques can have dramatic performance implications, @@ -322,11 +310,14 @@ import Html -test x y = div_ "Hello, my name is: " # x # "I'm of age: " # y +test x y = Div :> ("Hello, my name is: " # x) + # Div :> ("I'm of age: " # y) +-- It is important that your CompactHTML is a top-level value. myDoc :: CompactHTML ["name", "age"] -myDoc = compactHTML (test (V @"name") (V @"age")) +myDoc = compactHTML $ test (V @"name") (V @"age") +main :: IO () main = putStrLn $ renderCompactString myDoc (Put "Bob") (Put (42 :: Int)) ``` @@ -363,38 +354,36 @@ main :: IO () main = TL.putStrLn $ renderText example -example = - html_ - ( body_ - ( h1_ - ( img_ - # strong_ "foo" - ) - # div_ - ( div_ "bar" - ) - # div_ - ( form_ - ( fieldset_ - ( div_ - ( div_ - ( label_ "zot" - # select_ - ( option_ 'b' - # option_ 'c' - ) - # map div_ [1..5 :: Int] - ) +example + = Html + :> ( Body + :> ( H1 + :> ( Img + # Strong :> "foo" + ) + # Div :> Div :> "bar" + # Div + :> ( Form + :> ( Fieldset + :> ( Div + :> ( Div + :> ( Label :> "zot" + # Select + :> ( Option :> 'b' + # Option :> 'c' + ) + # map (Div :>) [1..5 :: Int] + ) + ) + # Button :> I + ) ) - # button_ (i_ ()) - ) - ) + ) ) - ) - ) + ) ``` -## Custom Attributes +## Custom Attributes and Elements You can define your own attributes, for example data-* or htmx. These custom attributes reside as well 100% at the type level and don't @@ -402,24 +391,41 @@ valid attribute name. ```haskell -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} module Main where import Html -import qualified Html.Attribute as A -dataName_ :: a -> 'CustomA "data-name" := a -dataName_ = A.custom_ +dataName :: Attribute + "data-name" -- name for rendering + 'True -- global attribute + 'False -- not a boolean attribute +dataName = CustomA main :: IO () -main = print $ div_A (dataName_ "foo") "bar" +main = print $ Div :@ dataName:="foo" :> "bar" ``` -I'd recommend that you put all your custom attributes in one module -which reexports Html.Attribute, so you can just qualified import your -module and have an uniform naming scheme. +And you can define your custom elements: + +```haskell +{-# LANGUAGE DataKinds #-} + +module Main where + +import Html + +banana :: Element + "banana" -- name for rendering + '[Flow, Phrasing] -- content categories + Flow -- content model + '["async", "for"] -- allowed attributes besides global attributes +banana = CustomElement + +main :: IO () +main = print $ banana :@ AsyncA:="foo" :> "bar" +``` ## FAQ diff --git a/bench/Alloc.hs b/bench/Alloc.hs --- a/bench/Alloc.hs +++ b/bench/Alloc.hs @@ -1,111 +1,71 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE UndecidableInstances #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE CPP #-} +{-# LANGUAGE NoMonomorphismRestriction #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE CPP #-} -- | Note that the allocation numbers are only reproducible on linux using the nix shell. module Main where import Html -import qualified Html.Attribute as A + import qualified Small as S import qualified Medium as M import qualified Big as B import Weigh import Data.Proxy -import Data.Int -import GHC -import GHC.Paths (libdir) -import GHC.TypeNats -import DynFlags -import Control.Monad - -allocs :: Int64 -> Weight -> Maybe String -allocs n w - | n' > n = Just $ "More" ++ answer - | n' < n = Just $ "Less" ++ answer - | otherwise = Nothing - where n' = weightAllocatedBytes w - answer = " allocated bytes than expected: " ++ show (abs $ n' - n) - -allocsError :: (Show a, Integral a) => a -> a -> a -> Weight -> Maybe String -allocsError i m n w - | n' > (m'+1) = Just $ "More" ++ answer - | n' < (m'-1) = Just $ "Less" ++ answer - | otherwise = Nothing - where n' = round (fromIntegral (weightAllocatedBytes w) / (10^i) :: Rational) - m' = n + m - answer = " allocated bytes than expected: " ++ pretty (abs $ m' - n') - pretty x = show x ++ " e" ++ show i - -f :: Document b => String -> (a -> b) -> a -> Int64 -> Weigh () -f s g x n = validateFunc s (renderByteString . g) x (allocs n) - main :: IO () main = mainWith $ do - let ghc = allocFold :: GhcVersions [802, 804, 806, 808] + f "()" id () [ 144 , -16 , 16 , 0 , 0 ] + f "Int" id (123456789 :: Int) [ 192 , 0 , 0 , 0 , 0 ] + f "Word" id (123456789 :: Word) [ 192 , 0 , 0 , 0 , 0 ] + f "Char" id 'a' [ 192 , 0 , 0 , 0 , 0 ] + f "Integer" id (123456789 :: Integer) [ 248 , 0 , 0 , 0 , 0 ] + f "Proxy" id (Proxy :: Proxy "a") [ 280 , -16 , 16 , 0 , 0 ] + f "oneElement Proxy" S.oneElement (Proxy :: Proxy "b") [ 280 , -16 , 16 , 0 , 0 ] + f "oneElement ()" S.oneElement () [ 280 , -16 , 16 , 0 , 0 ] + f "oneAttribute ()" (ClassA :=) () [ 280 , -16 , 16 , 0 , 0 ] + f "oneAttribute Proxy" (ClassA :=) (Proxy :: Proxy "c") [ 280 , -16 , 16 , 0 , 0 ] + f "listElement" S.listElement () [ 608 , 0 , 0 , 0 , 0 ] + f "Double" id (123456789 :: Double) [ 360 , 0 , 0 , 0 , -32 ] + f "oneElement" S.oneElement "" [ 368 , 0 , 0 , 0 , 0 ] + f "nestedElement" S.nestedElement "" [ 368 , 0 , 0 , 0 , 0 ] + f "listOfAttributes" (\x -> [ClassA := x, ClassA := x]) () [ 744 , 0 , 0 , 0 , 0 ] + f "Float" id (123456789 :: Float) [ 400 , 0 , 0 , 0 , -72 ] + f "oneAttribute" (ClassA :=) "" [ 480 , 0 , 0 , 0 , 0 ] + f "parallelElement" S.parallelElement "" [ 520 , 0 , 0 , -16 , 0 ] + f "parallelAttribute" (\x -> ClassA := x # IdA := x) "" [ 672 , 0 , 0 , -16 , 0 ] + f "elementWithAttribute" (\x -> Div :@ (ClassA := x) :> x) "" [ 656 , 0 , 0 , 0 , 0 ] + f "listOfListOf" (\x -> Div :> [I :> [Span :> x]]) () [ 1200 , 0 , 64 , 0 , 0 ] + f "helloWorld" M.helloWorld () [ 1232 , -16 , 16 , 0 , 0 ] + f "page" M.page () [ 1416 , -16 , -144 , 0 , 0 ] + f "table" M.table (2,2) [ 2680 , 0 , 0 , -96 , 64 ] + f "AttrShort" M.attrShort () [ 2680 , -16 , 856 , 0 , 0 ] + f "pageA" M.pageA () [ 4208 , -8 , -192 , -304 , 232 ] + f "AttrLong" M.attrLong () [ 2680 , -16 , 856 , 0 , 0 ] + f "Big table" M.table (15,15) [ 54080 , 0 , 0 , -3736 , 3576 ] + f "Big page" B.page () [ 27920 , -1040 , 0 , -1336 , 592 ] - f "()" id () $ ghc 128 0 0 0 - f "Int" id (123456789 :: Int) $ ghc 192 0 0 0 - f "Word" id (123456789 :: Word) $ ghc 192 0 0 0 - f "Char" id 'a' $ ghc 192 0 0 0 - f "Integer" id (123456789 :: Integer) $ ghc 248 0 0 0 - f "Proxy" id (Proxy :: Proxy "a") $ ghc 208 0 0 0 - f "oneElement Proxy" S.oneElement (Proxy :: Proxy "b") $ ghc 208 0 0 0 - f "oneElement ()" S.oneElement () $ ghc 208 0 0 0 - f "oneAttribute ()" A.class_ () $ ghc 208 0 0 0 - f "oneAttribute Proxy" A.class_ (Proxy :: Proxy "c") $ ghc 208 0 0 0 - f "listElement" S.listElement () $ ghc 608 0 0 0 - f "Double" id (123456789 :: Double) $ ghc 360 0 0 0 - f "oneElement" S.oneElement "" $ ghc 368 0 0 0 - f "nestedElement" S.nestedElement "" $ ghc 368 0 0 0 - f "listOfAttributes" (\x -> [A.class_ x, A.class_ x]) () $ ghc 712 0 0 0 - f "Float" id (123456789 :: Float) $ ghc 400 0 0 0 - f "oneAttribute" A.class_ "" $ ghc 520 0 0 0 - f "parallelElement" S.parallelElement "" $ ghc 520 0 0 (-16) - f "parallelAttribute" (\x -> A.class_ x # A.id_ x) "" $ ghc 736 0 0 0 - f "elementWithAttribute" (\x -> div_A (A.class_ x) x) "" $ ghc 696 0 0 0 - f "listOfListOf" (\x -> div_ [i_ [span_ x]]) () $ ghc 1200 0 64 0 - f "helloWorld" M.helloWorld () $ ghc 920 168 0 0 - f "page" M.page () $ ghc 1400 0 720 0 - f "table" M.table (2,2) $ ghc 2640 0 8 (-96) - f "AttrShort" M.attrShort () $ ghc 2688 0 2104 0 - f "pageA" M.pageA () $ ghc 4552 (-96) (-96) (-288) - f "AttrLong" M.attrLong () $ ghc 2688 0 2104 0 - f "Big table" M.table (15,15) $ ghc 54040 0 8 (-3736) - f "Big page" B.page () $ ghc 27888 (-120) 0 (-1344) + where versions = [ 802 , 804 , 806 , 808 , 810 ] -type family GhcVersions xs where - GhcVersions '[] = Int64 - GhcVersions (x ': xs) = GHC x -> GhcVersions xs + ghc = fromInteger . sum . take (length $ takeWhile (<= (__GLASGOW_HASKELL__ :: Int)) versions) -newtype GHC (k :: Nat) = GHC Int64 deriving Num + f s g x n = validateFunc s (renderByteString . g) x (allocs $ ghc n) -class AllocFold a where - allocFold :: a + allocs n w + | n' > n = Just $ "More" ++ answer (n' - n) + | n' < n = Just $ "Less" ++ answer (n - n') + | otherwise = Nothing + where n' = weightAllocatedBytes w + answer x = " allocated bytes than expected: " ++ show x -instance AllocFold (GHC k -> Int64) where - allocFold (GHC i) = i -instance AllocFold (GHC m -> a) => AllocFold (GHC l -> GHC m -> a) where - allocFold (GHC i1) i2 = allocFold (GHC i1 + i2) -instance {-# OVERLAPPING #-} AllocFold (GHC __GLASGOW_HASKELL__ -> a) => AllocFold (GHC __GLASGOW_HASKELL__ -> GHC m -> a) where - allocFold i1 _ = allocFold i1 - -compile :: String -> String -> IO () -compile out m = - void . defaultErrorHandler defaultFatalMessager defaultFlushOut . runGhc (Just libdir) $ do - dflags <- getSessionDynFlags - void $ setSessionDynFlags (dflags {optLevel = 2, importPaths = ["src", "bench"], hiDir = Just out, objectDir = Just out, outputFile = Just (out ++ "/out")}) - target <- guessTarget m Nothing - setTargets [target] - load LoadAllTargets diff --git a/bench/Big.hs b/bench/Big.hs --- a/bench/Big.hs +++ b/bench/Big.hs @@ -7,90 +7,88 @@ import Html import Medium (attrShort, attrLong, table) -import qualified Html.Attribute as A - page x = - html_ - ( body_ - ( h1_A (A.id_ "a") - ( img_ - # strong_A (A.class_ "b") (0 :: Int) + Html :> + ( Body :> + ( H1 :@ (IdA := "a") :> + ( Img + # Strong :@ (ClassA := "b") :> (0 :: Int) ) - # div_ - ( div_A (A.id_ "c") (1 :: Int) + # Div :> + ( Div :@ (IdA := "c") :> (1 :: Int) ) # attrShort "" # attrLong "" # table (3,3) - # div_ - ( form_A (A.class_ "d") - ( fieldset_ - ( div_A (A.id_ "e") - ( div_ - ( label_A (A.class_ "f") "g" - # select_ - ( option_A (A.id_ "h") "i" - # option_ "j" + # Div :> + ( Form :@ (ClassA := "d") :> + ( Fieldset :> + ( Div :@ (IdA := "e") :> + ( Div :> + ( Label :@ (ClassA := "f") :> "g" + # Select :> + ( Option :@ (IdA := "h") :> "i" + # Option :> "j" ) - # div_A (A.class_ "k") "l" + # Div :@ (ClassA := "k") :> "l" ) - # i_ x + # I :> x ) - # button_A (A.id_ "m") (i_ "n") + # Button :@ (IdA := "m") :> (I :> "n") ) ) ) - # div_ - ( form_A (A.class_ "o") - ( fieldset_ - ( div_A (A.id_ "p") - ( div_ - ( label_A (A.class_ "q") "r" - # select_ - ( option_A (A.id_ "s") "4" - # option_ "u" + # Div :> + ( Form :@ (ClassA := "o") :> + ( Fieldset :> + ( Div :@ (IdA := "p") :> + ( Div :> + ( Label :@ (ClassA := "q") :> "r" + # Select :> + ( Option :@ (IdA := "s") :> "4" + # Option :> "u" ) - # div_A (A.class_ "v") "w" + # Div :@ (ClassA := "v") :> "w" ) - # i_ x + # I :> x ) - # button_A (A.id_ "x") (i_ "y") + # Button :@ (IdA := "x") :> (I :> "y") ) ) ) - # div_ - ( form_A (A.class_ "z") - ( fieldset_ - ( div_A (A.id_ "A") - ( div_ - ( label_A (A.class_ "B") "C" - # select_ - ( option_A (A.id_ "D") "E" - # option_ "F" + # Div :> + ( Form :@ (ClassA := "z") :> + ( Fieldset :> + ( Div :@ (IdA := "A") :> + ( Div :> + ( Label :@ (ClassA := "B") :> "C" + # Select :> + ( Option :@ (IdA := "D") :> "E" + # Option :> "F" ) - # div_A (A.class_ "G") "H" + # Div :@ (ClassA := "G") :> "H" ) - # i_ x + # I :> x ) - # button_A (A.id_ "I") (i_ "J") + # Button :@ (IdA := "I") :> (I :> "J") ) ) ) - # div_ - ( form_A (A.class_ "K") - ( fieldset_ - ( div_A (A.id_ "L") - ( div_ - ( label_A (A.class_ "M") "N" - # select_ - ( option_A (A.id_ "O") "P" - # option_ "Q" + # Div :> + ( Form :@ (ClassA := "K") :> + ( Fieldset :> + ( Div :@ (IdA := "L") :> + ( Div :> + ( Label :@ (ClassA := "M") :> "N" + # Select :> + ( Option :@ (IdA := "O") :> "P" + # Option :> "Q" ) - # div_A (A.class_ "R") "S" + # Div :@ (ClassA := "R") :> "S" ) - # i_ x + # I :> x ) - # button_A (A.id_ "T") (i_ "U") + # Button :@ (IdA := "T") :> (I :> "U") ) ) ) diff --git a/bench/Medium.hs b/bench/Medium.hs --- a/bench/Medium.hs +++ b/bench/Medium.hs @@ -5,45 +5,44 @@ module Medium where import Html -import qualified Html.Attribute as A helloWorld x = - html_ - ( head_ - ( title_ x + Html :> + ( Head :> + ( Title :> x ) - # body_ - ( p_ "Hello World!" + # Body :> + ( P :> "Hello World!" ) ) -table (n, m) = table_ . replicate n . tr_ $ map td_ [(1::Int)..m] +table (n, m) = (Table :>) . replicate n . (Tr :>) $ map (Td :>) [(1::Int)..m] page x = - html_ - ( body_ - ( h1_ - ( img_ - # strong_ (0 :: Int) + Html :> + ( Body :> + ( H1 :> + ( Img + # Strong :> (0 :: Int) ) - # div_ - ( div_ (1 :: Int) + # Div :> + ( Div :> (1 :: Int) ) - # div_ - ( form_ - ( fieldset_ - ( div_ - ( div_ - ( label_ "a" - # select_ - ( option_ "b" - # option_ "c" + # Div :> + ( Form :> + ( Fieldset :> + ( Div :> + ( Div :> + ( Label :> "a" + # Select :> + ( Option :> "b" + # Option :> "c" ) - # div_ "d" + # Div :> "d" ) - # i_ x + # I :> x ) - # button_ (i_ "e") + # Button :> (I :> "e") ) ) ) @@ -51,61 +50,61 @@ ) attrShort x = - i_A (A.accesskey_ "a") - ( i_A (A.class_ "b") - ( i_A (A.contenteditable_ "c") - ( i_A (A.contextmenu_ "d") - ( i_A (A.dir_ "e") - ( i_A (A.draggable_ "f") - ( i_A A.hidden_ - ( i_A (A.id_ "h") - ( i_A (A.itemprop_ "i") - ( i_A (A.lang_ "j") - ( i_A (A.spellcheck_ "k") - ( i_A (A.style_ "l") - ( i_A (A.title_ x) "m")))))))))))) + I :@ (AccesskeyA := "a") :> + ( I :@ (ClassA := "b") :> + ( I :@ (ContenteditableA := "c") :> + ( I :@ (TranslateA := "d") :> + ( I :@ (DirA := "e") :> + ( I :@ (DraggableA := "f") :> + ( I :@ HiddenA :> + ( I :@ (IdA := "h") :> + ( I :@ (ItempropA := "i") :> + ( I :@ (LangA := "j") :> + ( I :@ (SpellcheckA := "k") :> + ( I :@ (StyleA := "l") :> + ( I :@ (TitleA := x) :> "m")))))))))))) attrLong x = - i_A ( A.accesskey_ "a" - # A.class_ "b" - # A.contenteditable_ "c" - # A.contextmenu_ "d" - # A.dir_ "e" - # A.draggable_ "f" - # A.hidden_ - # A.id_ "h" - # A.itemprop_ "i" - # A.lang_ "j" - # A.spellcheck_ "k" - # A.style_ "l" - # A.title_ x - ) "m" + I :@ ( AccesskeyA := "a" + # ClassA := "b" + # ContenteditableA := "c" + # TranslateA := "d" + # DirA := "e" + # DraggableA := "f" + # HiddenA + # IdA := "h" + # ItempropA := "i" + # LangA := "j" + # SpellcheckA := "k" + # StyleA := "l" + # TitleA := x + ) :> "m" pageA x = - html_ - ( body_ - ( h1_A (A.id_ "a") - ( img_ - # strong_A (A.class_ "b") (0 :: Int) + Html :> + ( Body :> + ( H1 :@ (IdA := "a") :> + ( Img + # Strong :@ (ClassA := "b") :> (0 :: Int) ) - # div_ - ( div_A (A.id_ "c") (1 :: Int) + # Div :> + ( Div :@ (IdA := "c") :> (1 :: Int) ) - # div_ - ( form_A (A.class_ "d") - ( fieldset_ - ( div_A (A.id_ "e") - ( div_ - ( label_A (A.class_ "f") "h" - # select_ - ( option_A (A.id_ "i") "j" - # option_ "k" + # Div :> + ( Form :@ (ClassA := "d") :> + ( Fieldset :> + ( Div :@ (IdA := "e") :> + ( Div :> + ( Label :@ (ClassA := "f") :> "h" + # Select :> + ( Option :@ (IdA := "i") :> "j" + # Option :> "k" ) - # div_A (A.class_ "l") "m" + # Div :@ (ClassA := "l") :> "m" ) - # i_ x + # I :> x ) - # button_A (A.id_ "n") (i_ "o") + # Button :@ (IdA := "n") :> (I :> "o") ) ) ) diff --git a/bench/Perf.hs b/bench/Perf.hs --- a/bench/Perf.hs +++ b/bench/Perf.hs @@ -8,7 +8,7 @@ module Main where import Html -import qualified Html.Attribute as A + import qualified Blaze as BL import qualified Small as S import qualified Medium as M @@ -52,14 +52,14 @@ , bench "oneElement Proxy" $ nf (renderByteString . S.oneElement) (Proxy :: Proxy "abc") , bench "()" $ nf renderByteString () , bench "oneElement ()" $ nf (renderByteString . S.oneElement) () - , bench "oneAttribute" $ nf (renderByteString . A.class_) "" - , bench "oneAttribute ()" $ nf (renderByteString . A.class_) () - , bench "oneAttribute Proxy" $ nf (renderByteString . A.class_) (Proxy :: Proxy "abc") - , bench "parallelAttribute" $ nf (\x -> renderByteString $ A.class_ x # A.id_ x) "" - , bench "elementWithAttribute" $ nf (\x -> renderByteString $ div_A (A.class_ x) x) "" - , bench "elementWithParallelAttribute" $ nf (\x -> renderByteString $ div_A (A.class_ x # A.id_ x) x) "" - , bench "listOfAttributes" $ nf (\x -> renderByteString [A.class_ x, A.class_ x]) "" - , bench "listOfListOf" $ nf (\x -> renderByteString $ div_ [i_ [span_ x]]) "" + , bench "oneAttribute" $ nf (renderByteString . (ClassA :=)) "" + , bench "oneAttribute ()" $ nf (renderByteString . (ClassA :=)) () + , bench "oneAttribute Proxy" $ nf (renderByteString . (ClassA :=)) (Proxy :: Proxy "abc") + , bench "parallelAttribute" $ nf (\x -> renderByteString $ ClassA := x # IdA := x) "" + , bench "elementWithAttribute" $ nf (\x -> renderByteString $ Div :@ (ClassA := x) :> x) "" + , bench "elementWithParallelAttribute" $ nf (\x -> renderByteString $ Div :@ (ClassA := x # IdA := x) :> x) "" + , bench "listOfAttributes" $ nf (\x -> renderByteString [ClassA := x, ClassA := x]) "" + , bench "listOfListOf" $ nf (\x -> renderByteString $ Div :> [I :> [Span :> x]]) "" ] medium :: Benchmark @@ -160,7 +160,7 @@ ] ] where - divs2 x = div_ "lorem;" # x # div_ "ipsum<>" + divs2 x = Div :> "lorem;" # x # Div :> "ipsum<>" divs4 = divs2 . divs2 divs8 = divs4 . divs4 divs16 = divs8 . divs8 diff --git a/bench/Reduction.hs b/bench/Reduction.hs --- a/bench/Reduction.hs +++ b/bench/Reduction.hs @@ -1,33 +1,40 @@ {-# LANGUAGE CPP #-} - {-# OPTIONS_GHC -fno-warn-missing-signatures #-} -#if __GLASGOW_HASKELL__ <= 802 -{-# OPTIONS_GHC -fsimpl-tick-factor=66 -freduction-depth=55 #-} + +#if __GLASGOW_HASKELL__ == 802 +{-# OPTIONS_GHC -freduction-depth=55 #-} +#elif __GLASGOW_HASKELL__ == 804 +{-# OPTIONS_GHC -freduction-depth=29 #-} +#elif __GLASGOW_HASKELL__ == 806 +{-# OPTIONS_GHC -freduction-depth=29 #-} +#elif __GLASGOW_HASKELL__ == 808 +{-# OPTIONS_GHC -freduction-depth=29 #-} +#elif __GLASGOW_HASKELL__ == 810 +{-# OPTIONS_GHC -freduction-depth=30 #-} #else -{-# OPTIONS_GHC -fsimpl-tick-factor=66 -freduction-depth=29 #-} +{-# OPTIONS_GHC -freduction-depth=0 #-} #endif module Main where import Html -import qualified Html.Attribute as A main = print p9 -p1 = div_A (A.id_ 'a') 'b' +p1 = Div :@ (IdA := 'a') :> 'b' -p2 = div_ (p1 # p1) +p2 = Div :> (p1 # p1) -p3 = div_ (p2 # p2) +p3 = Div :> (p2 # p2) -p4 = div_ (p3 # p3) +p4 = Div :> (p3 # p3) -p5 = div_ (p4 # p4) +p5 = Div :> (p4 # p4) -p6 = div_ (p5 # p5) +p6 = Div :> (p5 # p5) -p7 = div_ (p6 # p6) +p7 = Div :> (p6 # p6) -p8 = div_ (p7 # p7) +p8 = Div :> (p7 # p7) -p9 = div_ (p8 # p8) +p9 = Div :> (p8 # p8) diff --git a/bench/Small.hs b/bench/Small.hs --- a/bench/Small.hs +++ b/bench/Small.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-} @@ -5,23 +7,11 @@ import Html -oneElement - :: ('Div ?> a) - => a -> 'Div > a -oneElement = div_ +oneElement = (Div :>) -nestedElement - :: ('Span ?> a) - => a -> 'Div > ('Span > a) -nestedElement x = div_ (span_ x) +nestedElement x = Div :> Span :> x -parallelElement - :: ('Span ?> a, 'Div ?> a) - => a -> ('Div > a) # ('Span > a) -parallelElement x = div_ x # span_ x +parallelElement x = Div :> x # Span :> x -listElement - :: ('Div ?> a) - => a -> ['Div > a] -listElement x = [div_ x] +listElement x = [Div :> x] diff --git a/src/Html.hs b/src/Html.hs --- a/src/Html.hs +++ b/src/Html.hs @@ -8,11 +8,11 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} module Html ( module Html.Type , module Html.Convert - , module Html.Element , renderString , renderText , renderByteString @@ -28,7 +28,6 @@ import Html.Reify import Html.Convert -import Html.Element import Html.Type import Html.Type.Internal @@ -106,6 +105,10 @@ indexVar _ s = fromJust (elemIndex s (showTypeList @ (Reverse (Variables a)))) -- | Show instances to faciliate ghci development. -instance Document ((a :@: b) c) => Show ((a :@: b) c) where show = renderString -instance Document (a := b) => Show (a := b) where show = renderString -instance Document (a # b) => Show (a # b) where show = renderString +instance Document (a := b) => Show (a := b) where show = renderString +instance Document (a # b) => Show (a # b) where show = renderString + +instance Document (a :@ b) => Show (a :@ b) where show = renderString +instance Document (a :> b) => Show (a :> b) where show = renderString +instance Document (Attribute a global boolean) => Show (Attribute a global boolean) where show = renderString +instance Document (Element name categories contentModel contentAttributes) => Show (Element name categories contentModel contentAttributes) where show = renderString diff --git a/src/Html/Attribute.hs b/src/Html/Attribute.hs deleted file mode 100644 --- a/src/Html/Attribute.hs +++ /dev/null @@ -1,519 +0,0 @@ -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DataKinds #-} - -module Html.Attribute where - -import Html.Type - -role_ :: a -> 'RoleA := a -role_ = AT - -ariaActivedescendant_ :: a -> 'AriaActivedescendantA := a -ariaActivedescendant_ = AT - -ariaAtomic_ :: a -> 'AriaAtomicA := a -ariaAtomic_ = AT - -ariaAutocomplete_ :: a -> 'AriaAutocompleteA := a -ariaAutocomplete_ = AT - -ariaBusy_ :: a -> 'AriaBusyA := a -ariaBusy_ = AT - -ariaChecked_ :: a -> 'AriaCheckedA := a -ariaChecked_ = AT - -ariaControls_ :: a -> 'AriaControlsA := a -ariaControls_ = AT - -ariaDescribedby_ :: a -> 'AriaDescribedbyA := a -ariaDescribedby_ = AT - -ariaDisabled_ :: a -> 'AriaDisabledA := a -ariaDisabled_ = AT - -ariaDropeffect_ :: a -> 'AriaDropeffectA := a -ariaDropeffect_ = AT - -ariaExpanded_ :: a -> 'AriaExpandedA := a -ariaExpanded_ = AT - -ariaFlowto_ :: a -> 'AriaFlowtoA := a -ariaFlowto_ = AT - -ariaGrabbed_ :: a -> 'AriaGrabbedA := a -ariaGrabbed_ = AT - -ariaHaspopup_ :: a -> 'AriaHaspopupA := a -ariaHaspopup_ = AT - -ariaHidden_ :: a -> 'AriaHiddenA := a -ariaHidden_ = AT - -ariaInvalid_ :: a -> 'AriaInvalidA := a -ariaInvalid_ = AT - -ariaLabel_ :: a -> 'AriaLabelA := a -ariaLabel_ = AT - -ariaLabelledBy_ :: a -> 'AriaLabelledByA := a -ariaLabelledBy_ = AT - -ariaLevel_ :: a -> 'AriaLevelA := a -ariaLevel_ = AT - -ariaLive_ :: a -> 'AriaLiveA := a -ariaLive_ = AT - -ariaMultiline_ :: a -> 'AriaMultilineA := a -ariaMultiline_ = AT - -ariaMultiselectable_ :: a -> 'AriaMultiselectableA := a -ariaMultiselectable_ = AT - -ariaOwns_ :: a -> 'AriaOwnsA := a -ariaOwns_ = AT - -ariaPosinset_ :: a -> 'AriaPosinsetA := a -ariaPosinset_ = AT - -ariaPressed_ :: a -> 'AriaPressedA := a -ariaPressed_ = AT - -ariaReadonly_ :: a -> 'AriaReadonlyA := a -ariaReadonly_ = AT - -ariaRelevant_ :: a -> 'AriaRelevantA := a -ariaRelevant_ = AT - -ariaRequired_ :: a -> 'AriaRequiredA := a -ariaRequired_ = AT - -ariaSelected_ :: a -> 'AriaSelectedA := a -ariaSelected_ = AT - -ariaSetsize_ :: a -> 'AriaSetsizeA := a -ariaSetsize_ = AT - -ariaSort_ :: a -> 'AriaSortA := a -ariaSort_ = AT - -ariaValuemax_ :: a -> 'AriaValuemaxA := a -ariaValuemax_ = AT - -ariaValuemin_ :: a -> 'AriaValueminA := a -ariaValuemin_ = AT - -ariaValuenow_ :: a -> 'AriaValuenowA := a -ariaValuenow_ = AT - -ariaValuetext_ :: a -> 'AriaValuetextA := a -ariaValuetext_ = AT - -accept_ :: a -> 'AcceptA := a -accept_ = AT - -acceptCharset_ :: a -> 'AcceptCharsetA := a -acceptCharset_ = AT - -accesskey_ :: a -> 'AccesskeyA := a -accesskey_ = AT - -action_ :: a -> 'ActionA := a -action_ = AT - -allowfullscreen_ :: 'AllowfullscreenA := () -allowfullscreen_ = AT () - -allowpaymentrequest_ :: 'AllowpaymentrequestA := () -allowpaymentrequest_ = AT () - -align_ :: a -> 'AlignA := a -align_ = AT - -alt_ :: a -> 'AltA := a -alt_ = AT - -async_ :: 'AsyncA := () -async_ = AT () - -autocomplete_ :: a -> 'AutocompleteA := a -autocomplete_ = AT - -autofocus_ :: 'AutofocusA := () -autofocus_ = AT () - -autoplay_ :: 'AutoplayA := () -autoplay_ = AT () - -autosave_ :: a -> 'AutosaveA := a -autosave_ = AT - -bgcolor_ :: a -> 'BgcolorA := a -bgcolor_ = AT - -border_ :: a -> 'BorderA := a -border_ = AT - -buffered_ :: a -> 'BufferedA := a -buffered_ = AT - -challenge_ :: a -> 'ChallengeA := a -challenge_ = AT - -charset_ :: a -> 'CharsetA := a -charset_ = AT - -checked_ :: 'CheckedA := () -checked_ = AT () - -cite_ :: a -> 'CiteA := a -cite_ = AT - -class_ :: a -> 'ClassA := a -class_ = AT - -code_ :: a -> 'CodeA := a -code_ = AT - -codebase_ :: a -> 'CodebaseA := a -codebase_ = AT - -color_ :: a -> 'ColorA := a -color_ = AT - -cols_ :: Integral a => a -> 'ColsA := a -cols_ = AT - -colspan_ :: Integral a => a -> 'ColspanA := a -colspan_ = AT - -content_ :: a -> 'ContentA := a -content_ = AT - -contenteditable_ :: a -> 'ContenteditableA := a -contenteditable_ = AT - -contextmenu_ :: a -> 'ContextmenuA := a -contextmenu_ = AT - -controls_ :: 'ControlsA := () -controls_ = AT () - -coords_ :: a -> 'CoordsA := a -coords_ = AT - -crossorigin_ :: a -> 'CrossoriginA := a -crossorigin_ = AT - -data_ :: a -> 'DataA := a -data_ = AT - -datetime_ :: a -> 'DatetimeA := a -datetime_ = AT - -default_ :: 'DefaultA := () -default_ = AT () - -defer_ :: 'DeferA := () -defer_ = AT () - -dir_ :: a -> 'DirA := a -dir_ = AT - -dirname_ :: a -> 'DirnameA := a -dirname_ = AT - -disabled_ :: 'DisabledA := () -disabled_ = AT () - -download_ :: a -> 'DownloadA := a -download_ = AT - -draggable_ :: a -> 'DraggableA := a -draggable_ = AT - -dropzone_ :: a -> 'DropzoneA := a -dropzone_ = AT - -enctype_ :: a -> 'EnctypeA := a -enctype_ = AT - -for_ :: a -> 'ForA := a -for_ = AT - -form_ :: a -> 'FormA := a -form_ = AT - -formaction_ :: a -> 'FormactionA := a -formaction_ = AT - -formenctype_ :: a -> 'FormenctypeA := a -formenctype_ = AT - -formmethod_ :: a -> 'FormmethodA := a -formmethod_ = AT - -formnovalidate_ :: 'FormnovalidateA := () -formnovalidate_ = AT () - -formtarget_ :: a -> 'FormtargetA := a -formtarget_ = AT - -headers_ :: a -> 'HeadersA := a -headers_ = AT - -height_ :: Integral a => a -> 'HeightA := a -height_ = AT - -hidden_ :: 'HiddenA := () -hidden_ = AT () - -high_ :: Num a => a -> 'HighA := a -high_ = AT - -href_ :: a -> 'HrefA := a -href_ = AT - -hreflang_ :: a -> 'HreflangA := a -hreflang_ = AT - -httpEquiv_ :: a -> 'HttpEquivA := a -httpEquiv_ = AT - -icon_ :: a -> 'IconA := a -icon_ = AT - -id_ :: a -> 'IdA := a -id_ = AT - -integrity_ :: a -> 'IntegrityA := a -integrity_ = AT - -ismap_ :: 'IsmapA := () -ismap_ = AT () - -itemprop_ :: a -> 'ItempropA := a -itemprop_ = AT - -keytype_ :: a -> 'KeytypeA := a -keytype_ = AT - -kind_ :: a -> 'KindA := a -kind_ = AT - -label_ :: a -> 'LabelA := a -label_ = AT - -lang_ :: a -> 'LangA := a -lang_ = AT - -language_ :: a -> 'LanguageA := a -language_ = AT - -list_ :: a -> 'ListA := a -list_ = AT - -longdesc_ :: a -> 'LongdescA := a -longdesc_ = AT - -loop_ :: 'LoopA := () -loop_ = AT () - -low_ :: Num a => a -> 'LowA := a -low_ = AT - -manifest_ :: a -> 'ManifestA := a -manifest_ = AT - -max_ :: Num a => a -> 'MaxA := a -max_ = AT - -maxlength_ :: Integral a => a -> 'MaxlengthA := a -maxlength_ = AT - -minlength_ :: Integral a => a -> 'MinlengthA := a -minlength_ = AT - -media_ :: a -> 'MediaA := a -media_ = AT - -method_ :: a -> 'MethodA := a -method_ = AT - -min_ :: Num a => a -> 'MinA := a -min_ = AT - -multiple_ :: 'MultipleA := () -multiple_ = AT () - -muted_ :: 'MutedA := () -muted_ = AT () - -name_ :: a -> 'NameA := a -name_ = AT - -nonce_ :: a -> 'NonceA := a -nonce_ = AT - -novalidate_ :: 'NovalidateA := () -novalidate_ = AT () - -open_ :: 'OpenA := () -open_ = AT () - -optimum_ :: Num a => a -> 'OptimumA := a -optimum_ = AT - -pattern_ :: a -> 'PatternA := a -pattern_ = AT - -ping_ :: a -> 'PingA := a -ping_ = AT - -placeholder_ :: a -> 'PlaceholderA := a -placeholder_ = AT - -poster_ :: a -> 'PosterA := a -poster_ = AT - -preload_ :: a -> 'PreloadA := a -preload_ = AT - -radiogroup_ :: a -> 'RadiogroupA := a -radiogroup_ = AT - -readonly_ :: 'ReadonlyA := () -readonly_ = AT () - -referrerpolicy_ :: a -> 'ReferrerpolicyA := a -referrerpolicy_ = AT - -rel_ :: a -> 'RelA := a -rel_ = AT - -required_ :: 'RequiredA := () -required_ = AT () - -rev_ :: a -> 'RevA := a -rev_ = AT - -reversed_ :: 'ReversedA := () -reversed_ = AT () - -rows_ :: Integral a => a -> 'RowsA := a -rows_ = AT - -rowspan_ :: Integral a => a -> 'RowspanA := a -rowspan_ = AT - -sandbox_ :: a -> 'SandboxA := a -sandbox_ = AT - -scope_ :: a -> 'ScopeA := a -scope_ = AT - -scoped_ :: a -> 'ScopedA := a -scoped_ = AT - -seamless_ :: a -> 'SeamlessA := a -seamless_ = AT - -selected_ :: 'SelectedA := () -selected_ = AT () - -shape_ :: a -> 'ShapeA := a -shape_ = AT - -size_ :: Integral a => a -> 'SizeA := a -size_ = AT - -sizes_ :: a -> 'SizesA := a -sizes_ = AT - -slot_ :: a -> 'SlotA := a -slot_ = AT - -span_ :: Integral a => a -> 'SpanA := a -span_ = AT - -spellcheck_ :: a -> 'SpellcheckA := a -spellcheck_ = AT - -src_ :: a -> 'SrcA := a -src_ = AT - -srcdoc_ :: a -> 'SrcdocA := a -srcdoc_ = AT - -srclang_ :: a -> 'SrclangA := a -srclang_ = AT - -srcset_ :: a -> 'SrcsetA := a -srcset_ = AT - -start_ :: Integral a => a -> 'StartA := a -start_ = AT - -step_ :: Num a => a -> 'StepA := a -step_ = AT - -style_ :: a -> 'StyleA := a -style_ = AT - -summary_ :: a -> 'SummaryA := a -summary_ = AT - -tabindex_ :: Integral a => a -> 'TabindexA := a -tabindex_ = AT - -target_ :: a -> 'TargetA := a -target_ = AT - -title_ :: a -> 'TitleA := a -title_ = AT - -translate_ :: a -> 'TranslateA := a -translate_ = AT - -type_ :: a -> 'TypeA := a -type_ = AT - -typemustmatch_ :: 'TypemustmatchA := () -typemustmatch_ = AT () - -usemap_ :: a -> 'UsemapA := a -usemap_ = AT - -value_ :: a -> 'ValueA := a -value_ = AT - -width_ :: Integral a => a -> 'WidthA := a -width_ = AT - -wrap_ :: a -> 'WrapA := a -wrap_ = AT - --- | Escape hatch for defining non standard attributes. Note that it's --- your responsibility to choose valid attribute names, these are at --- the moment not checked. These custom attributes don't carry any --- performance penalty, they are fused at compiletime just as much as --- standard attributes. --- --- @ --- {-\# LANGUAGE DataKinds \#-} --- {-\# LANGUAGE TypeOperators \#-} --- import Html --- import qualified Html.Attribute as A --- --- dataName_ :: a -> 'CustomA "data-name" := a --- dataName_ = A.custom_ --- @ --- --- >>> div_A (dataName_ "foo") "bar" ---
bar
-custom_ :: a -> 'CustomA b := a -custom_ = AT - -addAttributes :: (a (b # b')) c => b' -> (a :@: b) c -> (a :@: (b # b')) c -addAttributes b' (WithAttributes b c) = WithAttributes (b # b') c diff --git a/src/Html/Element.hs b/src/Html/Element.hs deleted file mode 100644 --- a/src/Html/Element.hs +++ /dev/null @@ -1,887 +0,0 @@ -{-# OPTIONS_GHC -fno-warn-deprecations #-} - -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE DataKinds #-} - -module Html.Element where - -import Html.Type - -doctype_ :: 'DOCTYPE > () -doctype_ = WithAttributes () () - -a_ :: ('A ?> a) => a -> 'A > a -a_ = WithAttributes () - -a_A :: ('A a) b => a -> b -> ('A :@: a) b -a_A = WithAttributes - -abbr_ :: ('Abbr ?> a) => a -> 'Abbr > a -abbr_ = WithAttributes () - -abbr_A :: ('Abbr a) b => a -> b -> ('Abbr :@: a) b -abbr_A = WithAttributes - -acronym_ :: ('Acronym ?> a) => a -> 'Acronym > a -acronym_ = WithAttributes () - -acronym_A :: ('Acronym a) b => a -> b -> ('Acronym :@: a) b -acronym_A = WithAttributes - -address_ :: ('Address ?> a) => a -> 'Address > a -address_ = WithAttributes () - -address_A :: ('Address a) b => a -> b -> ('Address :@: a) b -address_A = WithAttributes - -applet_ :: ('Applet ?> a) => a -> 'Applet > a -applet_ = WithAttributes () - -applet_A :: ('Applet a) b => a -> b -> ('Applet :@: a) b -applet_A = WithAttributes - -area_ :: 'Area > () -area_ = WithAttributes () () - -area_A :: ('Area a) () => a -> ('Area :@: a) () -area_A = flip WithAttributes () - -article_ :: ('Article ?> a) => a -> 'Article > a -article_ = WithAttributes () - -article_A :: ('Article a) b => a -> b -> ('Article :@: a) b -article_A = WithAttributes - -aside_ :: ('Aside ?> a) => a -> 'Aside > a -aside_ = WithAttributes () - -aside_A :: ('Aside a) b => a -> b -> ('Aside :@: a) b -aside_A = WithAttributes - -audio_ :: ('Audio ?> a) => a -> 'Audio > a -audio_ = WithAttributes () - -audio_A :: ('Audio a) b => a -> b -> ('Audio :@: a) b -audio_A = WithAttributes - -b_ :: ('B ?> a) => a -> 'B > a -b_ = WithAttributes () - -b_A :: ('B a) b => a -> b -> ('B :@: a) b -b_A = WithAttributes - -base_ :: 'Base > () -base_ = WithAttributes () () - -base_A :: ('Base a) () => a -> ('Base :@: a) () -base_A = flip WithAttributes () - -basefont_ :: ('Basefont ?> a) => a -> 'Basefont > a -basefont_ = WithAttributes () - -basefont_A :: ('Basefont a) b => a -> b -> ('Basefont :@: a) b -basefont_A = WithAttributes - -bdi_ :: ('Bdi ?> a) => a -> 'Bdi > a -bdi_ = WithAttributes () - -bdi_A :: ('Bdi a) b => a -> b -> ('Bdi :@: a) b -bdi_A = WithAttributes - -bdo_ :: ('Bdo ?> a) => a -> 'Bdo > a -bdo_ = WithAttributes () - -bdo_A :: ('Bdo a) b => a -> b -> ('Bdo :@: a) b -bdo_A = WithAttributes - -bgsound_ :: ('Bgsound ?> a) => a -> 'Bgsound > a -bgsound_ = WithAttributes () - -bgsound_A :: ('Bgsound a) b => a -> b -> ('Bgsound :@: a) b -bgsound_A = WithAttributes - -big_ :: ('Big ?> a) => a -> 'Big > a -big_ = WithAttributes () - -big_A :: ('Big a) b => a -> b -> ('Big :@: a) b -big_A = WithAttributes - -blink_ :: ('Blink ?> a) => a -> 'Blink > a -blink_ = WithAttributes () - -blink_A :: ('Blink a) b => a -> b -> ('Blink :@: a) b -blink_A = WithAttributes - -blockquote_ :: ('Blockquote ?> a) => a -> 'Blockquote > a -blockquote_ = WithAttributes () - -blockquote_A :: ('Blockquote a) b => a -> b -> ('Blockquote :@: a) b -blockquote_A = WithAttributes - -body_ :: ('Body ?> a) => a -> 'Body > a -body_ = WithAttributes () - -body_A :: ('Body a) b => a -> b -> ('Body :@: a) b -body_A = WithAttributes - -br_ :: 'Br > () -br_ = WithAttributes () () - -br_A :: ('Br a) () => a -> ('Br :@: a) () -br_A = flip WithAttributes () - -button_ :: ('Button ?> a) => a -> 'Button > a -button_ = WithAttributes () - -button_A :: ('Button a) b => a -> b -> ('Button :@: a) b -button_A = WithAttributes - -canvas_ :: ('Canvas ?> a) => a -> 'Canvas > a -canvas_ = WithAttributes () - -canvas_A :: ('Canvas a) b => a -> b -> ('Canvas :@: a) b -canvas_A = WithAttributes - -caption_ :: ('Caption ?> a) => a -> 'Caption > a -caption_ = WithAttributes () - -caption_A :: ('Caption a) b => a -> b -> ('Caption :@: a) b -caption_A = WithAttributes - -center_ :: ('Center ?> a) => a -> 'Center > a -center_ = WithAttributes () - -center_A :: ('Center a) b => a -> b -> ('Center :@: a) b -center_A = WithAttributes - -cite_ :: ('Cite ?> a) => a -> 'Cite > a -cite_ = WithAttributes () - -cite_A :: ('Cite a) b => a -> b -> ('Cite :@: a) b -cite_A = WithAttributes - -code_ :: ('Code ?> a) => a -> 'Code > a -code_ = WithAttributes () - -code_A :: ('Code a) b => a -> b -> ('Code :@: a) b -code_A = WithAttributes - -col_ :: 'Col > () -col_ = WithAttributes () () - -col_A :: ('Col a) () => a -> ('Col :@: a) () -col_A = flip WithAttributes () - -colgroup_ :: ('Colgroup ?> a) => a -> 'Colgroup > a -colgroup_ = WithAttributes () - -colgroup_A :: ('Colgroup a) b => a -> b -> ('Colgroup :@: a) b -colgroup_A = WithAttributes - -command_ :: ('Command ?> a) => a -> 'Command > a -command_ = WithAttributes () - -command_A :: ('Command a) b => a -> b -> ('Command :@: a) b -command_A = WithAttributes - -content_ :: ('Content ?> a) => a -> 'Content > a -content_ = WithAttributes () - -content_A :: ('Content a) b => a -> b -> ('Content :@: a) b -content_A = WithAttributes - -data_ :: ('Data ?> a) => a -> 'Data > a -data_ = WithAttributes () - -data_A :: ('Data a) b => a -> b -> ('Data :@: a) b -data_A = WithAttributes - -datalist_ :: ('Datalist ?> a) => a -> 'Datalist > a -datalist_ = WithAttributes () - -datalist_A :: ('Datalist a) b => a -> b -> ('Datalist :@: a) b -datalist_A = WithAttributes - -dd_ :: ('Dd ?> a) => a -> 'Dd > a -dd_ = WithAttributes () - -dd_A :: ('Dd a) b => a -> b -> ('Dd :@: a) b -dd_A = WithAttributes - -del_ :: ('Del ?> a) => a -> 'Del > a -del_ = WithAttributes () - -del_A :: ('Del a) b => a -> b -> ('Del :@: a) b -del_A = WithAttributes - -details_ :: ('Details ?> a) => a -> 'Details > a -details_ = WithAttributes () - -details_A :: ('Details a) b => a -> b -> ('Details :@: a) b -details_A = WithAttributes - -dfn_ :: ('Dfn ?> a) => a -> 'Dfn > a -dfn_ = WithAttributes () - -dfn_A :: ('Dfn a) b => a -> b -> ('Dfn :@: a) b -dfn_A = WithAttributes - -dialog_ :: ('Dialog ?> a) => a -> 'Dialog > a -dialog_ = WithAttributes () - -dialog_A :: ('Dialog a) b => a -> b -> ('Dialog :@: a) b -dialog_A = WithAttributes - -dir_ :: ('Dir ?> a) => a -> 'Dir > a -dir_ = WithAttributes () - -dir_A :: ('Dir a) b => a -> b -> ('Dir :@: a) b -dir_A = WithAttributes - -div_ :: ('Div ?> a) => a -> 'Div > a -div_ = WithAttributes () - -div_A :: ('Div a) b => a -> b -> ('Div :@: a) b -div_A = WithAttributes - -dl_ :: ('Dl ?> a) => a -> 'Dl > a -dl_ = WithAttributes () - -dl_A :: ('Dl a) b => a -> b -> ('Dl :@: a) b -dl_A = WithAttributes - -dt_ :: ('Dt ?> a) => a -> 'Dt > a -dt_ = WithAttributes () - -dt_A :: ('Dt a) b => a -> b -> ('Dt :@: a) b -dt_A = WithAttributes - -element_ :: ('Element ?> a) => a -> 'Element > a -element_ = WithAttributes () - -element_A :: ('Element a) b => a -> b -> ('Element :@: a) b -element_A = WithAttributes - -em_ :: ('Em ?> a) => a -> 'Em > a -em_ = WithAttributes () - -em_A :: ('Em a) b => a -> b -> ('Em :@: a) b -em_A = WithAttributes - -embed_ :: 'Embed > () -embed_ = WithAttributes () () - -embed_A :: ('Embed a) () => a -> ('Embed :@: a) () -embed_A = flip WithAttributes () - -fieldset_ :: ('Fieldset ?> a) => a -> 'Fieldset > a -fieldset_ = WithAttributes () - -fieldset_A :: ('Fieldset a) b => a -> b -> ('Fieldset :@: a) b -fieldset_A = WithAttributes - -figcaption_ :: ('Figcaption ?> a) => a -> 'Figcaption > a -figcaption_ = WithAttributes () - -figcaption_A :: ('Figcaption a) b => a -> b -> ('Figcaption :@: a) b -figcaption_A = WithAttributes - -figure_ :: ('Figure ?> a) => a -> 'Figure > a -figure_ = WithAttributes () - -figure_A :: ('Figure a) b => a -> b -> ('Figure :@: a) b -figure_A = WithAttributes - -font_ :: ('Font ?> a) => a -> 'Font > a -font_ = WithAttributes () - -font_A :: ('Font a) b => a -> b -> ('Font :@: a) b -font_A = WithAttributes - -footer_ :: ('Footer ?> a) => a -> 'Footer > a -footer_ = WithAttributes () - -footer_A :: ('Footer a) b => a -> b -> ('Footer :@: a) b -footer_A = WithAttributes - -form_ :: ('Form ?> a) => a -> 'Form > a -form_ = WithAttributes () - -form_A :: ('Form a) b => a -> b -> ('Form :@: a) b -form_A = WithAttributes - -frame_ :: ('Frame ?> a) => a -> 'Frame > a -frame_ = WithAttributes () - -frame_A :: ('Frame a) b => a -> b -> ('Frame :@: a) b -frame_A = WithAttributes - -frameset_ :: ('Frameset ?> a) => a -> 'Frameset > a -frameset_ = WithAttributes () - -frameset_A :: ('Frameset a) b => a -> b -> ('Frameset :@: a) b -frameset_A = WithAttributes - -h1_ :: ('H1 ?> a) => a -> 'H1 > a -h1_ = WithAttributes () - -h1_A :: ('H1 a) b => a -> b -> ('H1 :@: a) b -h1_A = WithAttributes - -h2_ :: ('H2 ?> a) => a -> 'H2 > a -h2_ = WithAttributes () - -h2_A :: ('H2 a) b => a -> b -> ('H2 :@: a) b -h2_A = WithAttributes - -h3_ :: ('H3 ?> a) => a -> 'H3 > a -h3_ = WithAttributes () - -h3_A :: ('H3 a) b => a -> b -> ('H3 :@: a) b -h3_A = WithAttributes - -h4_ :: ('H4 ?> a) => a -> 'H4 > a -h4_ = WithAttributes () - -h4_A :: ('H4 a) b => a -> b -> ('H4 :@: a) b -h4_A = WithAttributes - -h5_ :: ('H5 ?> a) => a -> 'H5 > a -h5_ = WithAttributes () - -h5_A :: ('H5 a) b => a -> b -> ('H5 :@: a) b -h5_A = WithAttributes - -h6_ :: ('H6 ?> a) => a -> 'H6 > a -h6_ = WithAttributes () - -h6_A :: ('H6 a) b => a -> b -> ('H6 :@: a) b -h6_A = WithAttributes - -head_ :: ('Head ?> a) => a -> 'Head > a -head_ = WithAttributes () - -head_A :: ('Head a) b => a -> b -> ('Head :@: a) b -head_A = WithAttributes - -header_ :: ('Header ?> a) => a -> 'Header > a -header_ = WithAttributes () - -header_A :: ('Header a) b => a -> b -> ('Header :@: a) b -header_A = WithAttributes - -hgroup_ :: ('Hgroup ?> a) => a -> 'Hgroup > a -hgroup_ = WithAttributes () - -hgroup_A :: ('Hgroup a) b => a -> b -> ('Hgroup :@: a) b -hgroup_A = WithAttributes - -hr_ :: 'Hr > () -hr_ = WithAttributes () () - -hr_A :: ('Hr a) () => a -> ('Hr :@: a) () -hr_A = flip WithAttributes () - -html_ :: ('Html ?> a) => a -> 'Html > a -html_ = WithAttributes () - -html_A :: ('Html a) b => a -> b -> ('Html :@: a) b -html_A = WithAttributes - -i_ :: ('I ?> a) => a -> 'I > a -i_ = WithAttributes () - -i_A :: ('I a) b => a -> b -> ('I :@: a) b -i_A = WithAttributes - -iframe_ :: 'Iframe > () -iframe_ = WithAttributes () () - -iframe_A :: ('Iframe a) () => a -> ('Iframe :@: a) () -iframe_A = flip WithAttributes () - -image_ :: ('Image ?> a) => a -> 'Image > a -image_ = WithAttributes () - -image_A :: ('Image a) b => a -> b -> ('Image :@: a) b -image_A = WithAttributes - -img_ :: 'Img > () -img_ = WithAttributes () () - -img_A :: ('Img a) () => a -> ('Img :@: a) () -img_A = flip WithAttributes () - -input_ :: 'Input > () -input_ = WithAttributes () () - -input_A :: ('Input a) () => a -> ('Input :@: a) () -input_A = flip WithAttributes () - -ins_ :: ('Ins ?> a) => a -> 'Ins > a -ins_ = WithAttributes () - -ins_A :: ('Ins a) b => a -> b -> ('Ins :@: a) b -ins_A = WithAttributes - -isindex_ :: ('Isindex ?> a) => a -> 'Isindex > a -isindex_ = WithAttributes () - -isindex_A :: ('Isindex a) b => a -> b -> ('Isindex :@: a) b -isindex_A = WithAttributes - -kbd_ :: ('Kbd ?> a) => a -> 'Kbd > a -kbd_ = WithAttributes () - -kbd_A :: ('Kbd a) b => a -> b -> ('Kbd :@: a) b -kbd_A = WithAttributes - -keygen_ :: ('Keygen ?> a) => a -> 'Keygen > a -keygen_ = WithAttributes () - -keygen_A :: ('Keygen a) b => a -> b -> ('Keygen :@: a) b -keygen_A = WithAttributes - -label_ :: ('Label ?> a) => a -> 'Label > a -label_ = WithAttributes () - -label_A :: ('Label a) b => a -> b -> ('Label :@: a) b -label_A = WithAttributes - -legend_ :: ('Legend ?> a) => a -> 'Legend > a -legend_ = WithAttributes () - -legend_A :: ('Legend a) b => a -> b -> ('Legend :@: a) b -legend_A = WithAttributes - -li_ :: ('Li ?> a) => a -> 'Li > a -li_ = WithAttributes () - -li_A :: ('Li a) b => a -> b -> ('Li :@: a) b -li_A = WithAttributes - -link_ :: 'Link > () -link_ = WithAttributes () () - -link_A :: ('Link a) () => a -> ('Link :@: a) () -link_A = flip WithAttributes () - -listing_ :: ('Listing ?> a) => a -> 'Listing > a -listing_ = WithAttributes () - -listing_A :: ('Listing a) b => a -> b -> ('Listing :@: a) b -listing_A = WithAttributes - -main_ :: ('Main ?> a) => a -> 'Main > a -main_ = WithAttributes () - -main_A :: ('Main a) b => a -> b -> ('Main :@: a) b -main_A = WithAttributes - -map_ :: ('Map ?> a) => a -> 'Map > a -map_ = WithAttributes () - -map_A :: ('Map a) b => a -> b -> ('Map :@: a) b -map_A = WithAttributes - -mark_ :: ('Mark ?> a) => a -> 'Mark > a -mark_ = WithAttributes () - -mark_A :: ('Mark a) b => a -> b -> ('Mark :@: a) b -mark_A = WithAttributes - -marquee_ :: ('Marquee ?> a) => a -> 'Marquee > a -marquee_ = WithAttributes () - -marquee_A :: ('Marquee a) b => a -> b -> ('Marquee :@: a) b -marquee_A = WithAttributes - -math_ :: ('Math ?> a) => a -> 'Math > a -math_ = WithAttributes () - -math_A :: ('Math a) b => a -> b -> ('Math :@: a) b -math_A = WithAttributes - -menu_ :: ('Menu ?> a) => a -> 'Menu > a -menu_ = WithAttributes () - -menu_A :: ('Menu a) b => a -> b -> ('Menu :@: a) b -menu_A = WithAttributes - -menuitem_ :: 'Menuitem > () -menuitem_ = WithAttributes () () - -menuitem_A :: ('Menuitem a) () => a -> ('Menuitem :@: a) () -menuitem_A = flip WithAttributes () - -meta_ :: 'Meta > () -meta_ = WithAttributes () () - -meta_A :: ('Meta a) () => a -> ('Meta :@: a) () -meta_A = flip WithAttributes () - -meter_ :: ('Meter ?> a) => a -> 'Meter > a -meter_ = WithAttributes () - -meter_A :: ('Meter a) b => a -> b -> ('Meter :@: a) b -meter_A = WithAttributes - -multicol_ :: ('Multicol ?> a) => a -> 'Multicol > a -multicol_ = WithAttributes () - -multicol_A :: ('Multicol a) b => a -> b -> ('Multicol :@: a) b -multicol_A = WithAttributes - -nav_ :: ('Nav ?> a) => a -> 'Nav > a -nav_ = WithAttributes () - -nav_A :: ('Nav a) b => a -> b -> ('Nav :@: a) b -nav_A = WithAttributes - -nextid_ :: ('Nextid ?> a) => a -> 'Nextid > a -nextid_ = WithAttributes () - -nextid_A :: ('Nextid a) b => a -> b -> ('Nextid :@: a) b -nextid_A = WithAttributes - -nobr_ :: ('Nobr ?> a) => a -> 'Nobr > a -nobr_ = WithAttributes () - -nobr_A :: ('Nobr a) b => a -> b -> ('Nobr :@: a) b -nobr_A = WithAttributes - -noembed_ :: ('Noembed ?> a) => a -> 'Noembed > a -noembed_ = WithAttributes () - -noembed_A :: ('Noembed a) b => a -> b -> ('Noembed :@: a) b -noembed_A = WithAttributes - -noframes_ :: ('Noframes ?> a) => a -> 'Noframes > a -noframes_ = WithAttributes () - -noframes_A :: ('Noframes a) b => a -> b -> ('Noframes :@: a) b -noframes_A = WithAttributes - -noscript_ :: ('Noscript ?> a) => a -> 'Noscript > a -noscript_ = WithAttributes () - -noscript_A :: ('Noscript a) b => a -> b -> ('Noscript :@: a) b -noscript_A = WithAttributes - -object_ :: ('Object ?> a) => a -> 'Object > a -object_ = WithAttributes () - -object_A :: ('Object a) b => a -> b -> ('Object :@: a) b -object_A = WithAttributes - -ol_ :: ('Ol ?> a) => a -> 'Ol > a -ol_ = WithAttributes () - -ol_A :: ('Ol a) b => a -> b -> ('Ol :@: a) b -ol_A = WithAttributes - -optgroup_ :: ('Optgroup ?> a) => a -> 'Optgroup > a -optgroup_ = WithAttributes () - -optgroup_A :: ('Optgroup a) b => a -> b -> ('Optgroup :@: a) b -optgroup_A = WithAttributes - -option_ :: ('Option ?> a) => a -> 'Option > a -option_ = WithAttributes () - -option_A :: ('Option a) b => a -> b -> ('Option :@: a) b -option_A = WithAttributes - -output_ :: ('Output ?> a) => a -> 'Output > a -output_ = WithAttributes () - -output_A :: ('Output a) b => a -> b -> ('Output :@: a) b -output_A = WithAttributes - -p_ :: ('P ?> a) => a -> 'P > a -p_ = WithAttributes () - -p_A :: ('P a) b => a -> b -> ('P :@: a) b -p_A = WithAttributes - -param_ :: 'Param > () -param_ = WithAttributes () () - -param_A :: ('Param a) () => a -> ('Param :@: a) () -param_A = flip WithAttributes () - -picture_ :: ('Picture ?> a) => a -> 'Picture > a -picture_ = WithAttributes () - -picture_A :: ('Picture a) b => a -> b -> ('Picture :@: a) b -picture_A = WithAttributes - -plaintext_ :: ('Plaintext ?> a) => a -> 'Plaintext > a -plaintext_ = WithAttributes () - -plaintext_A :: ('Plaintext a) b => a -> b -> ('Plaintext :@: a) b -plaintext_A = WithAttributes - -pre_ :: ('Pre ?> a) => a -> 'Pre > a -pre_ = WithAttributes () - -pre_A :: ('Pre a) b => a -> b -> ('Pre :@: a) b -pre_A = WithAttributes - -progress_ :: ('Progress ?> a) => a -> 'Progress > a -progress_ = WithAttributes () - -progress_A :: ('Progress a) b => a -> b -> ('Progress :@: a) b -progress_A = WithAttributes - -q_ :: ('Q ?> a) => a -> 'Q > a -q_ = WithAttributes () - -q_A :: ('Q a) b => a -> b -> ('Q :@: a) b -q_A = WithAttributes - -rp_ :: ('Rp ?> a) => a -> 'Rp > a -rp_ = WithAttributes () - -rp_A :: ('Rp a) b => a -> b -> ('Rp :@: a) b -rp_A = WithAttributes - -rt_ :: ('Rt ?> a) => a -> 'Rt > a -rt_ = WithAttributes () - -rt_A :: ('Rt a) b => a -> b -> ('Rt :@: a) b -rt_A = WithAttributes - -rtc_ :: ('Rtc ?> a) => a -> 'Rtc > a -rtc_ = WithAttributes () - -rtc_A :: ('Rtc a) b => a -> b -> ('Rtc :@: a) b -rtc_A = WithAttributes - -ruby_ :: ('Ruby ?> a) => a -> 'Ruby > a -ruby_ = WithAttributes () - -ruby_A :: ('Ruby a) b => a -> b -> ('Ruby :@: a) b -ruby_A = WithAttributes - -s_ :: ('S ?> a) => a -> 'S > a -s_ = WithAttributes () - -s_A :: ('S a) b => a -> b -> ('S :@: a) b -s_A = WithAttributes - -samp_ :: ('Samp ?> a) => a -> 'Samp > a -samp_ = WithAttributes () - -samp_A :: ('Samp a) b => a -> b -> ('Samp :@: a) b -samp_A = WithAttributes - -script_ :: ('Script ?> a) => a -> 'Script > a -script_ = WithAttributes () - -script_A :: ('Script a) b => a -> b -> ('Script :@: a) b -script_A = WithAttributes - -section_ :: ('Section ?> a) => a -> 'Section > a -section_ = WithAttributes () - -section_A :: ('Section a) b => a -> b -> ('Section :@: a) b -section_A = WithAttributes - -select_ :: ('Select ?> a) => a -> 'Select > a -select_ = WithAttributes () - -select_A :: ('Select a) b => a -> b -> ('Select :@: a) b -select_A = WithAttributes - -shadow_ :: ('Shadow ?> a) => a -> 'Shadow > a -shadow_ = WithAttributes () - -shadow_A :: ('Shadow a) b => a -> b -> ('Shadow :@: a) b -shadow_A = WithAttributes - -slot_ :: ('Slot ?> a) => a -> 'Slot > a -slot_ = WithAttributes () - -slot_A :: ('Slot a) b => a -> b -> ('Slot :@: a) b -slot_A = WithAttributes - -small_ :: ('Small ?> a) => a -> 'Small > a -small_ = WithAttributes () - -small_A :: ('Small a) b => a -> b -> ('Small :@: a) b -small_A = WithAttributes - -source_ :: 'Source > () -source_ = WithAttributes () () - -source_A :: ('Source a) () => a -> ('Source :@: a) () -source_A = flip WithAttributes () - -spacer_ :: ('Spacer ?> a) => a -> 'Spacer > a -spacer_ = WithAttributes () - -spacer_A :: ('Spacer a) b => a -> b -> ('Spacer :@: a) b -spacer_A = WithAttributes - -span_ :: ('Span ?> a) => a -> 'Span > a -span_ = WithAttributes () - -span_A :: ('Span a) b => a -> b -> ('Span :@: a) b -span_A = WithAttributes - -strike_ :: ('Strike ?> a) => a -> 'Strike > a -strike_ = WithAttributes () - -strike_A :: ('Strike a) b => a -> b -> ('Strike :@: a) b -strike_A = WithAttributes - -strong_ :: ('Strong ?> a) => a -> 'Strong > a -strong_ = WithAttributes () - -strong_A :: ('Strong a) b => a -> b -> ('Strong :@: a) b -strong_A = WithAttributes - -style_ :: ('Style ?> a) => a -> 'Style > a -style_ = WithAttributes () - -style_A :: ('Style a) b => a -> b -> ('Style :@: a) b -style_A = WithAttributes - -sub_ :: ('Sub ?> a) => a -> 'Sub > a -sub_ = WithAttributes () - -sub_A :: ('Sub a) b => a -> b -> ('Sub :@: a) b -sub_A = WithAttributes - -summary_ :: ('Summary ?> a) => a -> 'Summary > a -summary_ = WithAttributes () - -summary_A :: ('Summary a) b => a -> b -> ('Summary :@: a) b -summary_A = WithAttributes - -sup_ :: ('Sup ?> a) => a -> 'Sup > a -sup_ = WithAttributes () - -sup_A :: ('Sup a) b => a -> b -> ('Sup :@: a) b -sup_A = WithAttributes - -svg_ :: ('Svg ?> a) => a -> 'Svg > a -svg_ = WithAttributes () - -svg_A :: ('Svg a) b => a -> b -> ('Svg :@: a) b -svg_A = WithAttributes - -table_ :: ('Table ?> a) => a -> 'Table > a -table_ = WithAttributes () - -table_A :: ('Table a) b => a -> b -> ('Table :@: a) b -table_A = WithAttributes - -tbody_ :: ('Tbody ?> a) => a -> 'Tbody > a -tbody_ = WithAttributes () - -tbody_A :: ('Tbody a) b => a -> b -> ('Tbody :@: a) b -tbody_A = WithAttributes - -td_ :: ('Td ?> a) => a -> 'Td > a -td_ = WithAttributes () - -td_A :: ('Td a) b => a -> b -> ('Td :@: a) b -td_A = WithAttributes - -template_ :: ('Template ?> a) => a -> 'Template > a -template_ = WithAttributes () - -template_A :: ('Template a) b => a -> b -> ('Template :@: a) b -template_A = WithAttributes - -textarea_ :: ('Textarea ?> a) => a -> 'Textarea > a -textarea_ = WithAttributes () - -textarea_A :: ('Textarea a) b => a -> b -> ('Textarea :@: a) b -textarea_A = WithAttributes - -tfoot_ :: ('Tfoot ?> a) => a -> 'Tfoot > a -tfoot_ = WithAttributes () - -tfoot_A :: ('Tfoot a) b => a -> b -> ('Tfoot :@: a) b -tfoot_A = WithAttributes - -th_ :: ('Th ?> a) => a -> 'Th > a -th_ = WithAttributes () - -th_A :: ('Th a) b => a -> b -> ('Th :@: a) b -th_A = WithAttributes - -thead_ :: ('Thead ?> a) => a -> 'Thead > a -thead_ = WithAttributes () - -thead_A :: ('Thead a) b => a -> b -> ('Thead :@: a) b -thead_A = WithAttributes - -time_ :: ('Time ?> a) => a -> 'Time > a -time_ = WithAttributes () - -time_A :: ('Time a) b => a -> b -> ('Time :@: a) b -time_A = WithAttributes - -title_ :: ('Title ?> a) => a -> 'Title > a -title_ = WithAttributes () - -title_A :: ('Title a) b => a -> b -> ('Title :@: a) b -title_A = WithAttributes - -tr_ :: ('Tr ?> a) => a -> 'Tr > a -tr_ = WithAttributes () - -tr_A :: ('Tr a) b => a -> b -> ('Tr :@: a) b -tr_A = WithAttributes - -track_ :: 'Track > () -track_ = WithAttributes () () - -track_A :: ('Track a) () => a -> ('Track :@: a) () -track_A = flip WithAttributes () - -tt_ :: ('Tt ?> a) => a -> 'Tt > a -tt_ = WithAttributes () - -tt_A :: ('Tt a) b => a -> b -> ('Tt :@: a) b -tt_A = WithAttributes - -u_ :: ('U ?> a) => a -> 'U > a -u_ = WithAttributes () - -u_A :: ('U a) b => a -> b -> ('U :@: a) b -u_A = WithAttributes - -ul_ :: ('Ul ?> a) => a -> 'Ul > a -ul_ = WithAttributes () - -ul_A :: ('Ul a) b => a -> b -> ('Ul :@: a) b -ul_A = WithAttributes - -var_ :: ('Var ?> a) => a -> 'Var > a -var_ = WithAttributes () - -var_A :: ('Var a) b => a -> b -> ('Var :@: a) b -var_A = WithAttributes - -video_ :: ('Video ?> a) => a -> 'Video > a -video_ = WithAttributes () - -video_A :: ('Video a) b => a -> b -> ('Video :@: a) b -video_A = WithAttributes - -wbr_ :: 'Wbr > () -wbr_ = WithAttributes () () - -wbr_A :: ('Wbr a) () => a -> ('Wbr :@: a) () -wbr_A = flip WithAttributes () - -xmp_ :: ('Xmp ?> a) => a -> 'Xmp > a -xmp_ = WithAttributes () - -xmp_A :: ('Xmp a) b => a -> b -> ('Xmp :@: a) b -xmp_A = WithAttributes diff --git a/src/Html/Element/Obsolete.hs b/src/Html/Element/Obsolete.hs new file mode 100644 --- /dev/null +++ b/src/Html/Element/Obsolete.hs @@ -0,0 +1,105 @@ +{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} +{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} + +module Html.Element.Obsolete where + +import Html.Type.Internal + +-- | Functions to create obsolete html elements. +-- +-- Usage: +-- +-- >>> center :> "barf" +--
barf
+ +type CustomElementDefault x + = Element + x + '[Metadata, Flow, Sectioning, Heading, Phrasing, Embedded, Interactive, Palpable, Scripting] (Metadata :|: Flow :|: Sectioning :|: Heading :|: Phrasing :|: Embedded :|: Interactive :|: Palpable :|: Scripting) + '[] + +applet :: CustomElementDefault "applet" +applet = CustomElement + +acronym :: CustomElementDefault "acronym" +acronym = CustomElement + +bgsound :: CustomElementDefault "bgsound" +bgsound = CustomElement + +dir :: CustomElementDefault "dir" +dir = CustomElement + +frame :: CustomElementDefault "frame" +frame = CustomElement + +frameset :: CustomElementDefault "frameset" +frameset = CustomElement + +noframes :: CustomElementDefault "noframes" +noframes = CustomElement + +isindex :: CustomElementDefault "isindex" +isindex = CustomElement + +keygen :: CustomElementDefault "keygen" +keygen = CustomElement + +listing :: CustomElementDefault "listing" +listing = CustomElement + +menuitem :: CustomElementDefault "menuitem" +menuitem = CustomElement + +nextid :: CustomElementDefault "nextid" +nextid = CustomElement + +noembed :: CustomElementDefault "noembed" +noembed = CustomElement + +plaintext :: CustomElementDefault "plaintext" +plaintext = CustomElement + +rb :: CustomElementDefault "rb" +rb = CustomElement + +rtc :: CustomElementDefault "rtc" +rtc = CustomElement + +strike :: CustomElementDefault "strike" +strike = CustomElement + +xmp :: CustomElementDefault "xmp" +xmp = CustomElement + +basefont :: CustomElementDefault "basefont" +basefont = CustomElement + +big :: CustomElementDefault "big" +big = CustomElement + +blink :: CustomElementDefault "blink" +blink = CustomElement + +center :: CustomElementDefault "center" +center = CustomElement + +font :: CustomElementDefault "font" +font = CustomElement + +marquee :: CustomElementDefault "marquee" +marquee = CustomElement + +multicol :: CustomElementDefault "multicol" +multicol = CustomElement + +nobr :: CustomElementDefault "nobr" +nobr = CustomElement + +spacer :: CustomElementDefault "spacer" +spacer = CustomElement + +tt :: CustomElementDefault "tt" +tt = CustomElement diff --git a/src/Html/Reify.hs b/src/Html/Reify.hs --- a/src/Html/Reify.hs +++ b/src/Html/Reify.hs @@ -8,7 +8,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE GADTs #-} @@ -96,7 +95,7 @@ , R u (One (Proxy s)) , Semigroup (RenderOutput u) ) => R u (T '[s] (a := b)) where - render (T (AT x)) = render (One (Proxy @ s)) <> render (T x :: T '[ "" ] b) + render (T (_ := x)) = render (One (Proxy @ s)) <> render (T x :: T '[ "" ] b) instance {-# INCOHERENT #-} ( R u (T '[ "" ] val) @@ -125,22 +124,34 @@ render (T t) = render (T t :: T xs val) <> render (One (Proxy @ x)) instance - ( R u (T (Take (Length b) ps) b) - , R u (T (Drop (Length b) ps) c) + ( R u (T (Take (Length a) ps) a) + , R u (T (Drop (Length a) ps) b) , Semigroup (RenderOutput u) - ) => R u (T ps ((a :@: b) c)) where - render (T ~(WithAttributes b c)) - = render (T b :: T (Take (Length b) ps) b) - <> render (T c :: T (Drop (Length b) ps) c) + ) => R u (T ps (a # b)) where + render (T ~(a :#: b)) + = render (T a :: T (Take (Length a) ps) a) + <> render (T b :: T (Drop (Length a) ps) b) instance ( R u (T (Take (Length a) ps) a) , R u (T (Drop (Length a) ps) b) , Semigroup (RenderOutput u) - ) => R u (T ps (a # b)) where - render (T ~(a :#: b)) + ) => R u (T ps (a :> b)) where + render (T ~(a :> b)) = render (T a :: T (Take (Length a) ps) a) <> render (T b :: T (Drop (Length a) ps) b) + +instance + ( R u (T (Drop 0 ps) b) + ) => R u (T ps (a :@ b)) where + render (T ~(_ :@ b)) + = render (T b :: T (Drop 0 ps) b) + +instance + ( R u (T ps a) + ) => R u (T ps (Lawless a)) where + render (T ~(Lawless a)) + = render (T a :: T ps a) instance ( R u (T (ToList a) a) diff --git a/src/Html/Type.hs b/src/Html/Type.hs --- a/src/Html/Type.hs +++ b/src/Html/Type.hs @@ -1,24 +1,25 @@ {-# LANGUAGE ExplicitNamespaces #-} module Html.Type - ( type (>) - , type (:@:)(..) - , type (#)(..) + ( type (#)(..) , (#) - , type (?>) - , type () - , type (:=)(..) - , Raw(..) - , Attribute(..) + , (:>)(..) + , (:@)(..) + , (:=)(..) , Element(..) + , Attribute(..) , CompactHTML , Put(..) , V(..) + , Raw(..) + , Lawless(..) , Retrievable , Retrieve , Variables , Document , Compactable + , ContentCategory(..) + , type (&) ) where import Html.Type.Internal diff --git a/src/Html/Type/Internal.hs b/src/Html/Type/Internal.hs --- a/src/Html/Type/Internal.hs +++ b/src/Html/Type/Internal.hs @@ -7,932 +7,1525 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE PolyKinds #-} -{-# LANGUAGE GADTs #-} - -{-# LANGUAGE CPP #-} -- Compatibility with ghc8.2 - -module Html.Type.Internal where - -import GHC.TypeLits -import GHC.Exts (Constraint) -import Data.Proxy -import Data.Type.Bool -import Data.ByteString (ByteString) - -{-# DEPRECATED - - Acronym , - Applet , - Basefont , - Big , - Blink , - Center , - Command , - Content , - Dir , - Font , - Frame , - Frameset , - Isindex , - Keygen , - Listing , - Marquee , - Multicol , - Noembed , - Plaintext , - Shadow , - Spacer , - Strike , - Tt , - Xmp , - Nextid - - "This is an obsolete html element and should not be used." #-} - --- | Data for declaring variables in a html document which will be compacted. -data V (n :: Symbol) = V - -newtype One a = One a - --- | Unique set of variables in a html document in the order of occurence. -type Variables a = Dedupe (GetV a) - --- | A compacted html documented with it's variables annoted as a list of Symbols. -data CompactHTML (a :: [Symbol]) = MkCompactHTML ByteString [(Int, ByteString)] deriving Show - -type family GetV a :: [Symbol] where - GetV (a # b) = Append (GetV a) (GetV b) - GetV ((a :@: b) c) = Append (GetV b) (GetV c) - GetV (a := b) = GetV b - GetV (Maybe a) = GetV a - GetV [a] = GetV a - GetV (Either a b) = Append (GetV a) (GetV b) - GetV (V v) = '[v] - GetV x = '[] - -type family Reverse xs where - Reverse xs = Reverse' xs '[] - -type family Reverse' xs ys where - Reverse' (x':xs) ys = Reverse' xs (x':ys) - Reverse' '[] ys = ys - -type family Dedupe xs :: [Symbol] where - Dedupe (x ': xs) = x ': Dedupe (Delete x xs) - Dedupe '[] = '[] - -type family Delete x xs :: [Symbol] where - Delete x (x ': xs) = Delete x xs - Delete x (y ': xs) = y ': Delete x xs - Delete _ _ = '[] - -class ShowTypeList a where - showTypeList :: [String] - -instance (ShowTypeList xs, KnownSymbol x) => ShowTypeList (x ': xs) where - showTypeList = symbolVal (Proxy @ x) : showTypeList @ xs - -instance ShowTypeList '[] where - showTypeList = [] - --- | The data type of all html elements and the kind of elements. -data Element - = DOCTYPE - - | A - | Abbr - | Acronym - | Address - | Applet - | Area - | Article - | Aside - | Audio - | B - | Base - | Basefont - | Bdi - | Bdo - | Bgsound - | Big - | Blink - | Blockquote - | Body - | Br - | Button - | Canvas - | Caption - | Center - | Cite - | Code - | Col - | Colgroup - | Command - | Content - | Data - | Datalist - | Dd - | Del - | Details - | Dfn - | Dialog - | Dir - | Div - | Dl - | Dt - | Element - | Em - | Embed - | Fieldset - | Figcaption - | Figure - | Font - | Footer - | Form - | Frame - | Frameset - | H1 - | H2 - | H3 - | H4 - | H5 - | H6 - | Head - | Header - | Hgroup - | Hr - | Html - | I - | Iframe - | Image - | Img - | Input - | Ins - | Isindex - | Kbd - | Keygen - | Label - | Legend - | Li - | Link - | Listing - | Main - | Map - | Mark - | Marquee - | Math - | Menu - | Menuitem - | Meta - | Meter - | Multicol - | Nav - | Nextid - | Nobr - | Noembed - | Noframes - | Noscript - | Object - | Ol - | Optgroup - | Option - | Output - | P - | Param - | Picture - | Plaintext - | Pre - | Progress - | Q - | Rp - | Rt - | Rtc - | Ruby - | S - | Samp - | Script - | Section - | Select - | Shadow - | Slot - | Small - | Source - | Spacer - | Span - | Strike - | Strong - | Style - | Sub - | Summary - | Sup - | Svg - | Table - | Tbody - | Td - | Template - | Textarea - | Tfoot - | Th - | Thead - | Time - | Title - | Tr - | Track - | Tt - | U - | Ul - | Var - | Video - | Wbr - | Xmp - -data Attribute - = RoleA - | AriaActivedescendantA - | AriaAtomicA - | AriaAutocompleteA - | AriaBusyA - | AriaCheckedA - | AriaControlsA - | AriaDescribedbyA - | AriaDisabledA - | AriaDropeffectA - | AriaExpandedA - | AriaFlowtoA - | AriaGrabbedA - | AriaHaspopupA - | AriaHiddenA - | AriaInvalidA - | AriaLabelA - | AriaLabelledByA - | AriaLevelA - | AriaLiveA - | AriaMultilineA - | AriaMultiselectableA - | AriaOwnsA - | AriaPosinsetA - | AriaPressedA - | AriaReadonlyA - | AriaRelevantA - | AriaRequiredA - | AriaSelectedA - | AriaSetsizeA - | AriaSortA - | AriaValuemaxA - | AriaValueminA - | AriaValuenowA - | AriaValuetextA - - | AcceptA - | AcceptCharsetA - | AccesskeyA - | ActionA - | AllowfullscreenA - | AllowpaymentrequestA - | AlignA - | AltA - | AsyncA - | AutocompleteA - | AutofocusA - | AutoplayA - | AutosaveA - | BgcolorA - | BorderA - | BufferedA - | ChallengeA - | CharsetA - | CheckedA - | CiteA - | ClassA - | CodeA - | CodebaseA - | ColorA - | ColsA - | ColspanA - | ContentA - | ContenteditableA - | ContextmenuA - | ControlsA - | CoordsA - | CrossoriginA - | DataA - | DatetimeA - | DefaultA - | DeferA - | DirA - | DirnameA - | DisabledA - | DownloadA - | DraggableA - | DropzoneA - | EnctypeA - | ForA - | FormA - | FormactionA - | FormenctypeA - | FormmethodA - | FormnovalidateA - | FormtargetA - | HeadersA - | HeightA - | HiddenA - | HighA - | HrefA - | HreflangA - | HttpEquivA - | IconA - | IdA - | IntegrityA - | IsmapA - | ItempropA - | KeytypeA - | KindA - | LabelA - | LangA - | LanguageA - | ListA - | LongdescA - | LoopA - | LowA - | ManifestA - | MaxA - | MaxlengthA - | MediaA - | MethodA - | MinA - | MinlengthA - | MultipleA - | MutedA - | NameA - | NonceA - | NovalidateA - | OpenA - | OptimumA - | PatternA - | PingA - | PlaceholderA - | PosterA - | PreloadA - | RadiogroupA - | ReadonlyA - | ReferrerpolicyA - | RelA - | RequiredA - | RevA - | ReversedA - | RowsA - | RowspanA - | SandboxA - | ScopeA - | ScopedA - | SeamlessA - | SelectedA - | ShapeA - | SizeA - | SizesA - | SlotA - | SpanA - | SpellcheckA - | SrcA - | SrcdocA - | SrclangA - | SrcsetA - | StartA - | StepA - | StyleA - | SummaryA - | TabindexA - | TargetA - | TitleA - | TranslateA - | TypeA - | TypemustmatchA - | UsemapA - | ValueA - | WidthA - | WrapA - - | CustomA Symbol - --- | We need efficient cons, snoc and append. This API has cons(O1) --- and snoc(O1) but append(On). Optimal would be a FingerTree. -data List = List [Symbol] Symbol - -type family (<|) s t :: List where - (<|) l ('List (s ': ss) r) = 'List (AppendSymbol l s ': ss) r - (<|) l ('List '[] r) = 'List '[] (AppendSymbol l r) - -type family (|>) t s :: List where - (|>) ('List ss r) rr = 'List ss (AppendSymbol r rr) - -type family (><) t1 t2 :: List where - (><) ('List ss r) ('List (s ': ss2) r2) = 'List (Append ss (AppendSymbol r s ': ss2)) r2 - (><) ('List ss r) ('List '[] r2) = 'List ss (AppendSymbol r r2) - -type OpenTag e = AppendSymbol "<" (AppendSymbol (ShowElement e) ">") - -type CloseTag e = AppendSymbol "") - --- | Flatten a document into a type list of tags. -type family ToList a :: List where - ToList (a # b) = ToList a >< ToList b - ToList ((a :@: ()) ()) = 'List '[] (If (HasContent (GetEInfo a)) (AppendSymbol (OpenTag a) (CloseTag a)) (OpenTag a)) - ToList ((a :@: b) ()) = AppendSymbol "<" (ShowElement a) <| ToList b |> If (HasContent (GetEInfo a)) (AppendSymbol ">" (CloseTag a)) ">" - ToList ((a :@: ()) b) = OpenTag a <| ToList b |> CloseTag a - ToList ((a :@: b) c) = (AppendSymbol "<" (ShowElement a) <| ToList b) >< (">" <| ToList c |> CloseTag a) - ToList (a := ()) = 'List '[] (AppendSymbol " " (ShowAttribute a)) - ToList (a := b) = AppendSymbol " " (AppendSymbol (ShowAttribute a) "=\"") <| ToList b |> "\"" - ToList () = 'List '[] "" - ToList (Proxy x) = 'List '[] x - ToList x = 'List '[""] "" - -newtype (:=) (a :: Attribute) b = AT b - --- | Check whether `b` is a valid child of `a`. -type a ?> b = Check Element a b - --- | Check whether `a` is a valid attribute and `b` is a valid child of `p`. -type () p a b = (Check Attribute p a, Check Element p b) - -type TextE a = Text (EInfoName (GetEInfo a)) -type TextA a = Text (AInfoName (GetAInfo a)) -type TagE a = Text "<" :<>: TextE a :<>: Text ">" - -type family Check f a b :: Constraint where - Check _ _ () = () - Check _ _ (Raw _) = () - Check f a (b # c) = (Check f a b, Check f a c) - Check f a (Maybe b) = Check f a b - Check f a (Either b c) = (Check f a b, Check f a c) --- Check f a (b -> c) = TypeError (ShowType a :<>: Text " can't contain a function.") - Check f a (b -> c) = TypeError (TagE a :<>: Text " can't contain a function.") - Check Element a ((b :@: _) _) = MaybeTypeError a b (CheckContentCategory (EInfoContent (GetEInfo a)) (SingleElement b ': EInfoCategories (GetEInfo b))) - Check Element a (f ((b :@: c) d)) = Check Element a ((b :@: c) d) - Check Element a (f (b # c)) = Check Element a (b # c) - Check Element a (b := c) = TypeError (TagE a :<>: Text " can't contain an attribute." :$$: Text "Try '" :<>: TextE a :<>: Text "_A' instead.") - Check Element a b = CheckString a b - Check Attribute a (b := _) = If (Elem a (AInfoElements (GetAInfo b)) || Null (AInfoElements (GetAInfo b))) - (() :: Constraint) - (TypeError (TextA b :<>: Text " is not a valid attribute of " :<>: TagE a :<>: Text ".")) - Check Attribute _ b = TypeError (ShowType b :<>: Text " is not an attribute.") - --- | Combine two elements or attributes sequentially. --- --- >>> i_ () # div_ () ---
--- --- >>> i_A (A.id_ "a" # A.class_ "b") "c" --- c -data (#) a b = (:#:) a b -{-# INLINE (#) #-} -(#) :: a -> b -> a # b -(#) = (:#:) -infixr 5 # - --- | Type synonym for elements without attributes. -type (>) a b = (:@:) a () b -infixr 6 > - --- | Decorate an element with attributes and descend to a valid child. --- It is recommended to use the predefined elements. --- --- >>> WithAttributes (A.class_ "bar") "a" :: ('Div :@: ('ClassA := String)) String ---
a
--- --- >>> div_A (A.class_ "bar") "a" ---
a
--- --- >>> div_ "a" ---
a
-data (:@:) (a :: Element) b c where - WithAttributes :: (a b) c => b -> c -> (a :@: b) c -infixr 8 :@: - --- | Wrapper for types which won't be escaped. -newtype Raw a = Raw {fromRaw :: a} - -type family Null xs where - Null '[] = True - Null _ = False - -type family Length c where - Length (a # b) = Length a + Length b - Length ((_ :@: b) c) = Length b + Length c - Length (_ := b) = Length b - Length () = 0 - Length (Proxy _) = 0 - Length _ = 1 - --- | Check whether an element may have content. -type family HasContent a where - HasContent (EInfo _ _ NoContent) = False - HasContent _ = True - --- | Append two type lists. --- --- Note that this definition is that ugly to reduce compiletimes. --- Please check whether the context reduction stack or compiletimes of --- a big html page get bigger if you try to refactor. -type family Append xs ys :: [k] where - - Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': xs) ys - = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': Append xs ys - - Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': xs) ys - = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': Append xs ys - - Append (x1 ': x2 ': x3 ': x4 ': xs) ys - = x1 ': x2 ': x3 ': x4 ': Append xs ys - - Append (x1 ': x2 ': xs) ys - = x1 ': x2 ': Append xs ys - - Append (x1 ': xs) ys - = x1 ': Append xs ys - - Append '[] ys - = ys - --- | Type level drop. --- --- Note that this definition is that ugly to reduce compiletimes. --- Please check whether the context reduction stack or compiletimes of --- a big html page get bigger if you try to refactor. -type family Drop n xs :: [k] where - Drop 0 xs = xs - Drop 1 (_ ': xs) = xs - Drop 2 (_ ': _ ': xs) = xs - Drop 4 (_ ': _ ': _ ': _ ': xs) = xs -#if __GLASGOW_HASKELL__ >= 804 - Drop 8 (_ ': _ ': _ ': _ ': _ ': _ ': _ ': _ ': xs) = xs - Drop n xs = Drop (n - 2^Log2 n) (Drop (2^(Log2 n-1)) (Drop (2^(Log2 n-1)) xs)) -#else - Drop 3 (_ ': _ ': _ ': xs) = xs - Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs -#endif - --- | Type level take. --- --- Note that this definition is that ugly to reduce compiletimes. --- Please check whether the context reduction stack or compiletimes of --- a big html page get bigger if you try to refactor. -type family Take n xs :: [k] where - Take 0 _ = '[] - Take 1 (x1 ': _) = '[x1] - Take 2 (x1 ': x2 ': _) = '[x1, x2] - Take 3 (x1 ': x2 ': x3 ': _) = '[x1, x2, x3] - Take 4 (x1 ': x2 ': x3 ': x4 ': _) = '[x1, x2, x3, x4] - Take 5 (x1 ': x2 ': x3 ': x4 ': x5 ': _) = '[x1, x2, x3, x4, x5] - Take 6 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': _) = '[x1, x2, x3, x4, x5, x6] - Take 7 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': _) = '[x1, x2, x3, x4, x5, x6, x7] - Take 8 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8] - Take 9 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8, x9] - Take n (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': Take (n-10) xs - --- | Type of type level information about tags. -data EInfo - (name :: Symbol) - (contentCategories :: [ContentCategory]) - (permittedContent :: ContentCategory) - -type family EInfoName x where EInfoName (EInfo n _ _) = n -type family EInfoCategories x where EInfoCategories (EInfo _ cs _) = cs -type family EInfoContent x where EInfoContent (EInfo _ _ c) = c - -type ShowElement (x :: Element) = EInfoName (GetEInfo x) - -type family CheckContentCategory (a :: ContentCategory) (b :: [ContentCategory]) :: Bool where - CheckContentCategory (a :|: b) c = CheckContentCategory a c || CheckContentCategory b c - CheckContentCategory (a :&: b) c = CheckContentCategory a c && CheckContentCategory b c - CheckContentCategory (NOT a) c = Not (CheckContentCategory a c) - CheckContentCategory a c = Elem a c - --- | Check whether a given element may contain a non document type. -type family CheckString (a :: Element) b where - CheckString a b = If (CheckContentCategory (EInfoContent (GetEInfo a)) '[OnlyText, FlowContent, PhrasingContent]) - (() :: Constraint) - (TypeError (TagE a :<>: Text " can't contain a " :<>: ShowType b)) - --- | Content categories according to the html spec. -data ContentCategory - = MetadataContent - | FlowContent - | SectioningContent - | HeadingContent - | PhrasingContent - | (:|:) ContentCategory ContentCategory - | (:&:) ContentCategory ContentCategory - | NOT ContentCategory - | NoContent - | OnlyText - | SingleElement Element - -infixr 2 :|: -infixr 3 :&: - -type family MaybeTypeError (a :: Element) (b :: Element) c where - MaybeTypeError a b c = If c (() :: Constraint) - (TypeError (TagE b :<>: Text " is not a valid child of " :<>: TagE a :<>: Text ".")) - -type family Elem (a :: k) (xs :: [k]) where - Elem a (a : xs) = True - Elem a (_ : xs) = Elem a xs - Elem a '[] = False - -newtype T (proxies :: k) target = T target - -data AInfo (name :: Symbol) (elements :: [Element]) -type ShowAttribute (x :: Attribute) = AInfoName (GetAInfo x) -type family AInfoElements x where AInfoElements (AInfo _ es) = es -type family AInfoName x where AInfoName (AInfo s _) = s - --- | Get type list of valid elements for a given attribute. An empty list signifies global attribute. -type family GetAInfo a where - - GetAInfo RoleA = AInfo "role" '[] - GetAInfo AriaActivedescendantA = AInfo "aria-activedescendant" '[] - GetAInfo AriaAtomicA = AInfo "aria-atomic" '[] - GetAInfo AriaAutocompleteA = AInfo "aria-autocomplete" '[] - GetAInfo AriaBusyA = AInfo "aria-busy" '[] - GetAInfo AriaCheckedA = AInfo "aria-checked" '[] - GetAInfo AriaControlsA = AInfo "aria-controls" '[] - GetAInfo AriaDescribedbyA = AInfo "aria-describedby" '[] - GetAInfo AriaDisabledA = AInfo "aria-disabled" '[] - GetAInfo AriaDropeffectA = AInfo "aria-dropeffect" '[] - GetAInfo AriaExpandedA = AInfo "aria-expanded" '[] - GetAInfo AriaFlowtoA = AInfo "aria-flowto" '[] - GetAInfo AriaGrabbedA = AInfo "aria-grabbed" '[] - GetAInfo AriaHaspopupA = AInfo "aria-haspopup" '[] - GetAInfo AriaHiddenA = AInfo "aria-hidden" '[] - GetAInfo AriaInvalidA = AInfo "aria-invalid" '[] - GetAInfo AriaLabelA = AInfo "aria-label" '[] - GetAInfo AriaLabelledByA = AInfo "aria-labelledBy" '[] - GetAInfo AriaLevelA = AInfo "aria-level" '[] - GetAInfo AriaLiveA = AInfo "aria-live" '[] - GetAInfo AriaMultilineA = AInfo "aria-multiline" '[] - GetAInfo AriaMultiselectableA = AInfo "aria-multiselectable" '[] - GetAInfo AriaOwnsA = AInfo "aria-owns" '[] - GetAInfo AriaPosinsetA = AInfo "aria-posinset" '[] - GetAInfo AriaPressedA = AInfo "aria-pressed" '[] - GetAInfo AriaReadonlyA = AInfo "aria-readonly" '[] - GetAInfo AriaRelevantA = AInfo "aria-relevant" '[] - GetAInfo AriaRequiredA = AInfo "aria-required" '[] - GetAInfo AriaSelectedA = AInfo "aria-selected" '[] - GetAInfo AriaSetsizeA = AInfo "aria-setsize" '[] - GetAInfo AriaSortA = AInfo "aria-sort" '[] - GetAInfo AriaValuemaxA = AInfo "aria-valuemax" '[] - GetAInfo AriaValueminA = AInfo "aria-valuemin" '[] - GetAInfo AriaValuenowA = AInfo "aria-valuenow" '[] - GetAInfo AriaValuetextA = AInfo "aria-valuetext" '[] - - GetAInfo AcceptA = AInfo "accept" '[Form, Input] - GetAInfo AcceptCharsetA = AInfo "accept-charset" '[Form] - GetAInfo AccesskeyA = AInfo "accesskey" '[] - GetAInfo ActionA = AInfo "action" '[Form] - GetAInfo AllowfullscreenA = AInfo "allowfullscreen" '[Iframe] - GetAInfo AllowpaymentrequestA = AInfo "allowpaymentrequest" '[Iframe] - GetAInfo AlignA = AInfo "align" '[Applet, Caption, Col, Colgroup, Hr, Iframe, Img, Table, Tbody, Td, Tfoot, Th, Thead, Tr] - GetAInfo AltA = AInfo "alt" '[Applet, Area, Img, Input] - GetAInfo AsyncA = AInfo "async" '[Script] - GetAInfo AutocompleteA = AInfo "autocomplete" '[Form, Input] - GetAInfo AutofocusA = AInfo "autofocus" '[Button, Input, Keygen, Select, Textarea] - GetAInfo AutoplayA = AInfo "autoplay" '[Audio, Video] - GetAInfo AutosaveA = AInfo "autosave" '[Input] - GetAInfo BgcolorA = AInfo "bgcolor" '[Body, Col, Colgroup, Marquee, Table, Tbody, Tfoot, Td, Th, Tr] - GetAInfo BorderA = AInfo "border" '[Img, Object, Table] - GetAInfo BufferedA = AInfo "buffered" '[Audio, Video] - GetAInfo ChallengeA = AInfo "challenge" '[Keygen] - GetAInfo CharsetA = AInfo "charset" '[Meta, Script] - GetAInfo CheckedA = AInfo "checked" '[Command, Input] - GetAInfo CiteA = AInfo "cite" '[Blockquote, Del, Ins, Q] - GetAInfo ClassA = AInfo "class" '[] - GetAInfo CodeA = AInfo "code" '[Applet] - GetAInfo CodebaseA = AInfo "codebase" '[Applet] - GetAInfo ColorA = AInfo "color" '[Basefont, Font, Hr] - GetAInfo ColsA = AInfo "cols" '[Textarea] - GetAInfo ColspanA = AInfo "colspan" '[Td, Th] - GetAInfo ContentA = AInfo "content" '[Meta] - GetAInfo ContenteditableA = AInfo "contenteditable" '[] - GetAInfo ContextmenuA = AInfo "contextmenu" '[] - GetAInfo ControlsA = AInfo "controls" '[Audio, Video] - GetAInfo CoordsA = AInfo "coords" '[Area] - GetAInfo CrossoriginA = AInfo "crossorigin" '[Audio, Img, Link, Script, Video] - GetAInfo DataA = AInfo "data" '[Object] - GetAInfo DatetimeA = AInfo "datetime" '[Del, Ins, Time] - GetAInfo DefaultA = AInfo "default" '[Track] - GetAInfo DeferA = AInfo "defer" '[Script] - GetAInfo DirA = AInfo "dir" '[] - GetAInfo DirnameA = AInfo "dirname" '[Input, Textarea] - GetAInfo DisabledA = AInfo "disabled" '[Button, Command, Fieldset, Input, Keygen, Optgroup, Option, Select, Textarea] - GetAInfo DownloadA = AInfo "download" '[A, Area] - GetAInfo DraggableA = AInfo "draggable" '[] - GetAInfo DropzoneA = AInfo "dropzone" '[] - GetAInfo EnctypeA = AInfo "enctype" '[Form] - GetAInfo ForA = AInfo "for" '[Label, Output] - GetAInfo FormA = AInfo "form" '[Button, Fieldset, Input, Keygen, Label, Meter, Object, Output, Progress, Select, Textarea] - GetAInfo FormactionA = AInfo "formaction" '[Input, Button] - GetAInfo FormenctypeA = AInfo "formenctype" '[Button, Input] - GetAInfo FormmethodA = AInfo "formmethod" '[Button, Input] - GetAInfo FormnovalidateA = AInfo "formnovalidate" '[Button, Input] - GetAInfo FormtargetA = AInfo "formtarget" '[Button, Input] - GetAInfo HeadersA = AInfo "headers" '[Td, Th] - GetAInfo HeightA = AInfo "height" '[Canvas, Embed, Iframe, Img, Input, Object, Video] - GetAInfo HiddenA = AInfo "hidden" '[] - GetAInfo HighA = AInfo "high" '[Meter] - GetAInfo HrefA = AInfo "href" '[A, Area, Base, Link] - GetAInfo HreflangA = AInfo "hreflang" '[A, Area, Link] - GetAInfo HttpEquivA = AInfo "httpEquiv" '[Meta] - GetAInfo IconA = AInfo "icon" '[Command] - GetAInfo IdA = AInfo "id" '[] - GetAInfo IntegrityA = AInfo "integrity" '[Link, Script] - GetAInfo IsmapA = AInfo "ismap" '[Img] - GetAInfo ItempropA = AInfo "itemprop" '[] - GetAInfo KeytypeA = AInfo "keytype" '[Keygen] - GetAInfo KindA = AInfo "kind" '[Track] - GetAInfo LabelA = AInfo "label" '[Track] - GetAInfo LangA = AInfo "lang" '[] - GetAInfo LanguageA = AInfo "language" '[Script] - GetAInfo ListA = AInfo "list" '[Input] - GetAInfo LongdescA = AInfo "longdesc" '[Img] - GetAInfo LoopA = AInfo "loop" '[Audio, Bgsound, Marquee, Video] - GetAInfo LowA = AInfo "low" '[Meter] - GetAInfo ManifestA = AInfo "manifest" '[Html] - GetAInfo MaxA = AInfo "max" '[Input, Meter, Progress] - GetAInfo MaxlengthA = AInfo "maxlength" '[Input, Textarea] - GetAInfo MediaA = AInfo "media" '[A, Area, Link, Source, Style] - GetAInfo MethodA = AInfo "method" '[Form] - GetAInfo MinA = AInfo "min" '[Input, Meter] - GetAInfo MinlengthA = AInfo "minlength" '[Input, Textarea] - GetAInfo MultipleA = AInfo "multiple" '[Input, Select] - GetAInfo MutedA = AInfo "muted" '[Video] - GetAInfo NameA = AInfo "name" '[Button, Form, Fieldset, Iframe, Input, Keygen, Object, Output, Select, Textarea, Map, Meta, Param] - GetAInfo NonceA = AInfo "nonce" '[Link, Script, Style] - GetAInfo NovalidateA = AInfo "novalidate" '[Form] - GetAInfo OpenA = AInfo "open" '[Details] - GetAInfo OptimumA = AInfo "optimum" '[Meter] - GetAInfo PatternA = AInfo "pattern" '[Input] - GetAInfo PingA = AInfo "ping" '[A, Area] - GetAInfo PlaceholderA = AInfo "placeholder" '[Input, Textarea] - GetAInfo PosterA = AInfo "poster" '[Video] - GetAInfo PreloadA = AInfo "preload" '[Audio, Video] - GetAInfo RadiogroupA = AInfo "radiogroup" '[Command] - GetAInfo ReadonlyA = AInfo "readonly" '[Input, Textarea] - GetAInfo ReferrerpolicyA = AInfo "referrerpolicy" '[A, Area, Iframe, Img, Link] - GetAInfo RelA = AInfo "rel" '[A, Area, Link] - GetAInfo RequiredA = AInfo "required" '[Input, Select, Textarea] - GetAInfo RevA = AInfo "rev" '[A, Link] - GetAInfo ReversedA = AInfo "reversed" '[Ol] - GetAInfo RowsA = AInfo "rows" '[Textarea] - GetAInfo RowspanA = AInfo "rowspan" '[Td, Th] - GetAInfo SandboxA = AInfo "sandbox" '[Iframe] - GetAInfo ScopeA = AInfo "scope" '[Th] - GetAInfo ScopedA = AInfo "scoped" '[Style] - GetAInfo SeamlessA = AInfo "seamless" '[Iframe] - GetAInfo SelectedA = AInfo "selected" '[Option] - GetAInfo ShapeA = AInfo "shape" '[A, Area] - GetAInfo SizeA = AInfo "size" '[Input, Select] - GetAInfo SizesA = AInfo "sizes" '[Link, Img, Source] - GetAInfo SlotA = AInfo "slot" '[] - GetAInfo SpanA = AInfo "span" '[Col, Colgroup] - GetAInfo SpellcheckA = AInfo "spellcheck" '[] - GetAInfo SrcA = AInfo "src" '[Audio, Embed, Iframe, Img, Input, Script, Source, Track, Video] - GetAInfo SrcdocA = AInfo "srcdoc" '[Iframe] - GetAInfo SrclangA = AInfo "srclang" '[Track] - GetAInfo SrcsetA = AInfo "srcset" '[Img] - GetAInfo StartA = AInfo "start" '[Ol] - GetAInfo StepA = AInfo "step" '[Input] - GetAInfo StyleA = AInfo "style" '[] - GetAInfo SummaryA = AInfo "summary" '[Table] - GetAInfo TabindexA = AInfo "tabindex" '[] - GetAInfo TargetA = AInfo "target" '[A, Area, Base, Form] - GetAInfo TitleA = AInfo "title" '[] - GetAInfo TranslateA = AInfo "translate" '[] - GetAInfo TypeA = AInfo "type" '[Button, Input, Command, Embed, Object, Script, Source, Style, Menu, Ol, A, Area, Link] - GetAInfo TypemustmatchA = AInfo "typemustmatch" '[Object] - GetAInfo UsemapA = AInfo "usemap" '[Img, Input, Object] - GetAInfo ValueA = AInfo "value" '[Button, Option, Input, Li, Meter, Progress, Param, Data] - GetAInfo WidthA = AInfo "width" '[Canvas, Embed, Iframe, Img, Input, Object, Video] - GetAInfo WrapA = AInfo "wrap" '[Textarea] - GetAInfo (CustomA x) = AInfo x '[] - --- | Retrieve type level meta data about elements. -type family GetEInfo a = r | r -> a where - - GetEInfo DOCTYPE = EInfo "!DOCTYPE html" '[] NoContent - GetEInfo A = EInfo "a" '[ FlowContent, PhrasingContent ] (FlowContent :&: NOT (SingleElement Details) :|: PhrasingContent) - GetEInfo Abbr = EInfo "abbr" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Address = EInfo "address" '[ FlowContent ] (FlowContent :&: NOT (HeadingContent :|: SectioningContent :|: SingleElement Address :|: SingleElement Header :|: SingleElement Footer)) - GetEInfo Area = EInfo "area" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Article = EInfo "article" '[ FlowContent, SectioningContent ] FlowContent - GetEInfo Aside = EInfo "aside" '[ FlowContent, SectioningContent ] FlowContent - GetEInfo Audio = EInfo "audio" '[ FlowContent, PhrasingContent ] (SingleElement Source :|: SingleElement Track) - GetEInfo B = EInfo "b" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Base = EInfo "base" '[ MetadataContent ] NoContent - GetEInfo Bdi = EInfo "bdi" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Bdo = EInfo "bdo" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Blockquote = EInfo "blockquote" '[ FlowContent ] FlowContent - GetEInfo Body = EInfo "body" '[] FlowContent - GetEInfo Br = EInfo "br" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Button = EInfo "button" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Canvas = EInfo "canvas" '[ FlowContent, PhrasingContent ] (SingleElement A :|: SingleElement Button :|: SingleElement Input) - GetEInfo Caption = EInfo "caption" '[] FlowContent - GetEInfo Cite = EInfo "cite" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Code = EInfo "code" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Col = EInfo "col" '[] NoContent - GetEInfo Colgroup = EInfo "colgroup" '[] (SingleElement Col) - GetEInfo Data = EInfo "data" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Datalist = EInfo "datalist" '[ FlowContent, PhrasingContent ] (PhrasingContent :|: SingleElement Option) - GetEInfo Dd = EInfo "dd" '[] FlowContent - GetEInfo Del = EInfo "del" '[ FlowContent, PhrasingContent ] OnlyText - GetEInfo Details = EInfo "details" '[ FlowContent ] ( FlowContent :|: SingleElement Summary) - GetEInfo Dfn = EInfo "dfn" '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Dfn)) - GetEInfo Dialog = EInfo "dialog" '[ FlowContent ] FlowContent - GetEInfo 'Div = EInfo "div" '[ FlowContent ] (FlowContent :|: SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template) - GetEInfo Dl = EInfo "dl" '[ FlowContent ] (SingleElement Dt :|: SingleElement Dd :|: SingleElement Script :|: SingleElement Template :|: SingleElement 'Div) - GetEInfo Dt = EInfo "dt" '[] (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent)) - GetEInfo Em = EInfo "em" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Embed = EInfo "embed" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Fieldset = EInfo "fieldset" '[ FlowContent ] (FlowContent :|: SingleElement Legend) - GetEInfo Figcaption = EInfo "figcaption" '[] FlowContent - GetEInfo Figure = EInfo "figure" '[ FlowContent ] (FlowContent :|: SingleElement Figcaption) - GetEInfo Footer = EInfo "footer" '[ FlowContent ] (FlowContent :&: NOT (SingleElement Footer :|: SingleElement Header)) - GetEInfo Form = EInfo "form" '[ FlowContent ] (FlowContent :&: NOT (SingleElement Form)) - GetEInfo H1 = EInfo "h1" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo H2 = EInfo "h2" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo H3 = EInfo "h3" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo H4 = EInfo "h4" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo H5 = EInfo "h5" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo H6 = EInfo "h6" '[ FlowContent, HeadingContent ] PhrasingContent - GetEInfo Head = EInfo "head" '[] MetadataContent - GetEInfo Header = EInfo "header" '[ FlowContent ] (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer)) - GetEInfo Hgroup = EInfo "hgroup" '[ FlowContent, HeadingContent ] (SingleElement H1 :|: SingleElement H2 :|: SingleElement H3 :|: SingleElement H4 :|: SingleElement H5 :|: SingleElement H6) - GetEInfo Hr = EInfo "hr" '[ FlowContent ] NoContent - GetEInfo Html = EInfo "html" '[] (SingleElement Head :|: SingleElement Body) - GetEInfo I = EInfo "i" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Iframe = EInfo "iframe" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Img = EInfo "img" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Input = EInfo "input" '[ FlowContent, PhrasingContent ] NoContent - GetEInfo Ins = EInfo "ins" '[ FlowContent, PhrasingContent ] OnlyText - GetEInfo Kbd = EInfo "kbd" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Label = EInfo "label" '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Label)) - GetEInfo Legend = EInfo "legend" '[] PhrasingContent - GetEInfo Li = EInfo "li" '[] FlowContent - GetEInfo Link = EInfo "link" '[ FlowContent, PhrasingContent, MetadataContent ] NoContent - GetEInfo Main = EInfo "main" '[ FlowContent ] FlowContent - GetEInfo Map = EInfo "map" '[ FlowContent, PhrasingContent ] OnlyText - GetEInfo Mark = EInfo "mark" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Menu = EInfo "menu" '[ FlowContent ] (FlowContent :|: SingleElement Li :|: SingleElement Script :|: SingleElement Template :|: SingleElement Menu :|: SingleElement Menuitem :|: SingleElement Hr) - GetEInfo Menuitem = EInfo "menuitem" '[] NoContent - GetEInfo Meta = EInfo "meta" '[ FlowContent, MetadataContent, PhrasingContent ] NoContent - GetEInfo Meter = EInfo "meter" '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Meter)) - GetEInfo Nav = EInfo "nav" '[ FlowContent, SectioningContent ] FlowContent - GetEInfo Noscript = EInfo "noscript" '[ FlowContent, MetadataContent, PhrasingContent ] (FlowContent :|: PhrasingContent :|: SingleElement Link :|: SingleElement Style :|: SingleElement Meta) - GetEInfo Object = EInfo "object" '[ FlowContent, PhrasingContent ] (SingleElement Param) - GetEInfo Ol = EInfo "ol" '[ FlowContent ] (SingleElement Li) - GetEInfo Optgroup = EInfo "optgroup" '[] (SingleElement Option) - GetEInfo Option = EInfo "option" '[] OnlyText - GetEInfo Output = EInfo "output" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo P = EInfo "p" '[ FlowContent ] PhrasingContent - GetEInfo Param = EInfo "param" '[] NoContent - GetEInfo Picture = EInfo "picture" '[ FlowContent, PhrasingContent ] (SingleElement Source :|: SingleElement Img) - GetEInfo Pre = EInfo "pre" '[ FlowContent ] PhrasingContent - GetEInfo Progress = EInfo "progress" '[ FlowContent, PhrasingContent ] (PhrasingContent :&: NOT (SingleElement Progress)) - GetEInfo Q = EInfo "q" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Rp = EInfo "rp" '[] OnlyText - GetEInfo Rt = EInfo "rt" '[] PhrasingContent - GetEInfo Rtc = EInfo "rtc" '[] (PhrasingContent :|: SingleElement Rt) - GetEInfo Ruby = EInfo "ruby" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo S = EInfo "s" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Samp = EInfo "samp" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Script = EInfo "script" '[ FlowContent, MetadataContent, PhrasingContent ] OnlyText - GetEInfo Section = EInfo "section" '[ FlowContent, SectioningContent ] FlowContent - GetEInfo Select = EInfo "select" '[ FlowContent, PhrasingContent ] (SingleElement Option :|: SingleElement Optgroup) - GetEInfo Slot = EInfo "slot" '[ FlowContent, PhrasingContent ] OnlyText - GetEInfo Small = EInfo "small" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Source = EInfo "source" '[] NoContent - GetEInfo Span = EInfo "span" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Strong = EInfo "strong" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Style = EInfo "style" '[ FlowContent, MetadataContent ] OnlyText - GetEInfo Sub = EInfo "sub" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Summary = EInfo "summary" '[] (PhrasingContent :|: HeadingContent) - GetEInfo Sup = EInfo "sup" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Table = EInfo "table" '[ FlowContent ] (SingleElement Caption :|: SingleElement Colgroup :|: SingleElement Thead :|: SingleElement Tbody :|: SingleElement Tr :|: SingleElement Tfoot) - GetEInfo Tbody = EInfo "tbody" '[] (SingleElement Tr) - GetEInfo Td = EInfo "td" '[] FlowContent - GetEInfo Template = EInfo "template" '[ FlowContent, MetadataContent, PhrasingContent ] (FlowContent :|: MetadataContent) - GetEInfo Textarea = EInfo "textarea" '[ FlowContent, PhrasingContent ] OnlyText - GetEInfo Tfoot = EInfo "tfoot" '[] (SingleElement Tr) - GetEInfo Th = EInfo "th" '[] (FlowContent :&: NOT (SingleElement Header :|: SingleElement Footer :|: SectioningContent :|: HeadingContent)) - GetEInfo Thead = EInfo "thead" '[] (SingleElement Tr) - GetEInfo Time = EInfo "time" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Title = EInfo "title" '[ MetadataContent ] OnlyText - GetEInfo Tr = EInfo "tr" '[] (SingleElement Td :|: SingleElement Th) - GetEInfo Track = EInfo "track" '[] NoContent - GetEInfo U = EInfo "u" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Ul = EInfo "ul" '[ FlowContent ] (SingleElement Li) - GetEInfo Var = EInfo "var" '[ FlowContent, PhrasingContent ] PhrasingContent - GetEInfo Video = EInfo "video" '[ FlowContent, PhrasingContent ] (SingleElement Track :|: SingleElement Source) - GetEInfo Wbr = EInfo "wbr" '[ FlowContent, PhrasingContent ] NoContent +{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE GADTs #-} + +{-# LANGUAGE CPP #-} + +module Html.Type.Internal where + +import GHC.TypeLits +import GHC.Exts (Constraint) +import Data.Proxy +import Data.Type.Bool +import Data.ByteString (ByteString) + +-- | +-- = Type level modelling of html +-- The following types and docs are from the following source: +-- [2020-10-16] https://html.spec.whatwg.org/ Copyright © WHATWG +-- HTML - Living Standard +-- (Apple, Google, Mozilla, Microsoft). This work is licensed under a +-- Creative Commons Attribution 4.0 International License + +-- | \ 3 Semantics. structure, and APIs of HTML documents +-- 3.2 Elements +-- 3.2.5 Content models +data ContentCategory + = OnlyText + | (:|:) ContentCategory ContentCategory + | (:&:) ContentCategory ContentCategory + | NOT ContentCategory + | Elements [Symbol] + + -- | \ 3.2.5.1 The "nothing" content model + | None + -- | \ 3.2.5.2 Kinds of content + -- 3.2.5.2.1 Metadata content + | Metadata + -- | \ 3.2.5.2.2 Flow content + | Flow + -- | \ 3.2.5.2.3 Sectioning content + | Sectioning + -- | \ 3.2.5.2.4 Heading content + | Heading + -- | \ 3.2.5.2.5 Phrasing content + | Phrasing + -- | \ 3.2.5.2.6 Embedded content + | Embedded + -- | \ 3.2.5.2.7 Interactive content + | Interactive + -- | \ 3.2.5.2.8 Palpable content + | Palpable + -- | \ 3.2.5.2.9 Script-supporting elements + | Scripting + +-- | 4 The elements of HTML +data Element (name :: Symbol) (categories :: [ContentCategory]) (contentModel :: ContentCategory) (contentAttributes :: [Symbol]) where + + DOCTYPE + :: Element + "!DOCTYPE html" + '[] + None + '[] + + -- | \ 4.1 The document element + -- 4.1.1 + Html + :: Element + "html" + '[] + -- A head element followed by a body element. + (Elements ["head", "body"]) + (ManifestA & '[]) + + -- | \ 4.2 Document metadata + -- 4.2.1 + Head + :: Element + "head" + '[] + -- If the document is an iframe srcdoc document or if title + -- information is available from a higher-level protocol: Zero or + -- more elements of metadata content, of which no more than one is + -- a title element and no more than one is a base + -- element. Otherwise: One or more elements of metadata content, + -- of which exactly one is a title element and no more than one is + -- a base element. + Metadata + '[] + + -- | \ 4.2.2 + Title + :: Element + "title" + '[Metadata] + -- Text that is not inter-element whitespace. + OnlyText + '[] + + -- | \ 4.2.3 + Base + :: Element + "base" + '[Metadata] + None + (HrefA & TargetA & '[]) + + -- | \ 4.2.4 + Link + :: Element + "link" + '[Metadata, Flow, Phrasing] + None + (HrefA & CrossoriginA & RelA & MediaA & IntegrityA & HreflangA & TypeA & ReferrerpolicyA & SizesA & ImagesrcsetA & ImagesizesA & AsA & RelA & ColorA & DisabledA & '[]) + + -- | \ 4.2.5 + Meta + :: Element + "meta" + '[Metadata, Flow, Phrasing] + None + (NameA & HttpEquivA & ContentA & CharsetA & '[]) + + -- | \ 4.2.6 + Style + :: Element + "style" + '[Metadata] + -- Text that gives a conformant style sheet. + OnlyText + (MediaA & '[]) + + -- | \ 4.3 Sections + -- 4.3.1 + Body + :: Element + "body" + '[] + Flow + (OnafterprintA & OnbeforeprintA & OnbeforeunloadA & OnhashchangeA & OnlanguagechangeA & OnmessageA & OnmessageerrorA & OnofflineA & OnonlineA & OnpagehideA & OnpageshowA & OnpopstateA & OnrejectionhandledA & OnstorageA & OnunhandledrejectionA & OnunloadA & '[]) + + -- | \ 4.3.2 + Article + :: Element + "article" + '[Flow, Sectioning, Palpable] + Flow + '[] + + -- | \ 4.3.3 + Section + :: Element + "section" + '[Flow, Sectioning, Palpable] + Flow + '[] + + -- | \ 4.3.4 + Nav + :: Element + "nav" + '[Flow, Sectioning, Palpable] + Flow + '[] + + -- | \ 4.3.5 + Aside + :: Element + "aside" + '[Flow, Sectioning, Palpable] + Flow + '[] + + -- | \ 4.3.6 + H1 + :: Element + "h1" + '[Flow, Heading, Palpable] + Phrasing + '[] + + H2 + :: Element + "h2" + '[Flow, Heading, Palpable] + Phrasing + '[] + + H3 + :: Element + "h3" + '[Flow, Heading, Palpable] + Phrasing + '[] + + H4 + :: Element + "h4" + '[Flow, Heading, Palpable] + Phrasing + '[] + + H5 + :: Element + "h5" + '[Flow, Heading, Palpable] + Phrasing + '[] + + H6 + :: Element + "h6" + '[Flow, Heading, Palpable] + Phrasing + '[] + + -- | \ 4.3.7 + Hgroup + :: Element + "hgroup" + '[Flow, Heading, Palpable] + ((Heading :&: NOT (Elements '["hgroup"])) :|: Scripting) + '[] + + -- | \ 4.3.8 + Header + :: Element + "header" + '[Flow, Palpable] + -- Flow content, but with no header or footer element descendants. + (Flow :&: NOT (Elements ["header", "footer"])) + '[] + + -- | \ 4.3.9 + Footer + :: Element + "footer" + '[Flow, Palpable] + -- Flow content, but with no header or footer element descendants. + (Flow :&: NOT (Elements ["header", "footer"])) + '[] + + -- | \ 4.3.10 + Address + :: Element + "address" + '[Flow, Palpable] + -- Flow content, but with no heading content descendants, no + -- sectioning content descendants, and no header, footer, or + -- address element descendants. + (Flow :&: NOT (Heading :|: Sectioning :|: Elements ["header", "footer", "address"])) + '[] + + -- | \ 4.4 Grouping content + -- 4.4.1 + P + :: Element + "p" + '[Flow, Palpable] + Phrasing + '[] + + -- | \ 4.4.2 + Hr + :: Element + "hr" + '[Flow] + None + '[] + + -- | \ 4.4.3 + Pre + :: Element + "pre" + '[Flow, Palpable] + Phrasing + '[] + + -- | \ 4.4.4 + Blockquote + :: Element + "blockquote" + '[Flow, Palpable] + Flow + (CiteA & '[]) + + -- | \ 4.4.5 + Ol + :: Element + "ol" + '[Flow, Palpable] + (Elements '["li"] :|: Scripting) + (ReversedA & StartA & TypeA & '[]) + + -- | \ 4.4.6 + Ul + :: Element + "ul" + '[Flow, Palpable] + (Elements '["li"] :|: Scripting) + '[] + + -- | \ 4.4.7 + Menu + :: Element + "menu" + '[Flow, Palpable] + (Elements '["li"] :|: Scripting) + '[] + + -- | \ 4.4.8 + Li + :: Element + "li" + '[] + Flow + (ValueA & '[]) + + -- | \ 4.4.9 + Dl + :: Element + "dl" + '[Flow, Palpable] + (Elements ["dt", "dd", "div"] :|: Scripting) + '[] + + -- | \ 4.4.10 + Dt + :: Element + "dt" + '[] + (Flow :&: NOT (Sectioning :|: Heading :|: Elements ["header", "footer"])) + '[] + + -- | \ 4.4.11 + Dd + :: Element + "dd" + '[] + Flow + '[] + + -- | \ 4.4.12 + Figure + :: Element + "figure" + '[Flow, Palpable] + -- Either: one figcaption element followed by flow content. Or: + -- flow content followed by one figcaption element. Or: flow + -- content. + (Flow :|: Elements '["figcaption"]) + '[] + + -- | \ 4.4.13 + Figcaption + :: Element + "figcaption" + '[] + Flow + '[] + + -- | \ 4.4.14 + Main + :: Element + "main" + '[Flow, Palpable] + Flow + '[] + + -- | \ 4.4.15 + Div + :: Element + "div" + '[Flow, Palpable] + -- If the element is a child of a dl element: one or more dt + -- elements followed by one or more dd elements, optionally + -- intermixed with script-supporting elements. If the element is + -- not a child of a dl element: flow content. + (Flow :|: Elements ["dt", "dt"] :|: Scripting) + '[] + + -- | \ 4.5 Text-level semantics + -- 4.5.1 + A + :: Element + "a" + '[Flow, Phrasing, Interactive, Palpable] + -- Transparent, but there must be no interactive content + -- descendant, a element descendant, or descendant with the + -- tabindex attribute specified. + ((Flow :|: Phrasing :|: Palpable) :&: NOT (Elements '["a"])) + (HrefA & TargetA & DownloadA & PingA & RelA & HreflangA & TypeA & ReferrerpolicyA & '[]) + + -- | \ 4.5.2 + Em + :: Element + "em" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.3 + Strong + :: Element + "strong" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.4 + Small + :: Element + "small" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.5 + S + :: Element + "s" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.6 + Cite + :: Element + "cite" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.7 + Q + :: Element + "q" + '[Flow, Phrasing, Palpable] + Phrasing + (CiteA & '[]) + + -- | \ 4.5.8 + Dfn + :: Element + "dfn" + '[Flow, Phrasing, Palpable] + (Phrasing :&: NOT (Elements '["dfn"])) + '[] + + -- | \ 4.5.9 + Abbr + :: Element + "abbr" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.10 + Ruby + :: Element + "ruby" + '[Flow, Phrasing, Palpable] + (Phrasing :|: Elements ["rt", "rp"]) + '[] + + -- | \ 4.5.11 + Rt + :: Element + "rt" + '[] + Phrasing + '[] + + -- | \ 4.5.12 + Rp + :: Element + "rp" + '[] + OnlyText + '[] + + -- | \ 4.5.13 + Data + :: Element + "data" + '[Flow, Phrasing, Palpable] + Phrasing + (ValueA & '[]) + + -- | \ 4.5.14 + Time + :: Element + "time" + '[Flow, Phrasing, Palpable] + Phrasing + (DatetimeA & '[]) + + -- | \ 4.5.15 + Code + :: Element + "code" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.16 + Var + :: Element + "var" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.17 + Samp + :: Element + "samp" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.18 + Kbd + :: Element + "kbd" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.19 + Sub + :: Element + "sub" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + Sup + :: Element + "sup" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.20 + I + :: Element + "i" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.21 + B + :: Element + "b" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.22 + U + :: Element + "u" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.23 + Mark + :: Element + "mark" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.24 + Bdi + :: Element + "bdi" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.25 + Bdo + :: Element + "bdo" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.26 + Span + :: Element + "span" + '[Flow, Phrasing, Palpable] + Phrasing + '[] + + -- | \ 4.5.27 + Br + :: Element + "br" + '[Flow, Phrasing] + None + '[] + + -- | \ 4.5.28 + Wbr + :: Element + "wbr" + '[Flow, Phrasing] + None + '[] + + -- | \ 4.7 Edits + -- 4.7.1 + Ins + :: Element + "ins" + '[Flow, Phrasing, Palpable] + (Flow :|: Phrasing :|: Palpable) + (CiteA & DatetimeA & '[]) + + -- | \ 4.7.2 + Del + :: Element + "del" + '[Flow, Phrasing] + (Flow :|: Phrasing) + (CiteA & DatetimeA & '[]) + + -- | \ 4.8 Embedded content + -- 4.8.1 + Picture + :: Element + "picture" + '[Flow, Phrasing, Embedded] + (Elements ["source", "img"] :|: Scripting) + '[] + + -- | \ 4.8.2 + Source + :: Element + "source" + '[] + None + (SrcA & TypeA & SrcsetA & SizesA & MediaA & '[]) + + -- | \ 4.8.3 + Img + :: Element + "img" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + None + (AltA & SrcA & SrcsetA & SizesA & CrossoriginA & UsemapA & IsmapA & WidthA & HeightA & ReferrerpolicyA & DecodingA & LoadingA & '[]) + + -- | \ 4.8.5 + Iframe + :: Element + "iframe" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + None + (SrcA & SrcdocA & NameA & SandboxA & AllowA & AllowfullscreenA & WidthA & HeightA & ReferrerpolicyA & LoadingA & '[]) + + -- | \ 4.8.6 + Embed + :: Element + "embed" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + None + (SrcA & TypeA & WidthA & HeightA & '[]) + + -- | \ 4.8.7 + Object + :: Element + "object" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + (Elements '["param"] :|: Flow :|: Phrasing :|: Embedded :|: Interactive :|: Palpable) + (DataA & TypeA & NameA & UsemapA & FormA & WidthA & HeightA & '[]) + + -- | \ 4.8.8 + Param + :: Element + "param" + '[] + None + (NameA & ValueA & '[]) + + -- | \ 4.8.9 + Video + :: Element + "video" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + ((Elements ["track", "source"] :|: Flow :|: Phrasing :|: Embedded :|: Interactive :|: Palpable) :&: NOT (Elements ["audio", "video"])) + (SrcA & CrossoriginA & PosterA & PreloadA & AutoplayA & PlaysinlineA & LoopA & MutedA & ControlsA & WidthA & HeightA & '[]) + + -- | \ 4.8.10 + Audio + :: Element + "audio" + '[Flow, Phrasing, Embedded, Interactive, Palpable] + ((Elements ["track", "source"] :|: Flow :|: Phrasing :|: Embedded :|: Interactive :|: Palpable) :&: NOT (Elements ["audio", "video"])) + (SrcA & CrossoriginA & PreloadA & AutoplayA & LoopA & MutedA & ControlsA & '[]) + + -- | \ 4.8.11 + Track + :: Element + "track" + '[] + None + (KindA & SrcA & SrclangA & LabelA & DefaultA & '[]) + + -- | \ 4.8.13 + Map + :: Element + "map" + '[Flow, Phrasing, Palpable] + (Flow :|: Phrasing :|: Palpable) + (NameA & '[]) + + -- | \ 4.8.14 + Area + :: Element + "area" + '[Flow, Phrasing] + None + (AltA & CoordsA & ShapeA & HrefA & TargetA & DownloadA & PingA & RelA & ReferrerpolicyA & '[]) + + -- | \ 4.9 Tabular data + -- 4.9.1 + Table + :: Element + "table" + '[Flow, Palpable] + (Elements ["caption", "colgroup", "thead", "tbody", "tr", "tfoot"] :|: Scripting) + '[] + + -- | \ 4.9.2 + Caption + :: Element + "caption" + '[] + (Flow :|: NOT (Elements '["table"])) + '[] + + -- | \ 4.9.3 + Colgroup + :: Element + "colgroup" + '[] + (Elements ["col", "template"]) + (SpanA & '[]) + + -- | \ 4.9.4 + Col + :: Element + "col" + '[] + None + (SpanA & '[]) + + -- | \ 4.9.5 + Tbody + :: Element + "tbody" + '[] + (Elements '["tr"] :|: Scripting) + '[] + + -- | \ 4.9.6 + Thead + :: Element + "thead" + '[] + (Elements '["tr"] :|: Scripting) + '[] + + -- | \ 4.9.7 + Tfoot + :: Element + "tfoot" + '[] + (Elements '["tr"] :|: Scripting) + '[] + + -- | \ 4.9.8 + Tr + :: Element + "tr" + '[] + (Elements ["td", "th"] :|: Scripting) + '[] + + -- | \ 4.9.9 + Td + :: Element + "td" + '[] + Flow + (ColspanA & RowspanA & HeadersA & '[]) + + -- | \ 4.9.10 + Th + :: Element + "th" + '[] + (Flow :&: NOT (Elements ["header", "footer"] :|: Sectioning :|: Heading)) + (ColspanA & RowspanA & HeadersA & ScopeA & AbbrA & '[]) + + -- | \ 4.10 Forms + -- 4.10.3 + Form + :: Element + "form" + '[Flow, Palpable] + (Flow :&: NOT (Elements '["form"])) + (AcceptCharsetA & ActionA & AutocompleteA & EnctypeA & MethodA & NameA & NovalidateA & TargetA & RelA & '[]) + + -- | \ 4.10.4 + Label + :: Element + "label" + '[Flow, Phrasing, Interactive, Palpable] + (Phrasing :&: NOT (Elements '["label"])) + (ForA & '[]) + + -- | \ 4.10.5 + Input + :: Element + "input" + '[Flow, Phrasing, Interactive, Palpable] + None + (AcceptA & AltA & AutocompleteA & CheckedA & DirnameA & DisabledA & FormA & FormactionA & FormenctypeA & FormmethodA & FormnovalidateA & FormtargetA & HeightA & ListA & MaxA & MaxlengthA & MinA & MinlengthA & MultipleA & NameA & PatternA & PlaceholderA & ReadonlyA & RequiredA & SizeA & SrcA & StepA & TypeA & ValueA & WidthA & '[]) + + -- | \ 4.10.6 + Button + :: Element + "button" + '[Flow, Phrasing, Interactive, Palpable] + (Phrasing :&: NOT Interactive) + (DisabledA & FormA & FormactionA & FormenctypeA & FormmethodA & FormnovalidateA & FormtargetA & NameA & TypeA & ValueA & '[]) + + -- | \ 4.10.7 + Select + :: Element + "select" + '[Flow, Phrasing, Interactive, Palpable] + (Elements ["option", "optgroup"] :|: Scripting) + (AutocompleteA & DisabledA & FormA & MultipleA & NameA & RequiredA & SizeA & '[]) + + -- | \ 4.10.8 + Datalist + :: Element + "datalist" + '[Flow, Phrasing] + (Phrasing :|: Scripting :|: Elements '["option"]) + '[] + + -- | \ 4.10.9 + Optgroup + :: Element + "optgroup" + '[] + (Elements '["option"] :|: Scripting) + (DisabledA & LabelA & '[]) + + -- | \ 4.10.10 + Option + :: Element + "option" + '[] + OnlyText + (DisabledA & LabelA & SelectedA & ValueA & '[]) + + -- | \ 4.10.11 + Textarea + :: Element + "textarea" + '[Flow, Phrasing, Interactive, Palpable] + OnlyText + (AutocompleteA & ColsA & DirnameA & DisabledA & FormA & MaxlengthA & MinlengthA & NameA & PlaceholderA & ReadonlyA & RequiredA & RowsA & WrapA & '[]) + + -- | \ 4.10.12 + Output + :: Element + "output" + '[Flow, Phrasing, Palpable] + Phrasing + (ForA & FormA & NameA & '[]) + + -- | \ 4.10.13 + Progress + :: Element + "progress" + '[Flow, Phrasing, Palpable] + (Phrasing :&: NOT (Elements '["progress"])) + (ValueA & MaxA & '[]) + + -- | \ 4.10.14 + Meter + :: Element + "meter" + '[Flow, Phrasing, Palpable] + (Phrasing :&: NOT (Elements '["meter"])) + (ValueA & MinA & MaxA & LowA & HighA & OptimumA & '[]) + + -- | \ 4.10.15 + Fieldset + :: Element + "fieldset" + '[Flow, Palpable] + (Elements '["legend"] :|: Flow) + (DisabledA & FormA & NameA & '[]) + + -- | \ 4.10.16 + Legend + :: Element + "legend" + '[] + (Phrasing :|: Heading) + '[] + + -- | \ 4.11 Interactive elements + -- 4.11.1 + Details + :: Element + "details" + '[Flow, Interactive, Palpable] + (Elements '["summary"] :|: Flow) + (OpenA & '[]) + + -- | \ 4.11.2 + Summary + :: Element + "summary" + '[] + (Phrasing :|: Heading) + '[] + + -- | \ 4.11.4 + Dialog + :: Element + "dialog" + '[Flow] + Flow + (OpenA & '[]) + + -- | \ 4.12 Scripting + -- 4.12.1 + Script + :: Element + "script" + '[Metadata, Flow, Phrasing, Scripting] + OnlyText + (SrcA & TypeA & NomoduleA & AsyncA & DeferA & CrossoriginA & IntegrityA & ReferrerpolicyA & '[]) + + -- | \ 4.12.2 + Noscript + :: Element + "noscript" + '[Metadata, Flow, Phrasing] + ((Elements ["link", "style", "meta"] :|: Metadata :|: Flow :|: Phrasing) :&: NOT (Elements '["noscript"])) + '[] + + -- | \ 4.12.3 + Template + :: Element + "template" + '[Metadata, Flow, Phrasing, Scripting] + (Metadata :|: Flow :|: Sectioning :|: Heading :|: Phrasing :|: Palpable) + '[] + + -- | \ 4.12.4 + Slot + :: Element + "slot" + '[Flow, Phrasing] + (Flow :|: Phrasing) + (NameA & '[]) + + -- | \ 4.12.5 + Canvas + :: Element + "canvas" + '[Flow, Phrasing, Embedded, Palpable] + (((Flow :|: Phrasing :|: Embedded :|: Palpable) :&: NOT Interactive) :|: Elements ["a", "img", "button", "input", "select"]) + (WidthA & HeightA & '[]) + + -- | \ 4.13 Custom elements + CustomElement + :: Element + name + categories + contentModel + contentAttributes + +data Attribute name global boolean where + CustomA :: Attribute name global boolean + + -- List of attributes (excluding event handler content attributes) + AbbrA :: Attribute "abbr" False False + AcceptA :: Attribute "accept" False False + AcceptCharsetA :: Attribute "accept-charset" False False + AccesskeyA :: Attribute "accesskey" True False + ActionA :: Attribute "action" False False + AllowA :: Attribute "allow" False False + AllowfullscreenA :: Attribute "allowfullscreen" False True + AltA :: Attribute "alt" False False + AsA :: Attribute "as" False False + AsyncA :: Attribute "async" False True + AutocapitalizeA :: Attribute "autocapitalize" True False + AutocompleteA :: Attribute "autocomplete" False False + AutofocusA :: Attribute "autofocus" True True + AutoplayA :: Attribute "autoplay" False True + CharsetA :: Attribute "charset" False False + CheckedA :: Attribute "checked" False True + CiteA :: Attribute "cite" False False + ClassA :: Attribute "class" True False + ColorA :: Attribute "color" False False + ColsA :: Attribute "cols" False False + ColspanA :: Attribute "colspan" False False + ContentA :: Attribute "content" False False + ContenteditableA :: Attribute "contenteditable" True False + ControlsA :: Attribute "controls" False True + CoordsA :: Attribute "coords" False False + CrossoriginA :: Attribute "crossorigin" False False + DataA :: Attribute "data" False False + DatetimeA :: Attribute "datetime" False False + DecodingA :: Attribute "decoding" False False + DefaultA :: Attribute "default" False True + DeferA :: Attribute "defer" False True + DirA :: Attribute "dir" True False + DirnameA :: Attribute "dirname" False False + DisabledA :: Attribute "disabled" False True + DownloadA :: Attribute "download" False False + DraggableA :: Attribute "draggable" True False + EnctypeA :: Attribute "enctype" False False + EnterkeyhintA :: Attribute "enterkeyhint" True False + ForA :: Attribute "for" False False + FormA :: Attribute "form" False False + FormactionA :: Attribute "formaction" False False + FormenctypeA :: Attribute "formenctype" False False + FormmethodA :: Attribute "formmethod" False False + FormnovalidateA :: Attribute "formnovalidate" False True + FormtargetA :: Attribute "formtarget" False False + HeadersA :: Attribute "headers" False False + HeightA :: Attribute "height" False False + HiddenA :: Attribute "hidden" True True + HighA :: Attribute "high" False False + HrefA :: Attribute "href" False False + HreflangA :: Attribute "hreflang" False False + HttpEquivA :: Attribute "httpEquiv" False False + IdA :: Attribute "id" True False + ImagesizesA :: Attribute "imagesizes" False False + ImagesrcsetA :: Attribute "imagesrcset" False False + InputmodeA :: Attribute "inputmode" True False + IntegrityA :: Attribute "integrity" False False + IsA :: Attribute "is" True False + IsmapA :: Attribute "ismap" False True + ItemidA :: Attribute "itemid" True False + ItempropA :: Attribute "itemprop" True False + ItemrefA :: Attribute "itemref" True False + ItemscopeA :: Attribute "itemscope" True True + ItemtypeA :: Attribute "itemtype" True False + KindA :: Attribute "kind" False False + LabelA :: Attribute "label" False False + LangA :: Attribute "lang" True False + ListA :: Attribute "list" False False + LoadingA :: Attribute "loading" False False + LoopA :: Attribute "loop" False True + LowA :: Attribute "low" False False + ManifestA :: Attribute "manifest" False False + MaxA :: Attribute "max" False False + MaxlengthA :: Attribute "maxlength" False False + MediaA :: Attribute "media" False False + MethodA :: Attribute "method" False False + MinA :: Attribute "min" False False + MinlengthA :: Attribute "minlength" False False + MultipleA :: Attribute "multiple" False True + MutedA :: Attribute "muted" False True + NameA :: Attribute "name" False False + NomoduleA :: Attribute "nomodule" False True + NonceA :: Attribute "nonce" True False + NovalidateA :: Attribute "novalidate" False True + OpenA :: Attribute "open" False True + OptimumA :: Attribute "optimum" False False + PatternA :: Attribute "pattern" False False + PingA :: Attribute "ping" False False + PlaceholderA :: Attribute "placeholder" False False + PlaysinlineA :: Attribute "playsinline" False True + PosterA :: Attribute "poster" False False + PreloadA :: Attribute "preload" False False + ReadonlyA :: Attribute "readonly" False True + ReferrerpolicyA :: Attribute "referrerpolicy" False False + RelA :: Attribute "rel" False False + RequiredA :: Attribute "required" False True + ReversedA :: Attribute "reversed" False True + RowsA :: Attribute "rows" False False + RowspanA :: Attribute "rowspan" False False + SandboxA :: Attribute "sandbox" False False + ScopeA :: Attribute "scope" False False + SelectedA :: Attribute "selected" False True + ShapeA :: Attribute "shape" False False + SizeA :: Attribute "size" False False + SizesA :: Attribute "sizes" False False + SlotA :: Attribute "slot" True False + SpanA :: Attribute "span" False False + SpellcheckA :: Attribute "spellcheck" True False + SrcA :: Attribute "src" False False + SrcdocA :: Attribute "srcdoc" False False + SrclangA :: Attribute "srclang" False False + SrcsetA :: Attribute "srcset" False False + StartA :: Attribute "start" False False + StepA :: Attribute "step" False False + StyleA :: Attribute "style" True False + TabindexA :: Attribute "tabindex" True False + TargetA :: Attribute "target" False False + TitleA :: Attribute "title" True False + TranslateA :: Attribute "translate" True False + TypeA :: Attribute "type" False False + UsemapA :: Attribute "usemap" False False + ValueA :: Attribute "value" False False + WidthA :: Attribute "width" False False + WrapA :: Attribute "wrap" False False + + -- List of event handler content attributes + OnabortA :: Attribute "onabort" True False + OnauxclickA :: Attribute "onauxclick" True False + OnafterprintA :: Attribute "onafterprint" False False + OnbeforeprintA :: Attribute "onbeforeprint" False False + OnbeforeunloadA :: Attribute "onbeforeunload" False False + OnblurA :: Attribute "onblur" True False + OncancelA :: Attribute "oncancel" True False + OncanplayA :: Attribute "oncanplay" True False + OncanplaythroughA :: Attribute "oncanplaythrough" True False + OnchangeA :: Attribute "onchange" True False + OnclickA :: Attribute "onclick" True False + OncloseA :: Attribute "onclose" True False + OncontextmenuA :: Attribute "oncontextmenu" True False + OncopyA :: Attribute "oncopy" True False + OncuechangeA :: Attribute "oncuechange" True False + OncutA :: Attribute "oncut" True False + OndblclickA :: Attribute "ondblclick" True False + OndragA :: Attribute "ondrag" True False + OndragendA :: Attribute "ondragend" True False + OndragenterA :: Attribute "ondragenter" True False + OndragleaveA :: Attribute "ondragleave" True False + OndragoverA :: Attribute "ondragover" True False + OndragstartA :: Attribute "ondragstart" True False + OndropA :: Attribute "ondrop" True False + OndurationchangeA :: Attribute "ondurationchange" True False + OnemptiedA :: Attribute "onemptied" True False + OnendedA :: Attribute "onended" True False + OnerrorA :: Attribute "onerror" True False + OnfocusA :: Attribute "onfocus" True False + OnformdataA :: Attribute "onformdata" True False + OnhashchangeA :: Attribute "onhashchange" False False + OninputA :: Attribute "oninput" True False + OninvalidA :: Attribute "oninvalid" True False + OnkeydownA :: Attribute "onkeydown" True False + OnkeypressA :: Attribute "onkeypress" True False + OnkeyupA :: Attribute "onkeyup" True False + OnlanguagechangeA :: Attribute "onlanguagechange" False False + OnloadA :: Attribute "onload" True False + OnloadeddataA :: Attribute "onloadeddata" True False + OnloadedmetadataA :: Attribute "onloadedmetadata" True False + OnloadstartA :: Attribute "onloadstart" True False + OnmessageA :: Attribute "onmessage" False False + OnmessageerrorA :: Attribute "onmessageerror" False False + OnmousedownA :: Attribute "onmousedown" True False + OnmouseenterA :: Attribute "onmouseenter" True False + OnmouseleaveA :: Attribute "onmouseleave" True False + OnmousemoveA :: Attribute "onmousemove" True False + OnmouseoutA :: Attribute "onmouseout" True False + OnmouseoverA :: Attribute "onmouseover" True False + OnmouseupA :: Attribute "onmouseup" True False + OnofflineA :: Attribute "onoffline" False False + OnonlineA :: Attribute "ononline" False False + OnpagehideA :: Attribute "onpagehide" False False + OnpageshowA :: Attribute "onpageshow" False False + OnpasteA :: Attribute "onpaste" True False + OnpauseA :: Attribute "onpause" True False + OnplayA :: Attribute "onplay" True False + OnplayingA :: Attribute "onplaying" True False + OnpopstateA :: Attribute "onpopstate" False False + OnprogressA :: Attribute "onprogress" True False + OnratechangeA :: Attribute "onratechange" True False + OnresetA :: Attribute "onreset" True False + OnresizeA :: Attribute "onresize" True False + OnrejectionhandledA :: Attribute "onrejectionhandled" False False + OnscrollA :: Attribute "onscroll" True False + OnsecuritypolicyviolationA :: Attribute "onsecuritypolicyviolation" True False + OnseekedA :: Attribute "onseeked" True False + OnseekingA :: Attribute "onseeking" True False + OnselectA :: Attribute "onselect" True False + OnslotchangeA :: Attribute "onslotchange" True False + OnstalledA :: Attribute "onstalled" True False + OnstorageA :: Attribute "onstorage" False False + OnsubmitA :: Attribute "onsubmit" True False + OnsuspendA :: Attribute "onsuspend" True False + OntimeupdateA :: Attribute "ontimeupdate" True False + OntoggleA :: Attribute "ontoggle" True False + OnunhandledrejectionA :: Attribute "onunhandledrejection" False False + OnunloadA :: Attribute "onunload" False False + OnvolumechangeA :: Attribute "onvolumechange" True False + OnwaitingA :: Attribute "onwaiting" True False + OnwheelA :: Attribute "onwheel" True False + + -- [2020-11-03] ARIA https://w3c.github.io/aria/#states_and_properties + RoleA :: Attribute "role" True False + + -- 6.7 Definitios of States and Properties (all aria-* attributes) + AriaActivedescendantA :: Attribute "aria-activedescendant" True False + AriaAtomicA :: Attribute "aria-atomic" True False + AriaAutocompleteA :: Attribute "aria-autocomplete" True False + AriaBraillelableA :: Attribute "aria-braillelable" True False + AriaBrailleroledescriptionA :: Attribute "aria-brailleroledescription" True False + AriaBusyA :: Attribute "aria-busy" True False + AriaCheckedA :: Attribute "aria-checked" True False + AriaColcountA :: Attribute "aria-colcount" True False + AriaColindexA :: Attribute "aria-colindex" True False + AriaColindextextA :: Attribute "aria-colindextext" True False + AriaColspanA :: Attribute "aria-colspan" True False + AriaControlsA :: Attribute "aria-controls" True False + AriaCurrentA :: Attribute "aria-current" True False + AriaDescribedbyA :: Attribute "aria-describedby" True False + AriaDescriptionA :: Attribute "aria-description" True False + AriaDetailsA :: Attribute "aria-details" True False + AriaDisabledA :: Attribute "aria-disabled" True False + AriaDropeffectA :: Attribute "aria-dropeffect" True False + AriaErrormessageA :: Attribute "aria-errormessage" True False + AriaExpandedA :: Attribute "aria-expanded" True False + AriaFlowtoA :: Attribute "aria-flowto" True False + AriaGrabbedA :: Attribute "aria-grabbed" True False + AriaHaspopupA :: Attribute "aria-haspopup" True False + AriaHiddenA :: Attribute "aria-hidden" True False + AriaInvalidA :: Attribute "aria-invalid" True False + AriaKeyshortcutsA :: Attribute "aria-keyshortcuts" True False + AriaLabelA :: Attribute "aria-label" True False + AriaLabelledByA :: Attribute "aria-labelledBy" True False + AriaLevelA :: Attribute "aria-level" True False + AriaLiveA :: Attribute "aria-live" True False + AriaModalA :: Attribute "aria-modal" True False + AriaMultilineA :: Attribute "aria-multiline" True False + AriaMultiselectableA :: Attribute "aria-multiselectable" True False + AriaOrientationA :: Attribute "aria-orientation" True False + AriaOwnsA :: Attribute "aria-owns" True False + AriaPlaceholderA :: Attribute "aria-placeholder" True False + AriaPosinsetA :: Attribute "aria-posinset" True False + AriaPressedA :: Attribute "aria-pressed" True False + AriaReadonlyA :: Attribute "aria-readonly" True False + AriaRelevantA :: Attribute "aria-relevant" True False + AriaRequiredA :: Attribute "aria-required" True False + AriaRoledescriptionA :: Attribute "aria-roledescription" True False + AriaRowcountA :: Attribute "aria-rowcount" True False + AriaRowindexA :: Attribute "aria-rowindex" True False + AriaRowindextextA :: Attribute "aria-rowindextext" True False + AriaRowspanA :: Attribute "aria-rowspan" True False + AriaSelectedA :: Attribute "aria-selected" True False + AriaSetsizeA :: Attribute "aria-setsize" True False + AriaSortA :: Attribute "aria-sort" True False + AriaValuemaxA :: Attribute "aria-valuemax" True False + AriaValueminA :: Attribute "aria-valuemin" True False + AriaValuenowA :: Attribute "aria-valuenow" True False + AriaValuetextA :: Attribute "aria-valuetext" True False + +-- | +-- = Utilities + +type GetAttributeName (e :: Attribute a global boolean) = a + +type (&) k b = GetAttributeName k ': b + +newtype Lawless a = Lawless a + +infixr 5 & + +-- | We need efficient cons, snoc and append. This API has cons(O1) +-- and snoc(O1) but append(On). Optimal would be a FingerTree. +data List = List [Symbol] Symbol + +type family (<|) s t :: List where + (<|) l ('List (s ': ss) r) = 'List (AppendSymbol l s ': ss) r + (<|) l ('List '[] r) = 'List '[] (AppendSymbol l r) + +type family (|>) t s :: List where + (|>) ('List ss r) rr = 'List ss (AppendSymbol r rr) + +type family (><) t1 t2 :: List where + (><) ('List ss r) ('List (s ': ss2) r2) = 'List (Append ss (AppendSymbol r s ': ss2)) r2 + (><) ('List ss r) ('List '[] r2) = 'List ss (AppendSymbol r r2) + +-- | Flatten a document into a type list of tags. +type family ToList a :: List where + ToList (Element name categories contentModel contentAttributes :> b) = AppendSymbol "<" (AppendSymbol name ">") <| ToList b |> AppendSymbol "") + ToList ((Element name categories contentModel contentAttributes :@ at) :> b) = AppendSymbol "<" name <| ToList at >< (">" <| ToList b) |> AppendSymbol "") + ToList (Element name categories None contentAttributes) = 'List '[] (AppendSymbol "<" (AppendSymbol name ">")) + ToList (Element name categories contentModel contentAttributes) = ToList (Element name categories contentModel contentAttributes :> ()) + ToList (Element name categories None contentAttributes :@ at) = AppendSymbol "<" name <| ToList at |> ">" + ToList (Element name categories contentModel contentAttributes :@ at) = AppendSymbol "<" name <| ToList at |> AppendSymbol ">") + ToList (a # b) = ToList a >< ToList b + ToList (Lawless a) = ToList a + ToList (Attribute a global boolean) = 'List '[] (AppendSymbol " " a) + ToList (Attribute a global boolean := ()) = 'List '[] (AppendSymbol " " a) + ToList (Attribute a global boolean := b) = AppendSymbol " " (AppendSymbol a "=\"") <| ToList b |> "\"" + ToList () = 'List '[] "" + ToList (Proxy x) = 'List '[] x + ToList x = 'List '[""] "" + +-- | Combine two elements or attributes sequentially. +-- +-- >>> i_ () # div_ () +--
+-- +-- >>> i_A (A.id_ "a" # A.class_ "b") "c" +-- c +data (#) a b = (:#:) a b +{-# INLINE (#) #-} +(#) :: a -> b -> a # b +(#) = (:#:) +infixr 5 # + +type family Lawful relationship father child :: Constraint where + Lawful relation x (Raw y) = () + Lawful relation x (Lawless y) = () + Lawful relation x (y1 # y2) = (Lawful relation x y1, Lawful relation x y2) + Lawful relation x (Maybe y) = Lawful relation x y + Lawful relation x (Either y1 y2) = (Lawful relation x y1, Lawful relation x y2) + Lawful relation x [y] = Lawful relation x y + Lawful relation x (c :@ _) = Lawful relation x c + Lawful relation x (c :> _) = Lawful relation x c + Lawful relation x (c := _) = Lawful relation x c + + Lawful AttributeValue (Attribute name1 global1 boolean1) (Attribute name2 global2 boolean2) = TypeError (Text "The attribute " :<>: Text name1 :<>: Text " can't contain the attribute " :<>: Text name2 :<>: Text ".") + Lawful AttributeValue (Attribute name1 global1 boolean1) (Element name2 categories contentModel contentAttributes) = TypeError (Text "The attribute " :<>: Text name1 :<>: Text " can't contain the element " :<>: Text name2 :<>: Text ".") + Lawful AttributeValue (Attribute name global boolean) v = If boolean (TypeError (Text "The attribute " :<>: Text name :<>: Text " is boolean and can't contain a value.")) (() :: Constraint) + Lawful AttributeValue x v = TypeError (ShowType x :<>: Text " is not an attribute.") + + Lawful Fatherhood (e :@ _) c = Lawful Fatherhood e c + Lawful Fatherhood (Element name categories contentModel contentAttributes) (Attribute name2 global boolean) = TypeError (Text name :<>: Text " can't have an attribute as children.") + Lawful Fatherhood (Element name categories None contentAttributes) _ = TypeError (Text name :<>: Text " can't have children.") + + Lawful Fatherhood (Element name1 categories1 contentModel1 contentAttributes1) + (Element name2 categories2 contentModel2 contentAttributes2) = MaybeTypeError name1 (Text name2) (CheckContentCategory name2 contentModel1 categories2) + Lawful Fatherhood (Element name categories contentModel contentAttributes) string = MaybeTypeError name (ShowType string) (CheckContentCategory "" contentModel '[OnlyText, Flow, Phrasing]) + Lawful Fatherhood _ _ = TypeError (Text "Only Elements and Elements with Attributes can father children.") + + Lawful Attribution (Element name categories contentModel contentAttributes) (Attribute a global boolean) + = If (global || Elem a contentAttributes) + (() :: Constraint) + (TypeError (Text a :<>: Text " is not a valid attribute of " :<>: Text name :<>: Text ".")) + Lawful Attribution (Element name categories contentModel contentAttributes) a = TypeError (ShowType a :<>: Text " is not a valid attribute of " :<>: Text name :<>: Text ".") + Lawful Attribution a _ = TypeError (ShowType a :<>: Text " is not an attributable element.") + +type family MaybeTypeError a b c where + MaybeTypeError a b c = If c (() :: Constraint) + (TypeError (b :<>: Text " is not a valid child of " :<>: Text a :<>: Text ".")) + +data Relationship + = Fatherhood + | Attribution + | AttributeValue + +data (:>) father child where + (:>) :: Lawful Fatherhood f c => f -> c -> f :> c + +data (:@) element attribution where + (:@) :: Lawful Attribution e a => e -> a -> e :@ a + +data (:=) a v where + (:=) :: Lawful AttributeValue a v => a -> v -> a := v + +infixr 6 :> +infixr 9 :@ +infixr 9 := + +-- | Wrapper for types which won't be escaped. +newtype Raw a = Raw {fromRaw :: a} + +type family Null xs where + Null '[] = True + Null _ = False + +type family Length c where + Length (a :> b) = Length a + Length b + Length (a :@ b) = Length b + Length (a # b) = Length a + Length b + Length (_ := b) = Length b + Length (Lawless a) = Length a + Length (Attribute a global boolean) = 0 + Length (Element name categories contentModel contentAttributes) = 0 + Length () = 0 + Length (Proxy _) = 0 + Length _ = 1 + +-- | Append two type lists. +-- +-- Note that this definition is that ugly to reduce compiletimes. +-- Please check whether the context reduction stack or compiletimes of +-- a big html page get bigger if you try to refactor. +type family Append xs ys :: [k] where + + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': Append xs ys + + Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': Append xs ys + + Append (x1 ': x2 ': x3 ': x4 ': xs) ys + = x1 ': x2 ': x3 ': x4 ': Append xs ys + + Append (x1 ': x2 ': xs) ys + = x1 ': x2 ': Append xs ys + + Append (x1 ': xs) ys + = x1 ': Append xs ys + + Append '[] ys + = ys + +-- | Type level drop. +-- +-- Note that this definition is that ugly to reduce compiletimes. +-- Please check whether the context reduction stack or compiletimes of +-- a big html page get bigger if you try to refactor. +type family Drop n xs :: [k] where + Drop 0 xs = xs + Drop 1 (_ ': xs) = xs + Drop 2 (_ ': _ ': xs) = xs + Drop 4 (_ ': _ ': _ ': _ ': xs) = xs +#if __GLASGOW_HASKELL__ >= 804 + Drop 8 (_ ': _ ': _ ': _ ': _ ': _ ': _ ': _ ': xs) = xs + Drop n xs = Drop (n - 2^Log2 n) (Drop (2^(Log2 n-1)) (Drop (2^(Log2 n-1)) xs)) +#else + Drop 3 (_ ': _ ': _ ': xs) = xs + Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs +#endif + +-- | Type level take. +-- +-- Note that this definition is that ugly to reduce compiletimes. +-- Please check whether the context reduction stack or compiletimes of +-- a big html page get bigger if you try to refactor. +type family Take n xs :: [k] where + Take 0 _ = '[] + Take 1 (x1 ': _) = '[x1] + Take 2 (x1 ': x2 ': _) = '[x1, x2] + Take 3 (x1 ': x2 ': x3 ': _) = '[x1, x2, x3] + Take 4 (x1 ': x2 ': x3 ': x4 ': _) = '[x1, x2, x3, x4] + Take 5 (x1 ': x2 ': x3 ': x4 ': x5 ': _) = '[x1, x2, x3, x4, x5] + Take 6 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': _) = '[x1, x2, x3, x4, x5, x6] + Take 7 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': _) = '[x1, x2, x3, x4, x5, x6, x7] + Take 8 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8] + Take 9 (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': _) = '[x1, x2, x3, x4, x5, x6, x7, x8, x9] + Take n (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': Take (n-10) xs + +type family CheckContentCategory (name :: Symbol) (a :: ContentCategory) (b :: [ContentCategory]) :: Bool where + CheckContentCategory n (a :|: b) c = CheckContentCategory n a c || CheckContentCategory n b c + CheckContentCategory n (a :&: b) c = CheckContentCategory n a c && CheckContentCategory n b c + CheckContentCategory n (NOT a) c = Not (CheckContentCategory n a c) + CheckContentCategory n (Elements xs) c = Elem n xs + CheckContentCategory n a c = Elem a c + +infixr 2 :|: +infixr 3 :&: + +type family Elem (a :: k) (xs :: [k]) where + Elem a (a : xs) = True + Elem a (_ : xs) = Elem a xs + Elem a '[] = False + +newtype T (proxies :: k) target = T target + +-- | Data for declaring variables in a html document which will be compacted. +data V (n :: Symbol) = V + +newtype One a = One a + +-- | Unique set of variables in a html document in the order of occurence. +type Variables a = Dedupe (GetV a) + +-- | A compacted html documented with it's variables annoted as a list of Symbols. +data CompactHTML (a :: [Symbol]) = MkCompactHTML ByteString [(Int, ByteString)] deriving Show + +type family GetV a :: [Symbol] where + GetV (a # b) = Append (GetV a) (GetV b) + GetV (a :> b) = Append (GetV a) (GetV b) + GetV (a :@ b) = Append (GetV a) (GetV b) + GetV (a := b) = GetV b + GetV (Maybe a) = GetV a + GetV [a] = GetV a + GetV (Either a b) = Append (GetV a) (GetV b) + GetV (V v) = '[v] + GetV x = '[] + +type family Reverse xs where + Reverse xs = Reverse' xs '[] + +type family Reverse' xs ys where + Reverse' (x':xs) ys = Reverse' xs (x':ys) + Reverse' '[] ys = ys + +type family Dedupe xs :: [Symbol] where + Dedupe (x ': xs) = x ': Dedupe (Delete x xs) + Dedupe '[] = '[] + +type family Delete x xs :: [Symbol] where + Delete x (x ': xs) = Delete x xs + Delete x (y ': xs) = y ': Delete x xs + Delete _ _ = '[] + +class ShowTypeList a where + showTypeList :: [String] + +instance (ShowTypeList xs, KnownSymbol x) => ShowTypeList (x ': xs) where + showTypeList = symbolVal (Proxy @ x) : showTypeList @ xs + +instance ShowTypeList '[] where + showTypeList = [] diff --git a/test/Custom.hs b/test/Custom.hs --- a/test/Custom.hs +++ b/test/Custom.hs @@ -1,11 +1,8 @@ {-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} module Custom where import Html -import qualified Html.Attribute as A - -hxPost_ :: a -> 'CustomA "hx-post" := a -hxPost_ = A.custom_ +hxPost :: Attribute "hx-post" 'True 'False +hxPost = CustomA diff --git a/test/Type.hs b/test/Type.hs --- a/test/Type.hs +++ b/test/Type.hs @@ -2,6 +2,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeInType #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-} @@ -16,6 +17,9 @@ where _x_ = undefined :: Test +type Demote (t :: k) = k + + type Test = ( ToList () == 'List '[] "" @@ -23,19 +27,19 @@ == 'List '[""] "" , ToList (Proxy "a") == 'List '[] "a" - , ToList ('A > Char) + , ToList (Demote 'A :> Char) == 'List '[""] "" - , ToList ('A > Char # 'Div > Int) + , ToList (Demote 'A :> Char # Demote 'Div :> Int) == 'List '["", "
"] "
" - , ToList (('Div :@: ('ClassA := Int)) Int) + , ToList ((Demote 'Div :@ (Demote 'ClassA := Int)) :> Int) == 'List '["
"] "
" - , ToList (('Div :@: ('ClassA := ())) Int) + , ToList ((Demote 'Div :@ (Demote 'ClassA := ())) :> Int) == 'List '["
"] "
" - , ToList (('Div :@: ('ClassA := ())) ()) + , ToList ((Demote 'Div :@ (Demote 'ClassA := ())) :> ()) == 'List '[] "
" - , ToList (('Div :@: ('ClassA := () # 'IdA := ())) ()) + , ToList ((Demote 'Div :@ (Demote 'ClassA := () # Demote 'IdA := ())) :> ()) == 'List '[] "
" - , ToList (('Div :@: ('ClassA := () # 'IdA := Proxy "ab")) ()) + , ToList ((Demote 'Div :@ (Demote 'ClassA := () # Demote 'IdA := Proxy "ab")) :> ()) == 'List '[] "
" ) diff --git a/test/Value.hs b/test/Value.hs --- a/test/Value.hs +++ b/test/Value.hs @@ -7,8 +7,6 @@ import Html -import qualified Html.Attribute as A - import Data.Proxy import Test.Hspec import Test.QuickCheck @@ -32,90 +30,86 @@ it "handles single elements" $ do property $ \x -> - renderString (div_ (Raw x)) + renderString (Div :> Raw x) === "
" ++ x ++ "
" it "handles nested elements" $ do property $ \x -> - renderString (div_ (div_ (Raw x))) + renderString (Div :> Div :> Raw x) === "
" ++ x ++ "
" it "handles parallel elements" $ do property $ \x y -> - renderString (div_ (Raw x) # div_ (Raw y)) + renderString (Div :> Raw x # Div :> Raw y) === "
" ++ x ++ "
" ++ y ++ "
" it "doesn't use closing tags for empty elements" $ do - renderString area_ + renderString Area `shouldBe` "" - renderString base_ + renderString Base `shouldBe` "" - renderString br_ + renderString Br `shouldBe` "
" - renderString col_ + renderString Col `shouldBe` "" - renderString embed_ + renderString Embed `shouldBe` "" - renderString hr_ + renderString Hr `shouldBe` "
" - renderString iframe_ + renderString Iframe `shouldBe` "