type-of-html 0.5.1.1 → 0.5.1.2
raw patch · 5 files changed
+171/−174 lines, 5 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Html: Data'A :: Attribute
- Html: renderBuilder :: forall a. Document a => a -> Builder
+ Html: renderBuilder :: Document a => a -> Builder
Files
- Readme.md +8/−2
- src/Html.hs +0/−2
- src/Html/Reify.hs +37/−24
- src/Html/Type.hs +124/−144
- type-of-html.cabal +2/−2
Readme.md view
@@ -147,7 +147,7 @@ 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@@ -215,10 +215,16 @@ This sort of compiletime optimization isn't for free, it'll increase compilation times. +Note that compiling with `-O2` results in a ~25% faster binary than+with `-O` and compiling with `-O0` compiles about 15 times faster, so+be sure that you develop with `-O0` and benchmark or deploy with+`-O2`. Be aware, that cabal compiles only with `-O` if you don't+specify explicitly otherwise.+ ## Comparision to lucid and blaze-html Advantages of `type-of-html`:-- more or less 7 times faster+- more or less 10 times faster on a medium sized page - a lot higher type safety: nearly no invalid document is inhabited - fewer dependencies
src/Html.hs view
@@ -1,10 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -{-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ExplicitNamespaces #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MonoLocalBinds #-} {-# LANGUAGE TypeOperators #-}
src/Html/Reify.hs view
@@ -1,13 +1,12 @@-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE MonoLocalBinds #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-} module Html.Reify where @@ -25,10 +24,13 @@ -- | Render a html document to a Builder. {-# INLINE renderBuilder #-}-renderBuilder :: forall a. Document a => a -> B.Builder-renderBuilder x = renderchunks (Tagged x :: Tagged (Symbols a) a)- <> unConv (convert (Proxy @ (Last (Symbols a))))+renderBuilder :: Document a => a -> B.Builder+renderBuilder = renderchunks . tag +{-# INLINE tag #-}+tag :: a -> Tagged (ToTypeList a) a+tag = Tagged+ -- | Render a html document to a String. {-# INLINE renderString #-} renderString :: Document a => a -> String@@ -44,18 +46,16 @@ renderByteString :: Document a => a -> B.ByteString renderByteString = B.toLazyByteString . renderBuilder -type Document a =- ( Renderchunks (Tagged (Symbols a) a)- , KnownSymbol (Last (Symbols a))- )+class Renderchunks (Tagged (ToTypeList a) a) => Document a where+instance Renderchunks (Tagged (ToTypeList a) a) => Document a class Renderchunks a where renderchunks :: a -> B.Builder -instance KnownSymbol a => Renderchunks (Tagged prox (Proxy a)) where+instance KnownSymbol a => Renderchunks (Tagged (prox :: [Symbol]) (Proxy a)) where {-# INLINE renderchunks #-} renderchunks _ = mempty-instance Renderchunks (Tagged prox ()) where+instance Renderchunks (Tagged (prox :: [Symbol]) ()) where {-# INLINE renderchunks #-} renderchunks _ = mempty @@ -75,6 +75,22 @@ = unConv (convert (Proxy @ s)) <> unConv (convert x) +instance {-# INCOHERENT #-}+ ( Renderchunks (Tagged xs val)+ ) => Renderchunks (Tagged ('FingerTree xs "") val) where+ {-# INLINE renderchunks #-}+ renderchunks (Tagged t)+ = renderchunks (Tagged t :: Tagged xs val)++instance {-# INCOHERENT #-}+ ( Renderchunks (Tagged xs val)+ , KnownSymbol x+ ) => Renderchunks (Tagged ('FingerTree xs x) val) where+ {-# INLINE renderchunks #-}+ renderchunks (Tagged t)+ = renderchunks (Tagged t :: Tagged xs val)+ <> unConv (convert (Proxy @ x))+ instance ( Renderchunks (Tagged prox b) ) => Renderchunks (Tagged prox (a > b)) where@@ -100,13 +116,10 @@ <> renderchunks (Tagged b :: Tagged (Drop (CountContent a) prox) b) instance- ( Renderchunks (Tagged (Symbols (a `f` b)) (a `f` b))- , KnownSymbol (Last (Symbols (a `f` b)))+ ( Renderchunks (Tagged (ToTypeList (a `f` b)) (a `f` b)) , KnownSymbol s ) => Renderchunks (Tagged (s ': ss) [a `f` b]) where {-# INLINE renderchunks #-} renderchunks (Tagged xs) = unConv (convert (Proxy @ s))- <> foldMap (\x -> renderchunks (Tagged x :: Tagged (Symbols (a `f` b)) (a `f` b)) <> closing) xs- where closing = unConv (convert (Proxy @ (Last (Symbols (a `f` b)))))-+ <> foldMap (renderchunks . tag) xs
src/Html/Type.hs view
@@ -1,12 +1,11 @@ {-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GADTs #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE GADTs #-} module Html.Type where @@ -228,7 +227,6 @@ | CoordsA | CrossoriginA | DataA- | Data'A | DatetimeA | DefaultA | DeferA@@ -534,123 +532,122 @@ ShowElement Xmp = "xmp" type family ShowAttribute (x :: Attribute) where- ShowAttribute AcceptA = "accept"- ShowAttribute AcceptCharsetA = "accept-charset"- ShowAttribute AccesskeyA = "accesskey"- ShowAttribute ActionA = "action"- ShowAttribute AlignA = "align"- ShowAttribute AltA = "alt"- ShowAttribute AsyncA = "async"- ShowAttribute AutocompleteA = "autocomplete"- ShowAttribute AutofocusA = "autofocus"- ShowAttribute AutoplayA = "autoplay"- ShowAttribute AutosaveA = "autosave"- ShowAttribute BgcolorA = "bgcolor"- ShowAttribute BorderA = "border"- ShowAttribute BufferedA = "buffered"- ShowAttribute ChallengeA = "challenge"- ShowAttribute CharsetA = "charset"- ShowAttribute CheckedA = "checked"- ShowAttribute CiteA = "cite"- ShowAttribute ClassA = "class"- ShowAttribute CodeA = "code"- ShowAttribute CodebaseA = "codebase"- ShowAttribute ColorA = "color"- ShowAttribute ColsA = "cols"- ShowAttribute ColspanA = "colspan"- ShowAttribute ContentA = "content"- ShowAttribute ContenteditableA = "contenteditable"- ShowAttribute ContextmenuA = "contextmenu"- ShowAttribute ControlsA = "controls"- ShowAttribute CoordsA = "coords"- ShowAttribute CrossoriginA = "crossorigin"- ShowAttribute DataA = "data"- ShowAttribute Data'A = "data'"- ShowAttribute DatetimeA = "datetime"- ShowAttribute DefaultA = "default"- ShowAttribute DeferA = "defer"- ShowAttribute DirA = "dir"- ShowAttribute DirnameA = "dirname"- ShowAttribute DisabledA = "disabled"- ShowAttribute DownloadA = "download"- ShowAttribute DraggableA = "draggable"- ShowAttribute DropzoneA = "dropzone"- ShowAttribute EnctypeA = "enctype"- ShowAttribute ForA = "for"- ShowAttribute FormA = "form"- ShowAttribute FormactionA = "formaction"- ShowAttribute HeadersA = "headers"- ShowAttribute HeightA = "height"- ShowAttribute HiddenA = "hidden"- ShowAttribute HighA = "high"- ShowAttribute HrefA = "href"- ShowAttribute HreflangA = "hreflang"- ShowAttribute HttpEquivA = "httpequiv"- ShowAttribute IconA = "icon"- ShowAttribute IdA = "id"- ShowAttribute IntegrityA = "integrity"- ShowAttribute IsmapA = "ismap"- ShowAttribute ItempropA = "itemprop"- ShowAttribute KeytypeA = "keytype"- ShowAttribute KindA = "kind"- ShowAttribute LabelA = "label"- ShowAttribute LangA = "lang"- ShowAttribute LanguageA = "language"- ShowAttribute ListA = "list"- ShowAttribute LoopA = "loop"- ShowAttribute LowA = "low"- ShowAttribute ManifestA = "manifest"- ShowAttribute MaxA = "max"- ShowAttribute MaxlengthA = "maxlength"- ShowAttribute MinlengthA = "minlength"- ShowAttribute MediaA = "media"- ShowAttribute MethodA = "method"- ShowAttribute MinA = "min"- ShowAttribute MultipleA = "multiple"- ShowAttribute MutedA = "muted"- ShowAttribute NameA = "name"- ShowAttribute NovalidateA = "novalidate"- ShowAttribute OpenA = "open"- ShowAttribute OptimumA = "optimum"- ShowAttribute PatternA = "pattern"- ShowAttribute PingA = "ping"- ShowAttribute PlaceholderA = "placeholder"- ShowAttribute PosterA = "poster"- ShowAttribute PreloadA = "preload"- ShowAttribute RadiogroupA = "radiogroup"- ShowAttribute ReadonlyA = "readonly"- ShowAttribute RelA = "rel"- ShowAttribute RequiredA = "required"- ShowAttribute ReversedA = "reversed"- ShowAttribute RowsA = "rows"- ShowAttribute RowspanA = "rowspan"- ShowAttribute SandboxA = "sandbox"- ShowAttribute ScopeA = "scope"- ShowAttribute ScopedA = "scoped"- ShowAttribute SeamlessA = "seamless"- ShowAttribute SelectedA = "selected"- ShowAttribute ShapeA = "shape"- ShowAttribute SizeA = "size"- ShowAttribute SizesA = "sizes"- ShowAttribute SlotA = "slot"- ShowAttribute SpanA = "span"- ShowAttribute SpellcheckA = "spellcheck"- ShowAttribute SrcA = "src"- ShowAttribute SrcdocA = "srcdoc"- ShowAttribute SrclangA = "srclang"- ShowAttribute SrcsetA = "srcset"- ShowAttribute StartA = "start"- ShowAttribute StepA = "step"- ShowAttribute StyleA = "style"- ShowAttribute SummaryA = "summary"- ShowAttribute TabindexA = "tabindex"- ShowAttribute TargetA = "target"- ShowAttribute TitleA = "title"- ShowAttribute TypeA = "type"- ShowAttribute UsemapA = "usemap"- ShowAttribute ValueA = "value"- ShowAttribute WidthA = "width"- ShowAttribute WrapA = "wrap"+ ShowAttribute AcceptA = " accept=\""+ ShowAttribute AcceptCharsetA = " accept-charset=\""+ ShowAttribute AccesskeyA = " accesskey=\""+ ShowAttribute ActionA = " action=\""+ ShowAttribute AlignA = " align=\""+ ShowAttribute AltA = " alt=\""+ ShowAttribute AsyncA = " async=\""+ ShowAttribute AutocompleteA = " autocomplete=\""+ ShowAttribute AutofocusA = " autofocus=\""+ ShowAttribute AutoplayA = " autoplay=\""+ ShowAttribute AutosaveA = " autosave=\""+ ShowAttribute BgcolorA = " bgcolor=\""+ ShowAttribute BorderA = " border=\""+ ShowAttribute BufferedA = " buffered=\""+ ShowAttribute ChallengeA = " challenge=\""+ ShowAttribute CharsetA = " charset=\""+ ShowAttribute CheckedA = " checked=\""+ ShowAttribute CiteA = " cite=\""+ ShowAttribute ClassA = " class=\""+ ShowAttribute CodeA = " code=\""+ ShowAttribute CodebaseA = " codebase=\""+ ShowAttribute ColorA = " color=\""+ ShowAttribute ColsA = " cols=\""+ ShowAttribute ColspanA = " colspan=\""+ ShowAttribute ContentA = " content=\""+ ShowAttribute ContenteditableA = " contenteditable=\""+ ShowAttribute ContextmenuA = " contextmenu=\""+ ShowAttribute ControlsA = " controls=\""+ ShowAttribute CoordsA = " coords=\""+ ShowAttribute CrossoriginA = " crossorigin=\""+ ShowAttribute DataA = " data=\""+ ShowAttribute DatetimeA = " datetime=\""+ ShowAttribute DefaultA = " default=\""+ ShowAttribute DeferA = " defer=\""+ ShowAttribute DirA = " dir=\""+ ShowAttribute DirnameA = " dirname=\""+ ShowAttribute DisabledA = " disabled=\""+ ShowAttribute DownloadA = " download=\""+ ShowAttribute DraggableA = " draggable=\""+ ShowAttribute DropzoneA = " dropzone=\""+ ShowAttribute EnctypeA = " enctype=\""+ ShowAttribute ForA = " for=\""+ ShowAttribute FormA = " form=\""+ ShowAttribute FormactionA = " formaction=\""+ ShowAttribute HeadersA = " headers=\""+ ShowAttribute HeightA = " height=\""+ ShowAttribute HiddenA = " hidden=\""+ ShowAttribute HighA = " high=\""+ ShowAttribute HrefA = " href=\""+ ShowAttribute HreflangA = " hreflang=\""+ ShowAttribute HttpEquivA = " httpequiv=\""+ ShowAttribute IconA = " icon=\""+ ShowAttribute IdA = " id=\""+ ShowAttribute IntegrityA = " integrity=\""+ ShowAttribute IsmapA = " ismap=\""+ ShowAttribute ItempropA = " itemprop=\""+ ShowAttribute KeytypeA = " keytype=\""+ ShowAttribute KindA = " kind=\""+ ShowAttribute LabelA = " label=\""+ ShowAttribute LangA = " lang=\""+ ShowAttribute LanguageA = " language=\""+ ShowAttribute ListA = " list=\""+ ShowAttribute LoopA = " loop=\""+ ShowAttribute LowA = " low=\""+ ShowAttribute ManifestA = " manifest=\""+ ShowAttribute MaxA = " max=\""+ ShowAttribute MaxlengthA = " maxlength=\""+ ShowAttribute MinlengthA = " minlength=\""+ ShowAttribute MediaA = " media=\""+ ShowAttribute MethodA = " method=\""+ ShowAttribute MinA = " min=\""+ ShowAttribute MultipleA = " multiple=\""+ ShowAttribute MutedA = " muted=\""+ ShowAttribute NameA = " name=\""+ ShowAttribute NovalidateA = " novalidate=\""+ ShowAttribute OpenA = " open=\""+ ShowAttribute OptimumA = " optimum=\""+ ShowAttribute PatternA = " pattern=\""+ ShowAttribute PingA = " ping=\""+ ShowAttribute PlaceholderA = " placeholder=\""+ ShowAttribute PosterA = " poster=\""+ ShowAttribute PreloadA = " preload=\""+ ShowAttribute RadiogroupA = " radiogroup=\""+ ShowAttribute ReadonlyA = " readonly=\""+ ShowAttribute RelA = " rel=\""+ ShowAttribute RequiredA = " required=\""+ ShowAttribute ReversedA = " reversed=\""+ ShowAttribute RowsA = " rows=\""+ ShowAttribute RowspanA = " rowspan=\""+ ShowAttribute SandboxA = " sandbox=\""+ ShowAttribute ScopeA = " scope=\""+ ShowAttribute ScopedA = " scoped=\""+ ShowAttribute SeamlessA = " seamless=\""+ ShowAttribute SelectedA = " selected=\""+ ShowAttribute ShapeA = " shape=\""+ ShowAttribute SizeA = " size=\""+ ShowAttribute SizesA = " sizes=\""+ ShowAttribute SlotA = " slot=\""+ ShowAttribute SpanA = " span=\""+ ShowAttribute SpellcheckA = " spellcheck=\""+ ShowAttribute SrcA = " src=\""+ ShowAttribute SrcdocA = " srcdoc=\""+ ShowAttribute SrclangA = " srclang=\""+ ShowAttribute SrcsetA = " srcset=\""+ ShowAttribute StartA = " start=\""+ ShowAttribute StepA = " step=\""+ ShowAttribute StyleA = " style=\""+ ShowAttribute SummaryA = " summary=\""+ ShowAttribute TabindexA = " tabindex=\""+ ShowAttribute TargetA = " target=\""+ ShowAttribute TitleA = " title=\""+ ShowAttribute TypeA = " type=\""+ ShowAttribute UsemapA = " usemap=\""+ ShowAttribute ValueA = " value=\""+ ShowAttribute WidthA = " width=\""+ ShowAttribute WrapA = " wrap=\"" type family OpenTag e where OpenTag e = AppendSymbol (AppendSymbol "<" (ShowElement e)) ">"@@ -681,9 +678,6 @@ (><) ('FingerTree ss r) ('FingerTree (s ': ss2) r2) = 'FingerTree (Append ss (AppendSymbol r s ': ss2)) r2 (><) ('FingerTree ss r) ('FingerTree '[] r2) = 'FingerTree ss (AppendSymbol r r2) -type family ToList (t :: FingerTree) where- ToList ('FingerTree ss r) = Append ss '[r]- -- | Flatten a html tree of elements into a type list of tags. type family ToTypeList a :: FingerTree where ToTypeList (a # ()) = ToTypeList a@@ -693,7 +687,7 @@ ToTypeList ((a :@: b) ()) = AppendSymbol "<" (ShowElement a) <| ToTypeList b |> If (HasContent (GetInfo a)) (AppendSymbol ">" (CloseTag a)) ">" ToTypeList (a > b) = OpenTag a <| ToTypeList b |> CloseTag a ToTypeList ((a :@: b) c) = (AppendSymbol "<" (ShowElement a) <| ToTypeList b) >< (">" <| ToTypeList c |> CloseTag a)- ToTypeList (a := b) = 'FingerTree '[AppendSymbol (AppendSymbol " " (ShowAttribute a)) "=\""] "\""+ ToTypeList (a := b) = 'FingerTree '[ShowAttribute a] "\"" ToTypeList (Proxy x) = 'FingerTree '[] x ToTypeList x = 'FingerTree '[""] "" @@ -759,18 +753,6 @@ Take 4 (x1 ': x2 ': x3 ': x4 ': _) = '[x1, x2, x3, x4] 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)- Last (_ ': _ ': x ': xs) = Last (x ': xs)- Last (_ ': x ': xs) = Last (x ': xs)- Last (x ': xs) = x- -- | Type of type level information about tags. data ElementInfo (contentCategories :: [ContentCategory])@@ -823,9 +805,7 @@ Elem a (_ : xs) = Elem a xs Elem a '[] = False -newtype Tagged (proxies :: [Symbol]) target = Tagged target--type Symbols a = ToList (ToTypeList a)+newtype Tagged (proxies :: k) target = Tagged target -- | Get type list of valid elements for a given attribute. An empty list signifies global attribute. type family GetAttributeInfo a where
type-of-html.cabal view
@@ -1,5 +1,5 @@ name: type-of-html-version: 0.5.1.1+version: 0.5.1.2 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@@ -49,7 +49,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: bench- ghc-options: -Wall+ ghc-options: -Wall -O2 default-language: Haskell2010 build-depends: base >= 4.10 && < 4.11 , type-of-html