type-of-html 0.5.0.0 → 0.5.1.0
raw patch · 5 files changed
+144/−40 lines, 5 filesdep +ghc-primPVP ok
version bump matches the API change (PVP)
Dependencies added: ghc-prim
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−0
- Readme.md +35/−16
- src/Html/Convert.hs +67/−12
- src/Html/Type.hs +35/−11
- type-of-html.cabal +2/−1
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for type-of-html +## 0.5.1.0 -- 2017-09-13++* perf increase+* better compile times+ ## 0.5.0.0 -- 2017-09-12 * type attributes
Readme.md view
@@ -1,6 +1,6 @@ # Type of html -`Type of html` is a library for generating html in a highly+`type-of-html` is a library for generating html in a highly performant, modular and type safe manner. Please look at the documentation of the module for an overview of the api:@@ -110,10 +110,10 @@ ) ``` -Please note that the type of 'page' is inferable, so ask ghc-mod or+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 signatures for bigger documents.+that you don't write type signatures for `type-of-html`. All text will be automatically html escaped: @@ -137,17 +137,17 @@ ## Performance -`Type of html` is a lot faster than `blaze html` or than `lucid`.+`type-of-html` is a lot faster than `blaze-html` or than `lucid`. Look at the following benchmarks: -Remember this benchmark from blaze?+Remember this benchmark from `blaze-html`?  -This is comparing blaze with type of html:+This is comparing blaze with `type-of-html`: -+ To look at the exact code of this benchmark look [here](bench/Main.hs) in the repo. The big table benchmark here is only a 4x4 table. Using@@ -157,9 +157,9 @@ How is this possible? We supercompile lots of parts of the generation process. This is possible thanks to the new features of GHC 8.2:-AppendSymbol. We represent tags as kinds and map these tags to (a ::-[Symbol]) and then fold all neighbouring Proxies with-AppendSymbol. Afterwards we retrieve the Proxies with symbolVal which+AppendSymbol. We represent tags and attributes as kinds and map these+to (a :: [Symbol]) and then fold all neighbouring Symbols with+AppendSymbol. Afterwards we reify the Symbols with symbolVal which will be embedded in the executable as Addr#. All this happens at compile time. At runtime we do only generate the content and append Builders.@@ -176,11 +176,30 @@ ```haskell decodeUtf8 $ toLazyByteString ( Data.ByteString.Builder.unpackCString# "<tr><td>"#- <> escape (Data.Text.unpackCString# "test"#)+ <> builderCString# "test"# <> Data.ByteString.Builder.unpackCString# "</tr>"# ) ``` +Note that the compiler automatically sees that your string literal+doesn't need utf8 and converts directly the `"test"# :: Addr#` to an+escaped Builder without any intermediate structure, not even an+allocated bytestring.++```haskell+renderByteString $ tr_ (td_ "teſt")+```++Results in++```haskell+toLazyByteString+ ( Data.ByteString.Builder.unpackCString# "<tr><td>"#+ <> encodeUtf8BuilderEscaped prim (Data.Text.unpackCString# "te\\197\\191t"#)+ <> Data.ByteString.Builder.unpackCString# "</tr>"#+ )+```+ If you write ```haskell@@ -198,20 +217,20 @@ ## Comparision to lucid and blaze-html -Advantages of 'type-of-html':-- more or less 5 times faster-- a lot higher type safety: a lot of invalid documents are not inhabited+Advantages of `type-of-html`:+- more or less 7 times faster+- a lot higher type safety: nearly no invalid document is inhabited - fewer dependencies Disadvantages of 'type-of-html': - a bit noisy syntax (don't write types!) - sometimes unusual type error messages-- compile times (1 min for a medium sized page, with -O0 only ~4sec)+- compile times (30sec for a medium sized page, with `-O0` only ~3sec) - needs at least ghc 8.2 I'd generally recommend that you put your documents into an extra module to avoid frequent recompilations. Additionally you can use-type-of-html within an blaze-html document and vice versa. This+`type-of-html` within an `blaze-html` document and vice versa. This allows you to gradually migrate, or only write the hotpath in a more efficient representation.
src/Html/Convert.hs view
@@ -3,6 +3,8 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-} module Html.Convert where @@ -10,10 +12,14 @@ import Data.Proxy import Data.String import GHC.TypeLits+ import Html.Type+import GHC.Prim (Addr#, ord#, indexCharOffAddr#)+import GHC.Types import Data.Char (ord) +import qualified GHC.CString as GHC import qualified Data.Monoid as M import qualified Data.Semigroup as S @@ -27,26 +33,41 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL +{-# INLINE escapeUtf8 #-}+escapeUtf8 :: BP.BoundedPrim Char+escapeUtf8 =+ BP.condB (> '>' ) BP.charUtf8 $+ BP.condB (== '<' ) (fixed4 ('&',('l',('t',';')))) $+ BP.condB (== '>' ) (fixed4 ('&',('g',('t',';')))) $+ BP.condB (== '&' ) (fixed5 ('&',('a',('m',('p',';'))))) $+ BP.condB (== '"' ) (fixed5 ('&',('#',('3',('4',';'))))) $+ BP.condB (== '\'') (fixed5 ('&',('#',('3',('9',';'))))) $+ BP.liftFixedToBounded BP.char7+ where+ {-# INLINE fixed4 #-}+ fixed4 x = BP.liftFixedToBounded $ const x BP.>$<+ BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7++ {-# INLINE fixed5 #-}+ fixed5 x = BP.liftFixedToBounded $ const x BP.>$<+ BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7 BP.>*< BP.char7+ {-# INLINE escape #-} escape :: BP.BoundedPrim Word8 escape = BP.condB (> c2w '>' ) (BP.liftFixedToBounded BP.word8) $- BP.condB (== c2w '<' ) (fixed4 (c2w '&',(c2w 'l',(c2w 't',c2w ';')))) $ -- <- BP.condB (== c2w '>' ) (fixed4 (c2w '&',(c2w 'g',(c2w 't',c2w ';')))) $ -- >- BP.condB (== c2w '&' ) (fixed5 (c2w '&',(c2w 'a',(c2w 'm',(c2w 'p',c2w ';'))))) $ -- &- BP.condB (== c2w '"' ) (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '4',c2w ';'))))) $ -- "- BP.condB (== c2w '\'') (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '9',c2w ';'))))) $ -- '- BP.liftFixedToBounded BP.word8 -- fallback for Chars smaller than '>'+ BP.condB (== c2w '<' ) (fixed4 (c2w '&',(c2w 'l',(c2w 't',c2w ';')))) $+ BP.condB (== c2w '>' ) (fixed4 (c2w '&',(c2w 'g',(c2w 't',c2w ';')))) $+ BP.condB (== c2w '&' ) (fixed5 (c2w '&',(c2w 'a',(c2w 'm',(c2w 'p',c2w ';'))))) $+ BP.condB (== c2w '"' ) (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '4',c2w ';'))))) $+ BP.condB (== c2w '\'') (fixed5 (c2w '&',(c2w '#',(c2w '3',(c2w '9',c2w ';'))))) $+ BP.liftFixedToBounded BP.word8 where-- {-# INLINE c2w #-} c2w = fromIntegral . ord - {-# INLINE fixed4 #-} fixed4 x = BP.liftFixedToBounded $ const x BP.>$< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 - {-# INLINE fixed5 #-} fixed5 x = BP.liftFixedToBounded $ const x BP.>$< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 BP.>*< BP.word8 @@ -101,7 +122,7 @@ convert (AT x) = convert x instance Convert (Raw String) where {-# INLINE convert #-}- convert (Raw x) = Converted (fromString x)+ convert (Raw x) = stringConvRaw x instance Convert (Raw T.Text) where {-# INLINE convert #-} convert (Raw x) = Converted (T.encodeUtf8Builder x)@@ -110,7 +131,7 @@ convert (Raw x) = Converted (TL.encodeUtf8Builder x) instance Convert String where {-# INLINE convert #-}- convert = convert . T.pack+ convert = stringConv instance Convert T.Text where {-# INLINE convert #-} convert = Converted . T.encodeUtf8BuilderEscaped escape@@ -135,3 +156,37 @@ instance KnownSymbol a => Convert (Proxy a) where {-# INLINE convert #-} convert = Converted . U.byteStringCopy . fromString . symbolVal++{-# INLINE builderCString# #-}+builderCString# :: Addr# -> Converted+builderCString# addr = Converted $ BP.primUnfoldrBounded escape go 0+ where+ go !i | b /= 0 = Just (fromIntegral b, i+1)+ | otherwise = Nothing+ where+ !b = I# (ord# (at# i))+ at# (I# i#) = indexCharOffAddr# addr i#++{-# INLINE [0] stringConv #-}+stringConv :: String -> Converted+stringConv = Converted . BP.primMapListBounded escapeUtf8++{-# INLINE [0] stringConvRaw #-}+stringConvRaw :: String -> Converted+stringConvRaw = Converted . B.stringUtf8++{-# RULES "CONVERTED literal" forall a.+ stringConv (GHC.unpackCString# a)+ = builderCString# a #-}++{-# RULES "CONVERTED literal raw" forall a.+ stringConvRaw (GHC.unpackCString# a)+ = Converted (U.byteStringCopy (fromString (GHC.unpackCString# a))) #-}++{-# RULES "CONVERTED literal utf8" forall a.+ stringConv (GHC.unpackCStringUtf8# a)+ = convert (T.pack (GHC.unpackCStringUtf8# a)) #-}++{-# RULES "CONVERTED literal utf8 raw" forall a.+ stringConvRaw (GHC.unpackCStringUtf8# a)+ = convert (Raw (T.pack (GHC.unpackCStringUtf8# a))) #-}
src/Html/Type.hs view
@@ -331,7 +331,7 @@ a ?> f (b # c) = a ?> (b # c) a ?> () = () a ?> (b -> c) = TypeError (Text "Html elements can't contain functions")- a ?> b = CheckString a+ a ?> b = CheckString a b type family Null xs where Null '[] = True@@ -680,8 +680,13 @@ ToTypeList x = '[Nothing] -- | 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 xs '[] = xs+ Append xs '[]+ = xs Append (x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': xs) ys = x1 ': x2 ': x3 ': x4 ': x5 ': x6 ': x7 ': x8 ': x9 ': x10 ': x11 ': x12 ': x13 ': x14 ': x15 ': x16 ': x17 ': x18 ': x19 ': x20 ': x21 ': x22 ': x23 ': x24 ': x25 ': x26 ': x27 ': x28 ': x29 ': x30 ': x31 ': x32 ': x33 ': x34 ': x35 ': x36 ': x37 ': x38 ': x39 ': x40 ': x41 ': x42 ': x43 ': x44 ': x45 ': x46 ': x47 ': x48 ': x49 ': x50 ': x51 ': x52 ': x53 ': x54 ': x55 ': x56 ': x57 ': x58 ': x59 ': x60 ': x61 ': x62 ': x63 ': x64 ': Append xs ys@@ -704,8 +709,8 @@ Append (x1 ': xs) ys = x1 ': Append xs ys - Append '[] ys = ys-+ Append '[] ys+ = ys -- | Check whether an element may have content. type family HasContent a where@@ -713,8 +718,12 @@ HasContent _ = True -- | Fuse neighbouring non empty type level strings.+--+-- 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 Fuse a where- Fuse '[Just a, Nothing] = '[a, ""]+ Fuse '[Just a, Nothing] = '[a, ""] Fuse (Just x1 ': Nothing ': Just x2 ': Nothing ': x ': xs) = x1 ': x2 ': Fuse (x ': xs) Fuse (Just x1 ': Just x2 ': Nothing ': Just x3 ': Nothing ': x ': xs) = AppendSymbol x1 x2 ': x3 ': Fuse (x ': xs) Fuse (Just x1 ': Nothing ': Just x2 ': Just x3 ': Nothing ': x ': xs) = x1 ': AppendSymbol x2 x3 ': Fuse (x ': xs)@@ -733,10 +742,15 @@ Fuse (Just x1 ': Just x2 ': Just x3 ': Just x4 ': Just x5 ': Nothing ': x ': xs) = AppendSymbol x1 (AppendSymbol x2 (AppendSymbol x3 (AppendSymbol x4 x5))) ': Fuse (x ': xs) Fuse (Just x1 ': Just x2 ': xs) = Fuse (Just (AppendSymbol x1 x2) ': xs)- Fuse (Just a ': xs) = '[a]+ Fuse (Just a ': xs) = '[a] Fuse (Nothing ': xs) = "" ': Fuse xs- Fuse '[] = '[]+ Fuse '[] = '[] +-- | Type level drop.+--+-- Note that this definition is that ugly to reduce compiletimes.+-- Please check whether the context reduction stack or compiletimes of+-- a big html page get bigger if you try to refactor. type family Drop n xs :: [Symbol] where Drop 0 xs = xs Drop 1 (_ ': xs) = xs@@ -745,6 +759,11 @@ Drop 4 (_ ': _ ': _ ': _ ': xs) = xs Drop n (_ ': _ ': _ ': _ ': _ ': xs) = Drop (n-5) xs +-- | 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 :: [Symbol] where Take 0 _ = '[] Take 1 (x1 ': _) = '[x1]@@ -754,6 +773,10 @@ Take n (x1 ': x2 ': x3 ': x4 ': x5 ': xs) = x1 ': x2 ': x3 ': x4 ': x5 ': Take (n-5) xs -- | Last for type level 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 Last (xs :: [Symbol]) where Last (_ ': _ ': _ ': _ ': _ ': _ ': _ ': _ ': x ': xs) = Last (x ': xs) Last (_ ': _ ': _ ': _ ': x ': xs) = Last (x ': xs)@@ -777,10 +800,10 @@ CheckContentCategory a c = Elem a c -- | Check whether a given element may contain a string.-type family CheckString (a :: Element) where- CheckString a = If (TestPaternity OnlyText (GetInfo a) (ElementInfo '[FlowContent, PhrasingContent] NoContent))- (() :: Constraint)- (TypeError (ShowType a :<>: Text " can't contain a string"))+type family CheckString (a :: Element) b where+ CheckString a b = If (TestPaternity OnlyText (GetInfo a) (ElementInfo '[FlowContent, PhrasingContent] NoContent))+ (() :: Constraint)+ (TypeError (ShowType a :<>: Text " can't contain a " :<>: ShowType b)) -- | Content categories according to the html spec. data ContentCategory@@ -818,6 +841,7 @@ type Symbols a = Fuse (ToTypeList a) +-- | Get type list of valid elements for a given attribute. An empty list signifies global attribute. type family GetAttributeInfo a where GetAttributeInfo AcceptA = '[Form, Input] GetAttributeInfo AcceptCharsetA = '[Form]
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 0.5.0.0+version: 0.5.1.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@@ -31,6 +31,7 @@ build-depends: base >= 4.10 && < 4.11 , text , bytestring+ , ghc-prim test-suite test type: exitcode-stdio-1.0