type-of-html 1.3.4.0 → 1.4.0.0

raw patch · 21 files changed

+266/−167 lines, 21 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• Readme.md +1/−4
• bench/Alloc.hs +32/−22
• bench/Compilation.hs +40/−0
• bench/Compilation/X0.hs +10/−0
• bench/Compilation/X1.hs +10/−0
• bench/Compilation/X128.hs +10/−0
• bench/Compilation/X16.hs +10/−0
• bench/Compilation/X2.hs +10/−0
• bench/Compilation/X32.hs +10/−0
• bench/Compilation/X4.hs +10/−0
• bench/Compilation/X64.hs +10/−0
• bench/Compilation/X8.hs +10/−0
• src/Html.hs +4/−13
• src/Html/CPP.hs +0/−24
• src/Html/Convert.hs +8/−1
• src/Html/Reify.hs +36/−48
• src/Html/Type.hs +0/−1
• src/Html/Type/Internal.hs +25/−31
• test/Type.hs +8/−15
• type-of-html.cabal +15/−8

@@ -1,5 +1,12 @@ # Revision history for type-of-html +## 1.4.0.0  -- 2018-05-01++* add fixity for >+* remove ghc8.0.2 compatibility for perf reasons+* remove CPP+* error early on functions as children+ ## 1.3.4.0  -- 2018-04-03  * reduce allocations

@@ -6,7 +6,7 @@ Please look at the documentation of the module for an overview of the api: [Html](https://hackage.haskell.org/package/type-of-html/docs/Html.html) -Note that you need at least ghc 8.0.+Note that you need at least ghc 8.2.  ## Typesafety @@ -177,9 +177,6 @@ big table benchmark here is only a 4x4 table. Using a 1000x10 table like on the blaze homepage yields even better relative performance (~9 times faster), but would make the other benchmarks unreadable.--If you use ghc 802 performance will be about 20% slower compared to-newer ghcs, but obviously still a lot faster than blaze.  How is this possible? We supercompile lots of parts of the generation process. This is possible thanks to the new features of GHC 8.2:

@@ -1,5 +1,7 @@ {-# LANGUAGE DataKinds #-} +-- | Note that the allocation numbers are only reproducible on linux using the nix shell.+ module Main where  import Html@@ -34,11 +36,10 @@   | otherwise = Nothing   where n' = round (fromIntegral (weightAllocatedBytes w) / (10^i) :: Rational) :: Int         answer = " allocated bytes than "-              ++ pretty (show n)+              ++ pretty n               ++ ": "-              ++ pretty (show n')-        pretty (a:as) = a : '.' : as ++ " e" ++ show (length as+i)-        pretty _      = ""+              ++ pretty n'+        pretty x = show x ++ " e" ++ show i  f :: NFData b => String -> Int64 -> (a -> b) -> a -> Weigh () f s n g x = validateFunc s g x (allocs n)@@ -46,10 +47,7 @@ main :: IO () main = withSystemTempDirectory "compile" $ \tmp -> mainWith $ do -  -- nixpkgs: 1b27260-  -- ghc: 8.4.1--  f "()"                             144 renderByteString ()+  f "()"                              96 renderByteString ()   f "Int"                            216 renderByteString (123456789 :: Int)   f "Word"                           216 renderByteString (123456789 :: Word)   f "Char"                           232 renderByteString 'a'@@ -59,32 +57,44 @@   f "oneElement ()"                  280 (renderByteString . S.oneElement) ()   f "oneAttribute ()"                280 (renderByteString . A.class_) ()   f "oneAttribute Proxy"             280 (renderByteString . A.class_) (Proxy :: Proxy "c")-  f "listElement"                    352 (renderByteString . S.listElement) ()+  f "listElement"                    392 (renderByteString . S.listElement) ()   f "Double"                         360 renderByteString (123456789 :: Double)   f "oneElement"                     368 (renderByteString . S.oneElement) ""   f "nestedElement"                  368 (renderByteString . S.nestedElement) ""-  f "listOfAttributes"               352 (\x -> renderByteString [A.class_ x, A.class_ x]) ()+  f "listOfAttributes"               488 (\x -> renderByteString [A.class_ x, A.class_ x]) ()   f "Float"                          400 renderByteString (123456789 :: Float)   f "oneAttribute"                   408 (renderByteString . A.class_) ""   f "parallelElement"                520 (renderByteString . S.parallelElement) ""   f "parallelAttribute"              584 (\x -> renderByteString $ A.class_ x # A.id_ x) ""   f "elementWithAttribute"           584 (\x -> renderByteString $ div_A (A.class_ x) x) ""-  f "listOfListOf"                   632 (\x -> renderByteString $ div_ [i_ [span_ x]]) ()-  f "helloWorld"                    1232 (renderByteString . M.helloWorld) ()-  f "page"                          1512 (renderByteString . M.page) ()+  f "listOfListOf"                   984 (\x -> renderByteString $ div_ [i_ [span_ x]]) ()+  f "helloWorld"                    1264 (renderByteString . M.helloWorld) ()+  f "page"                          1256 (renderByteString . M.page) ()   f "table"                         1664 (renderByteString . M.table) (2,2)-  f "AttrShort"                     2608 (renderByteString . M.attrShort) ()-  f "pageA"                         2960 (renderByteString . M.pageA) ()-  f "AttrLong"                      3352 (renderByteString . M.attrLong) ()+  f "AttrShort"                     3352 (renderByteString . M.attrShort) ()+  f "pageA"                         2320 (renderByteString . M.pageA) ()+  f "AttrLong"                      2608 (renderByteString . M.attrLong) ()   f "Big table"                    19968 (renderByteString . M.table) (15,15)   f "Big page"                     25064 (renderByteString . B.page) () -  validateAction "Compile Library"   (compile tmp) "Html"           (allocsError 1021 6)-  validateAction "Compile Small.hs"  (compile tmp) "Small"          (allocsError 1061 6)-  validateAction "Compile Medium.hs" (compile tmp) "Medium"         (allocsError 1790 6)-  validateAction "Compile Big.hs"    (compile tmp) "Big"            (allocsError 2470 6)-  validateAction "Compile Alloc.hs"  (compile tmp) "bench/Alloc.hs" (allocsError 2531 6)-  validateAction "Compile Perf.hs"   (compile tmp) "bench/Perf.hs"  (allocsError 4809 6)+  let libAlloc n = allocsError (101 + n) 7++  validateAction "Compile Library"   (compile tmp) "Html"                      $ libAlloc   0+  validateAction "Compile Small.hs"  (compile tmp) "Small"                     $ libAlloc   4+  validateAction "Compile Medium.hs" (compile tmp) "Medium"                    $ libAlloc  77+  validateAction "Compile Big.hs"    (compile tmp) "Big"                       $ libAlloc 145+  validateAction "Compile Alloc.hs"  (compile tmp) "bench/Alloc.hs"            $ libAlloc 151+  validateAction "Compile Perf.hs"   (compile tmp) "bench/Perf.hs"             $ libAlloc 299++  validateAction "Compile X0.hs"     (compile tmp) "bench/Compilation/X0.hs"   $ libAlloc   5+  validateAction "Compile X1.hs"     (compile tmp) "bench/Compilation/X1.hs"   $ libAlloc   5+  validateAction "Compile X2.hs"     (compile tmp) "bench/Compilation/X2.hs"   $ libAlloc   6+  validateAction "Compile X4.hs"     (compile tmp) "bench/Compilation/X4.hs"   $ libAlloc   8+  validateAction "Compile X8.hs"     (compile tmp) "bench/Compilation/X8.hs"   $ libAlloc  13+  validateAction "Compile X16.hs"    (compile tmp) "bench/Compilation/X16.hs"  $ libAlloc  26+  validateAction "Compile X32.hs"    (compile tmp) "bench/Compilation/X32.hs"  $ libAlloc  66+  validateAction "Compile X64.hs"    (compile tmp) "bench/Compilation/X64.hs"  $ libAlloc 205+  validateAction "Compile X128.hs"   (compile tmp) "bench/Compilation/X128.hs" $ libAlloc 716  compile :: String -> String -> IO () compile out m =

@@ -0,0 +1,40 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances  #-}+{-# LANGUAGE ScopedTypeVariables   #-}+{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE DataKinds             #-}++module Compilation (helloWorld, R(..), Proxy(..)) where++import Html++import GHC.TypeLits+import Data.Proxy++type family Repeat (n :: Nat) x where+  Repeat 0 x = x+  Repeat n x = x # Repeat (n-1) x++class R n x where+  r :: Proxy n -> x -> Repeat n x++instance {-# INCOHERENT #-} R 0 x where+  r _ x = x++instance (Repeat n x ~ (x # Repeat (n-1) x), R (n-1) x) => R n x where+  r _ x = x # r (Proxy :: Proxy (n-1)) x++helloWorld :: 'Title ?> a => a -> 'Html > (('Head > ('Title > a)) # ('Body > ('P > ())))+helloWorld x =+  html_+    ( head_+      ( title_ x+      )+    # body_+      ( p_ ()+      )+    )++

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X0 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 0) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X1 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 1) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X128 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 128) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X16 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 16) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X2 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 2) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X32 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 32) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X4 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 4) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X64 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 64) $ helloWorld ()+

@@ -0,0 +1,10 @@+{-# OPTIONS_GHC -freduction-depth=0 #-}+{-# LANGUAGE DataKinds #-}++module Compilation.X8 (run) where++import Compilation++run :: IO ()+run = print . r (Proxy :: Proxy 8) $ helloWorld ()+

@@ -21,23 +21,12 @@ import Html.Convert import Html.Element import Html.Type-import Html.Type.Internal  import qualified Data.ByteString.Lazy          as B-import qualified Data.ByteString.Builder       as B import qualified Data.ByteString.Builder.Extra as BE import qualified Data.Text.Lazy                as T import qualified Data.Text.Lazy.Encoding       as T --- | Constraint synonym of html documents.-type Document  a = Document' a-type Document' a = R (T (ToList a) a)---- | Render a html document to a Builder.-{-# INLINE renderBuilder #-}-renderBuilder :: Document a => a -> B.Builder-renderBuilder = unConv . render . (T :: a -> T (ToList a) a)- -- | Render a html document to a String. {-# INLINE renderString #-} renderString :: Document a => a -> String@@ -57,5 +46,7 @@     BE.smallChunkSize   ) B.empty . renderBuilder --- | Orphan show instance to faciliate ghci development.-instance {-# OVERLAPPABLE #-} Document a => Show a where show = renderString+-- | 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

@@ -1,24 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators        #-}-{-# LANGUAGE TypeFamilies         #-}-{-# LANGUAGE DataKinds            #-}-{-# LANGUAGE PolyKinds            #-}-{-# LANGUAGE CPP                  #-}--module Html.CPP where--import GHC.TypeLits--#if __GLASGOW_HASKELL__ >= 802-type Sym = Symbol-type List a = '[a]-type EmptySym = ""-type family AppSymbols xs where-  AppSymbols (x ': xs) = AppendSymbol x (AppSymbols xs)-  AppSymbols '[] = ""-#else-type Sym = [Symbol]-type List a = a-type EmptySym = '[]-type AppSymbols xs = xs-#endif

@@ -19,7 +19,8 @@ import GHC.TypeLits import GHC.Types import GHC.Prim (Addr#, ord#, indexCharOffAddr#)-import GHC.CString (unpackCString#, unpackCStringUtf8#)+import GHC.CString (unpackCString#, unpackCStringUtf8#, unpackFoldrCString#)+import GHC.Base (build)  import qualified Data.Semigroup                   as S import qualified Data.Monoid                      as M@@ -153,8 +154,14 @@ {-# RULES "CONVERTED literal" forall a.     stringConv (unpackCString# a) = builderCString# escape a #-} +{-# RULES "CONVERTED foldr literal" forall a.+    stringConv (build (unpackFoldrCString# a)) = builderCString# escape a #-}+ {-# RULES "CONVERTED literal raw" forall a.     stringConvRaw (unpackCString# a) = builderCString# (BP.liftFixedToBounded BP.word8) a #-}++{-# RULES "CONVERTED foldr literal raw" forall a.+    stringConvRaw (build (unpackFoldrCString# a)) = builderCString# (BP.liftFixedToBounded BP.word8) a #-}  {-# RULES "CONVERTED literal utf8" forall a.     stringConv (unpackCStringUtf8# a) = convert (T.pack (unpackCStringUtf8# a)) #-}

@@ -2,41 +2,37 @@ {-# LANGUAGE ScopedTypeVariables  #-} {-# LANGUAGE FlexibleInstances    #-} {-# LANGUAGE TypeApplications     #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE ConstraintKinds      #-}+{-# LANGUAGE MonoLocalBinds       #-} {-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeFamilies         #-} {-# LANGUAGE DataKinds            #-} {-# LANGUAGE PolyKinds            #-} -module Html.Reify-  ( R(..)-  ) where+module Html.Reify where  import Html.Type.Internal import Html.Convert-import Html.CPP -import GHC.TypeLits import Data.Proxy import Data.Semigroup ((<>))+import Data.ByteString.Builder (Builder)+import GHC.Exts -class R a where-  render :: a -> Converted+type Document' a = R (T (ToList a) a) -instance-  KnownSymbol s-  => R (Proxy (s :: Symbol)) where-  {-# INLINE render #-}-  render = convert+-- | Constraint for html documents.  It's a type family to avoid an+-- error about FlexibleContexts and a warning about MonoLocalBinds.+type family Document a where Document a = Document' a -instance-  R (Proxy ('[] :: [Symbol])) where-  {-# INLINE render #-}-  render _ = mempty+-- | Render a html document to a Builder.+{-# INLINE renderBuilder #-}+renderBuilder :: Document a => a -> Builder+renderBuilder = unConv . render . (T :: a -> T (ToList a) a) . inline -instance-  ( KnownSymbol x, R (Proxy xs)-  ) => R (Proxy ((x ': xs) :: [Symbol])) where-  {-# INLINE render #-}-  render _ = convert (Proxy @ x) <> render (Proxy @ xs)+class R a where+  render :: a -> Converted  instance {-# INCOHERENT #-}   R (T '[] val) where@@ -45,34 +41,29 @@  instance {-# INCOHERENT #-}   ( Convert val-  ) => R (T '[ EmptySym ] val) where-  {-# INLINE render #-}-  render (T x) = convert x--instance {-# OVERLAPPING #-}-  R (T '[ EmptySym ] String) where+  ) => R (T '[ "" ] val) where   {-# INLINE render #-}   render (T x) = convert x  instance   ( Convert b-  , R (Proxy s)+  , Convert (Proxy s)   ) => R (T '[s] (a := b)) where   {-# INLINE render #-}-  render (T (AT x)) = render (Proxy @ s) <> convert x+  render (T (AT x)) = convert (Proxy @ s) <> convert x  instance {-# INCOHERENT #-}   ( Convert val-  , R (Proxy s)+  , Convert (Proxy s)   ) => R (T '[s] val) where   {-# INLINE render #-}-  render (T x) = render (Proxy @ s) <> convert x+  render (T x) = convert (Proxy @ s) <> convert x  instance {-# OVERLAPPING #-}-  ( R (Proxy s)+  ( Convert (Proxy s)   ) => R (T '[s] String) where   {-# INLINE render #-}-  render (T x) = render (Proxy @ s) <> convert x+  render (T x) = convert (Proxy @ s) <> convert x  instance {-# OVERLAPPING #-}   ( R (T xs val)@@ -82,10 +73,10 @@  instance   ( R (T xs val)-  , R (Proxy x)-  ) => R (T ('FingerTree xs x) val) where+  , Convert (Proxy x)+  ) => R (T ('List xs x) val) where   {-# INLINE render #-}-  render (T t) = render (T t :: T xs val) <> render (Proxy @ x)+  render (T t) = render (T t :: T xs val) <> convert (Proxy @ x)  instance   ( R (T (Take (Length b) ps) b)@@ -107,31 +98,28 @@  instance   ( R (T (ToList a) a)-  , R (Proxy s)+  , Convert (Proxy s)   ) => R (T (s ': ss) [a]) where   {-# INLINE render #-}   render (T xs)-    = render (Proxy @ s)-    <> foldMap (render . newT) xs+    = convert (Proxy @ s)+    <> foldMap (Converted . renderBuilder) xs  instance   ( R (T (ToList a) a)-  , R (Proxy s)+  , Convert (Proxy s)   ) => R (T (s ': ss) (Maybe a)) where   {-# INLINE render #-}   render (T mx)-    = render (Proxy @ s)-    <> foldMap (render . newT) mx+    = convert (Proxy @ s)+    <> foldMap (Converted . renderBuilder) mx  instance   ( R (T (ToList a) a)   , R (T (ToList b) b)-  , R (Proxy s)+  , Convert (Proxy s)   ) => R (T (s ': ss) (Either a b)) where   {-# INLINE render #-}   render (T eab)-    = render (Proxy @ s)-    <> either (render . newT) (render . newT) eab--newT :: x -> T (ToList x) x-newT = T+    = convert (Proxy @ s)+    <> either (Converted . renderBuilder) (Converted . renderBuilder) eab

@@ -6,7 +6,6 @@   , type (#)(..)   , (#)   , type (?>)-  , type (??>)   , type (<?>)   , type (:=)(..)   , Raw(..)

@@ -11,8 +11,6 @@  module Html.Type.Internal where -import Html.CPP- import GHC.TypeLits import GHC.Exts import Data.Proxy@@ -330,41 +328,38 @@   | WrapA  -- | We need efficient cons, snoc and append.  This API has cons(O1)--- and snoc(O1) but append(On).  Optimal would be a real 2-3--- FingerTree.-data FingerTree = FingerTree [Sym] Sym-type Empty = 'FingerTree '[] EmptySym-type Split = 'FingerTree '[EmptySym] EmptySym-type NoTail xs = 'FingerTree xs EmptySym-type Singleton = 'FingerTree '[]--type Both l r = AppSymbols (Append (List l) (List r))+-- and snoc(O1) but append(On).  Optimal would be a FingerTree.+data List = List [Symbol] Symbol+type Empty = 'List '[] ""+type Split = 'List '[""] ""+type NoTail xs = 'List xs ""+type Singleton = 'List '[] -type family (<|) s t :: FingerTree where-  (<|) l ('FingerTree (s ': ss) r) = 'FingerTree (Both l s ': ss) r-  (<|) l ('FingerTree '[] r) = 'FingerTree '[] (Both l r)+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 :: FingerTree where-  (|>) ('FingerTree ss r) rr = 'FingerTree ss (Both r rr)+type family (|>) t s :: List where+  (|>) ('List ss r) rr = 'List ss (AppendSymbol r rr) -type family (><) t1 t2 :: FingerTree where-  (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (Both r s ': ss2)) r2-  (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (Both r r2)+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 = ["<", ShowElement e, ">"]+type OpenTag e = AppendSymbol "<" (AppendSymbol (ShowElement e) ">") -type CloseTag e = ["</", ShowElement e, ">"]+type CloseTag e = AppendSymbol "</" (AppendSymbol (ShowElement e) ">")  -- | Flatten a document into a type list of tags.-type family ToList a :: FingerTree where+type family ToList a :: List where   ToList (a # b)         = ToList a >< ToList b-  ToList ((a :@: ()) ()) = Singleton (If (HasContent (GetEInfo a)) (AppSymbols (Append (OpenTag a) (CloseTag a))) (AppSymbols (OpenTag a)))-  ToList ((a :@: b) ())  = AppSymbols '["<", ShowElement a] <| ToList b |> If (HasContent (GetEInfo a)) (AppSymbols (">" ': CloseTag a)) (AppSymbols '[">"])-  ToList ((a :@: ()) b)  = AppSymbols (OpenTag a) <| ToList b |> AppSymbols (CloseTag a)-  ToList ((a :@: b) c)   = (AppSymbols '["<", ShowElement a] <| ToList b) >< (AppSymbols '[">"] <| ToList c |> AppSymbols (CloseTag a))-  ToList (a := b)        = AppSymbols '[" ", ShowAttribute a,"=\""] <| ToList b |> AppSymbols '["\""]+  ToList ((a :@: ()) ()) = Singleton (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 := b)        = AppendSymbol " " (AppendSymbol (ShowAttribute a) "=\"") <| ToList b |> "\""   ToList ()              = Empty-  ToList (Proxy x)       = Singleton (AppSymbols '[x])+  ToList (Proxy x)       = Singleton x   ToList x               = Split  newtype (:=) (a :: Attribute) b = AT b@@ -375,14 +370,12 @@ -- | 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) -{-# DEPRECATED (??>) "This will be removed in a future release, use `<?>` instead" #-}-type a ??> b = Check Attribute a b- type family Check f a b :: Constraint where   Check _ _ ()                      = ()   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 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)@@ -407,6 +400,7 @@  -- | 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.

@@ -4,11 +4,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE PolyKinds #-}-{-# LANGUAGE CPP #-}  module Main where -#if __GLASGOW_HASKELL__ >= 802 import GHC.TypeLits import Html.Type.Internal import Data.Proxy@@ -24,28 +22,23 @@   , ToList Int     == Split   , ToList (Proxy "a")-    == 'FingerTree '[] "a"+    == 'List '[] "a"   , ToList ('A > Char)-    == 'FingerTree '["<a>"] "</a>"+    == 'List '["<a>"] "</a>"   , ToList ('A > Char # 'Div > Int)-    == 'FingerTree '["<a>", "</a><div>"] "</div>"+    == 'List '["<a>", "</a><div>"] "</div>"   , ToList (('Div :@: ('ClassA := Int)) Int)-    == 'FingerTree '["<div class=\"","\">"] "</div>"+    == 'List '["<div class=\"","\">"] "</div>"   , ToList (('Div :@: ('ClassA := ())) Int)-    == 'FingerTree '["<div class=\"\">"] "</div>"+    == 'List '["<div class=\"\">"] "</div>"   , ToList (('Div :@: ('ClassA := ())) ())-    == 'FingerTree '[] "<div class=\"\"></div>"+    == 'List '[] "<div class=\"\"></div>"   , ToList (('Div :@: ('ClassA := () # 'IdA := ())) ())-    == 'FingerTree '[] "<div class=\"\" id=\"\"></div>"+    == 'List '[] "<div class=\"\" id=\"\"></div>"   , ToList (('Div :@: ('ClassA := () # 'IdA := Proxy "ab")) ())-    == 'FingerTree '[] "<div class=\"\" id=\"ab\"></div>"+    == 'List '[] "<div class=\"\" id=\"ab\"></div>"   )  type family a == b where   a == a = ()   a == b = TypeError ('Text "Unequal types:" ':$$: 'ShowType a ':$$: 'ShowType b)--#else-main :: IO ()-main = pure ()-#endif

@@ -1,5 +1,5 @@ name:                 type-of-html-version:              1.3.4.0+version:              1.4.0.0 synopsis:             High performance type driven html generation. description:          This library makes most invalid html documents compile time errors and uses advanced type level features to realise compile time computations. license:              BSD3@@ -7,10 +7,9 @@ author:               Florian Knupfer maintainer:           fknupfer@gmail.com homepage:             https://github.com/knupfer/type-of-html-tested-with:          GHC == 8.0.2-                    , GHC == 8.2.2-                    , GHC == 8.4.1-copyright:            2017, Florian Knupfer+tested-with:          GHC == 8.2.2+                    , GHC == 8.4.2+copyright:            2017 - 2018, Florian Knupfer category:             Language, Text, Web, HTML build-type:           Simple extra-source-files:   ChangeLog.md@@ -27,7 +26,6 @@                     , Html.Element                     , Html.Attribute   other-modules:      Html.Type.Internal-                    , Html.CPP                     , Html.Reify   hs-source-dirs:     src   default-language:   Haskell2010@@ -54,8 +52,7 @@   main-is:            Type.hs   hs-source-dirs:     test                     , src-  other-modules:      Html.CPP-                    , Html.Type.Internal+  other-modules:      Html.Type.Internal   ghc-options:        -Wall   default-language:   Haskell2010   build-depends:      base >= 4.9 && < 5@@ -66,6 +63,16 @@   other-modules:      Small                     , Medium                     , Big+                    , Compilation+                    , Compilation.X0+                    , Compilation.X1+                    , Compilation.X2+                    , Compilation.X4+                    , Compilation.X8+                    , Compilation.X16+                    , Compilation.X32+                    , Compilation.X64+                    , Compilation.X128   hs-source-dirs:     bench   ghc-options:        -Wall -O2   default-language:   Haskell2010