type-of-html 1.6.0.0 → 1.6.1.0

raw patch · 15 files changed

+801/−514 lines, 15 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• Readme.md +97/−62
• bench/Alloc.hs +33/−33
• bench/Big.hs +0/−96
• bench/Blaze.hs +2/−69
• bench/ExampleBlaze.hs +219/−0
• bench/ExampleTypeOfHtml.hs +217/−0
• bench/Medium.hs +85/−95
• bench/Perf.hs +16/−33
• src/Html.hs +2/−2
• src/Html/Element/Obsolete.hs +0/−105
• src/Html/Obsolete.hs +105/−0
• src/Html/Reify.hs +4/−4
• src/Html/Type/Internal.hs +10/−11
• type-of-html.cabal +5/−4

@@ -1,5 +1,11 @@ # Revision history for type-of-html +## 1.6.1.0  -- 2020-11-07++* visual fixes+* benchmark cleanup+* added example+ ## 1.6.0.0  -- 2020-11-06  * major overhaul

@@ -159,13 +159,20 @@  This is comparing blaze with `type-of-html`: -![type-of-html](https://user-images.githubusercontent.com/5609565/37879227-765df128-3075-11e8-9270-3839ce1852c8.png)+![type-of-html](https://user-images.githubusercontent.com/5609565/98452828-48a97780-2153-11eb-8e6c-2981c69e7d0d.png)  To look at the exact code of this benchmark look into the repo.  The-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.+big table benchmark here is only a 50x10 table. Using a 1000x10 table+like on the blaze homepage yields even better relative performance,+but would make the other benchmarks unreadable. The synthetic page is+just a small page with a lot of elements and a lot of attributes but+with minimal text. The hackage upload benchmark is a rendering of+https://http://hackage.haskell.org/upload which contains a lot of text. +Note how the `compactHTML` rendering is about 150 times faster than+blaze for the real world case. Look below for the explanation of the+difference between `type-of-html` and `compactHTML`.+ 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 and attributes as kinds and map these@@ -321,66 +328,15 @@ main = putStrLn $ renderCompactString myDoc (Put "Bob") (Put (42 :: Int)) ``` -## Comparision to lucid and blaze-html--Advantages of `type-of-html`:-- more or less 10 times faster on a medium sized page-- 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 (30sec for a medium sized page, with `-O0` only ~2sec)-- needs at least ghc 8--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-allows you to gradually migrate, or only write the hotpath in a more-efficient representation.--## Example usage+You can easily investigate your CompactHTML in ghci thanks to a colorful prettified show instance:  ```haskell-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}--module Main where--import Html--import Data.Text.Lazy.IO as TL--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]-                       )-                    )-                 # Button :> I-                 )-              )-           )-        )-     )+>>> myDoc+"<div>Hello, my name is: "+name+"</div><div>I&#39;m of age: "+age+"</div>" ```  ## Custom Attributes and Elements@@ -426,6 +382,85 @@ main :: IO () main = print $ banana :@ AsyncA:="foo" :> "bar" ```++## Notation++If you want a bit cleaner notation which resembles blaze, you can use+the language pragma rebindable syntax:++```haskell+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}+{-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RebindableSyntax #-}++import Prelude+import Html++main :: IO ()+main = print $+  Html :> do+    Body :> do+      H1 :@ IdA:="a" :> do+        Img+        Strong :@ ClassA:="b" :> (0 :: Int)+      Div :> do+        Div :@ IdA:="c" :> (1 :: Int)+      Div :> do+        Form :@ ClassA:="d" :> do+          Fieldset :> do+            Div :@ IdA:="e" :> do+              Div :> do+                Label :@ ClassA:="f" :> "a"+                Select :> do+                  Option :@ IdA:="g" :> "b"+                  Option :> "c"+                Div :@ ClassA:="h" :> "d"+              I :> "a"+            Button :@ IdA:="i" :> do+              I :> "e"+  where+    (>>) = (#)+```++## Comparision to lucid and blaze-html++Advantages of `type-of-html`:+- more or less 10 times faster on a medium sized page+- 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 (30sec for a medium sized page, with `-O0` only ~2sec)+- needs at least ghc 8.2+- you may need to specify {-# OPTIONS_GHC -freduction-depth=0 #-}++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+allows you to gradually migrate, or only write the hotpath in a more+efficient representation.++## Example usage++If you'd like to see a full fledged example, go to following module+from the benchmarks of this library:+[Example](https://github.com/knupfer/type-of-html/bench/ExampleTypeOfHtml.hs)+It is a verbatim implementation of the source of+http://hackage.haskell.org/upload++If you wish, you can compare the clarity of the code with an+implementation in blaze:+[Example](https://github.com/knupfer/type-of-html/bench/ExampleBlaze.hs)++I'd argue that the source code in `type-of-html` has some visual advantages:+- qualified imports aren't needed+- it's more consistent, e.g. no spurious underscores (e.g. `rel_` vs `ref`)+- clearer distinction between data and functions, in `type-of-html`+  elements and attributes are capitalized++Note that the type of `hackageUpload` is quite big (about 1kLOC of type signature), so don't even bother to ask ghci :).  ## FAQ 

@@ -14,9 +14,9 @@  import Html -import qualified Small          as S-import qualified Medium         as M-import qualified Big            as B+import qualified Small             as S+import qualified Medium            as M+import qualified ExampleTypeOfHtml as EX  import Weigh import Data.Proxy@@ -24,37 +24,37 @@ main :: IO () main = mainWith $ do -  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 ()                                 [    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)                         [   2616 ,     0 ,      64 ,   -96 ,     64 ]+  f "AttrShort"            M.attrShort ()                        [   2680 ,   -16 ,     856 ,     0 ,      0 ]+  f "pageA"                M.pageA ()                            [   2504 ,  -176 ,      64 ,     0 ,      0 ]+  f "AttrLong"             M.attrLong ()                         [   2680 ,   -16 ,     856 ,     0 ,      0 ]+  f "Big table"            M.table (50,10)                       [ 120072 ,     0 ,    1600 , -8096 ,   7952 ]+  f "hackage upload"       EX.hackageUpload ()                   [ 698784 ,   488 , -204792 , -1408 , -47120 ] -  where versions =                                               [   802 ,   804 ,  806 ,   808 ,  810 ]+  where versions =                                               [    802 ,   804 ,     806 ,   808 ,    810 ]          ghc = fromInteger . sum . take (length $ takeWhile (<= (__GLASGOW_HASKELL__ :: Int)) versions) 

@@ -1,96 +0,0 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}--{-# LANGUAGE NoMonomorphismRestriction #-}--module Big where--import Html-import Medium (attrShort, attrLong, table)--page x =-  Html :>-    ( Body :>-      ( H1 :@ (IdA := "a") :>-        ( Img-        # Strong :@ (ClassA := "b") :> (0 :: Int)-        )-      # Div :>-        ( Div :@ (IdA := "c") :> (1 :: Int)-        )-      # attrShort ""-      # attrLong ""-      # table (3,3)-      # Div :>-        ( Form :@ (ClassA := "d") :>-          ( Fieldset :>-            ( Div :@ (IdA := "e") :>-              ( Div :>-                ( Label :@ (ClassA := "f") :> "g"-                # Select :>-                  ( Option :@ (IdA := "h") :> "i"-                  # Option :> "j"-                  )-                # Div :@ (ClassA := "k") :> "l"-                )-              # I :> x-              )-            # Button :@ (IdA := "m") :> (I :> "n")-            )-          )-        )-      # Div :>-        ( Form :@ (ClassA := "o") :>-          ( Fieldset :>-            ( Div :@ (IdA := "p") :>-              ( Div :>-                ( Label :@ (ClassA := "q") :> "r"-                # Select :>-                  ( Option :@ (IdA := "s") :> "4"-                  # Option :> "u"-                  )-                # Div :@ (ClassA := "v") :> "w"-                )-              # I :> x-              )-            # Button :@ (IdA := "x") :> (I :> "y")-            )-          )-        )-      # Div :>-        ( Form :@ (ClassA := "z") :>-          ( Fieldset :>-            ( Div :@ (IdA := "A") :>-              ( Div :>-                ( Label :@ (ClassA := "B") :> "C"-                # Select :>-                  ( Option :@ (IdA := "D") :> "E"-                  # Option :> "F"-                  )-                # Div :@ (ClassA := "G") :> "H"-                )-              # I :> x-              )-            # Button :@ (IdA := "I") :> (I :> "J")-            )-          )-        )-      # Div :>-        ( Form :@ (ClassA := "K") :>-          ( Fieldset :>-            ( Div :@ (IdA := "L") :>-              ( Div :>-                ( Label :@ (ClassA := "M") :> "N"-                # Select :>-                  ( Option :@ (IdA := "O") :> "P"-                  # Option :> "Q"-                  )-                # Div :@ (ClassA := "R") :> "S"-                )-              # I :> x-              )-            # Button :@ (IdA := "T") :> (I :> "U")-            )-          )-        )-      )-    )

@@ -8,73 +8,6 @@ import qualified Text.Blaze.Html5            as B import qualified Text.Blaze.Html5.Attributes as BA -blazeMinimal :: B.Html -> B.Html-blazeMinimal = B.div--blazeHelloWorld :: B.Html -> B.Html-blazeHelloWorld x =-  B.html $ do-    B.head $ do-      B.title x-    B.body $ do-      B.p "Hello World!"--blazePage :: B.Html -> B.Html-blazePage x =-  B.html $ do-    B.body $ do-      B.h1 $ do-        B.img-        B.strong (B.toHtml (0 :: Int))-      B.div $ do-        B.div (B.toHtml (1 :: Int))-      B.div $ do-        B.form $ do-          B.fieldset $ do-            B.div $ do-              B.div $ do-                B.label "a"-                B.select $ do-                  B.option "b"-                  B.option "c"-                B.div "d"-              B.i x-            B.button $ B.i "e"--blazeAttrShort :: B.AttributeValue -> B.Html-blazeAttrShort x-  = B.i ! BA.accesskey       "a"-  $ B.i ! BA.class_          "b"-  $ B.i ! BA.contenteditable "c"-  $ B.i ! BA.contextmenu     "d"-  $ B.i ! BA.dir             "e"-  $ B.i ! BA.draggable       "f"-  $ B.i ! BA.hidden          mempty-  $ B.i ! BA.id              "h"-  $ B.i ! BA.itemprop        "i"-  $ B.i ! BA.lang            "j"-  $ B.i ! BA.spellcheck      "k"-  $ B.i ! BA.style           "l"-  $ B.i ! BA.title           x-  $ "m"--blazeAttrLong :: B.AttributeValue -> B.Html-blazeAttrLong x-  = B.i ! BA.accesskey       "a"-        ! BA.class_          "b"-        ! BA.contenteditable "c"-        ! BA.contextmenu     "d"-        ! BA.dir             "e"-        ! BA.draggable       "f"-        ! BA.hidden          mempty-        ! BA.id              "h"-        ! BA.itemprop        "i"-        ! BA.lang            "j"-        ! BA.spellcheck      "k"-        ! BA.style           "l"-        ! BA.title           x-        $ "m"- blazePageA :: B.Html -> B.Html blazePageA x =   B.html $ do@@ -95,7 +28,8 @@                   B.option "c"                 B.div ! BA.class_ "h" $ "d"               B.i x-            B.button ! BA.id "i" $ B.i "e"+            B.button ! BA.id "i" $ do+              B.i "e"  blazeTable :: (Int, Int) -> B.Html blazeTable (n, m)@@ -103,4 +37,3 @@   . replicateM_ n   . B.tr   $ mapM_ (B.td . B.toHtml) [1..m]-

@@ -0,0 +1,219 @@+{-# LANGUAGE OverloadedStrings #-}++module ExampleBlaze (hackageUpload) where++import Data.String+import Text.Blaze.Html5 ((!))++import qualified Text.Blaze.Html4.Strict     as H4+import qualified Text.Blaze.Html5            as B+import qualified Text.Blaze.Html5.Attributes as BA++-- [2020-11-07] http://hackage.haskell.org/upload+hackageUpload :: B.Html -> B.Html+hackageUpload title =+  B.docTypeHtml $ do+    B.head $ do+      B.meta ! BA.name "viewport" ! BA.content "width=device-width, initial-scale=1"+      B.link ! BA.href "https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" ! BA.rel "stylesheet"+      B.link ! BA.rel "stylesheet" ! BA.href "/static/hackage.css" ! BA.type_ "text/css"+      B.link ! BA.rel "icon" ! BA.type_ "image/png" ! BA.href "/static/favicon.png"+      B.link ! BA.rel "search" ! BA.type_ "application/opensearchdescription+xml" ! BA.title "Hackage" ! BA.href "/packages/opensearch.xml"+      "<!-- Global site tag (gtag.js) - Google Analytics -->"+      B.script ! BA.async mempty ! BA.src "https://www.googletagmanager.com/gtag/js?id=UA-83290513-3" $ mempty+      B.script $ do+        fromString $ unlines+          [ "window.dataLayer = window.dataLayer || [];"+          , "function gtag(){dataLayer.push(arguments);}"+          , "gtag('js', new Date());"+          , "gtag('config', 'UA-83290513-3');"+          ]+      B.title $ title -- "Uploading packages and package candidates | Hackage"+    B.body $ do+      B.div ! BA.id "page-header" $ do+        B.a ! BA.class_ "caption" ! BA.href "/" $ "Hackage :: [Package]"+        B.ul ! BA.class_ "links" ! BA.id "page-menu" $ do+          B.li $ do+            B.form ! BA.action "/packages/search" ! BA.method "get" ! BA.class_ "search" $ mempty+            B.button ! BA.type_ "submit" $ "Search&nbsp;"+            B.input ! BA.type_ "text" ! BA.name "terms"+          B.li $ do+            B.a ! BA.href "/packages/browse" $ "Browse"+          B.li $ do+            B.a ! BA.href "/packages/recent" $ "What's new"+          B.li $ do+            B.a ! BA.href "/upload" $ "Upload"+          B.li $ do+            B.a ! BA.href "/accounts" $ "User accounts"+      B.div ! BA.id "content" $ do+        B.h2 $ "Uploading packages"+        B.div ! BA.style "font-size: large; text-align: center;" $ do+          "Upload and publish a package "+          B.strong $ "permanently"+          ": "+          B.a ! BA.href "/packages/upload" $ "Upload"+        B.p $ do+          "Uploading a package puts it in the "+          B.a ! BA.href "/packages/browse" $ "package index"+          "so that anyone can download it and view information about it. "+          B.strong $ "You can only upload a package version once and this cannot be undone"+          ", so try to get it right the first time! To reduce the risk of mistakes it's recommended to use the "+          B.a ! BA.href "!candidates" $ "package candidates feature"+          " described below."+        B.p $ do+          "Because each package added to the main package index has a cost of operation and maintenance associated to it, "+          B.strong $ "your package should strive to provide value for the community by being intended to be useful to others"+          ", which entails giving your package a meaningful synopsis/description as well as ensuring your package is installable by helping with providing accurate meta-data."+        B.p $ do+          "Packages must be in the form produced by Cabal's "+          B.a ! BA.href "http://www.haskell.org/cabal/users-guide/installing-packages.html!setup-sdist" $ "sdist"+          " command: a gzipped tar file "+          B.em $ "package"+          "-"+          B.em $ "version"+          H4.tt $ ".tar.gz"+          " comprising a directory "+          B.em $ "package"+          "-"+          B.em $ "version"+          " containing a package of that name and version, including "+          B.em $ "package"+          H4.tt $ ".cabal"+          ". See the notes at the bottom of the page."+        B.h3 ! BA.id "versioning_and_curation" $ "Package versioning and curation"+        B.p $ do+          "By default, uploaded packages are "+          B.i $ "curated"+          " which means that both maintainers and hackage trustees may revise their metadata (particularly involving version bounds) to guide build tools in producing install-plans. (For more information on revisions, see the "+          B.a ! BA.href "https://github.com/haskell-infra/hackage-trustees/blob/master/revisions-information.md" $ "FAQ"+          ")."+        B.p $ do+          "In order to ensure the integrity and well-functioning of the Hackage/Cabal ecosystem, all curated packages "+          B.abbr ! BA.title "[RFC2119] The word 'should' is intended to denote that there may exist valid reasons in particular circumstances to ignore a particular item, but the full implications MUST be understood and carefully weighed before choosing a different course" $ "should"+          " follow Haskell's "+          B.a ! BA.href "https://pvp.haskell.org/"$"Package Versioning Policy (PVP)"+          "."+        B.p $ do+          "In particular, be aware that although the "+          B.a ! BA.href "https://pvp.haskell.org/" $ "PVP"+          " and "+          B.a ! BA.href "http://semver.org/" $ "SemVer"+          " are based on the same concepts they differ significantly in structure and consequently are "+          B.em $ "not compatible"+          " with each other. Please consult the "+          B.a ! BA.href "https://pvp.haskell.org/faq/!semver" $ "PVP/SemVer FAQ section"+          " for more details about the differences and related issues."+        B.p $ do+          "Further, an important property of the PVP contract is that it can only be effective and provide strong enough guarantees if it is followed not only by an individual package, but also by that package's transitive dependencies. Consequently, packages which are curated should aim to depend only on other curated packages."+        B.p $ do+          "In the course of the curation process, the "+          B.a ! BA.href "/packages/trustees" $ "Hackage Trustees"+          " need to be able to contact package maintainers, to inform them about and help to resolve issues with their packages (including its meta-data) which affect the Hackage ecosystem."+        B.p $ do+          "Package uploaders may choose to exclude individual package uploads from curation, by setting the "+          H4.tt $ "x-curation:"+          " field of the package's cabal file to "+          H4.tt $ "uncurated"+          ". Packages which are uncurated have no expectations on them regarding versioning policy.  Trustees or maintainers may "+          B.i $ "adopt"+          " uncurated packages into the curated layer through metadata revisions. Metadata revisions must not set the value of the"+          H4.tt $ "x-curation"+          " field to any variant of "+          H4.tt $ "uncurated"+          "."+        B.p $ do+          "Two variants of the "+          H4.tt $ "uncurated"+          " property are supported. First, "+          H4.tt $ "uncurated-no-trustee-contact"+          ", which indicates that maintainers do not wish to be contacted by trustees regarding any metadata issues with the package. (Contact may still occur over issues that are not related to curation, such as licensing, etc.). Second, "+          H4.tt $ "uncurated-seeking-adoption"+          ", which indicates that maintainers would like their package to be adopted in the curated layer, but currently some issue prevents this, which they would like assistance with."+        B.p $ "In the future, metadata regarding curation will be made available in the UI of Hackage, and different derived indexes will be provided for the uncurated and curated layers of packages."+        B.h3 $ "Open source licenses"+        B.p $ do+          "The code and other material you upload and distribute via this site must be under an "+          B.em $ "open source license"+          ". This is a service operated for the benefit of the community and that is our policy. It is also so that we can operate the service in compliance with copyright laws."+        B.p $ do+          "The Hackage operators do not want to be in the business of making judgements on what is and is not a valid open source license, but we retain the right to remove packages that are not under licenses that are open source in spirit, or that conflict with our ability to operate this service. (If you want advice, see the ones "+          B.a ! BA.href "/package/Cabal/docs/Distribution-License.html" $ "Cabal recommends"+          ".)"+        B.p $ do+          "The Hackage operators do "+          B.em $ "not"+          " need and are "+          B.em $ "not"+          " asking for any rights beyond those granted by the open source license you choose to use. All normal open source licenses grant enough rights to be able to operate this service."+        B.p $ do+          "In particular, we expect as a consequence of the license that:"+        B.ol $ do+          B.li $ do+            "we have the right to distribute what you have uploaded to other people"+          B.li $ do+            "we have the right to distribute certain derivatives and format conversions, including but not limited to:"+            B.ul $ do+              B.li $ do+                "documentation derived from the package"+              B.li $ do+                "alternative presentations and formats of code (e.g. html markup)"+              B.li $ do+                "excerpts and presentation of package metadataw"+              B.li $ do+                "modified versions of package metadata"+        B.p $ "Please make sure that you comply with the license of all code and other material that you upload. For example, check that your tarball includes the license files of any 3rd party code that you include."+        B.h3 $ "Privileges"+        B.p $ do+          "To upload a package, you'll need a Hackage "+          B.a ! BA.href "/accounts" $ "username"+          " and password."+        B.p $ "If you upload a package or package candidate and no other versions exist in the package database, you become part of the maintainer group for that package, and you can add other maintainers if you wish. If a maintainer group exists for a package, only its members can upload new versions of that package."+        B.p $ do+          "If there is no maintainer, the uploader can remove themselves from the group, and a "+          B.a ! BA.href "/packages/trustees" $ "package trustee"+          " can add anyone who wishes to assume the responsibility. The "+          B.code $ "Maintainer"+          " field of the Cabal file should be "+          B.code $ "None"+          " in this case. If a package is being maintained, any release not approved and supported by the maintainer should use a different package name. Then use the "+          B.code $ "Maintainer"+          " field as above either to commit to supporting the fork yourself or to mark it as unsupported."+        B.h3 ! BA.id "candidates" $ "Package Candidates"+        B.p $ do+          B.a ! BA.href "/packages/candidates" $ do+            "Package "+            B.em $ "candidates"+          " are a way to preview the package page, view any warnings or possible errors you might encounter, and let others install it before publishing it to the main index. (Note: you can view these warnings with 'cabal check'.) You can have multiple candidates for each package at the same time so long as they each have different versions. Finally, you can publish a candidate to the main index if it's not there already."+        B.p $ do+          "Package candidates have not yet been fully implemented and are still being improved; see "+          B.a ! BA.href "https://github.com/haskell/hackage-server/projects/1" $ "Package Candidates Project Dashboard"+          " for an overview of what still needs to be done."+        B.div ! BA.style "font-size: large; text-align: center;" $ do+          B.a ! BA.href "/packages/candidates/upload" $ "Upload a package candidate"+        B.h3 $ "Notes"+        B.ul $ do+          B.li $ do+            "You should check that your source bundle builds, including the haddock documentation if it's a library."+          B.li $ do+            "Categories are determined by whatever you put in the "+            B.code $ "Category"+            " field. You should try to pick existing categories when possible. You can have more than one category, separated by commas. If no other versions of the package exist, the categories automatically become the package's tags."+          B.li $ do+            "Occasional changes to the GHC base package can mean that some work needs to be done to make packages compatible across a range of versions. See "+            B.a ! BA.href "https://github.com/haskell-infra/hackage-trustees/blob/master/cookbook.md" $ "these notes"+            " for some tips in how to do so. There are some notes for upgrading"+            B.a ! BA.href "http://www.haskell.org/haskellwiki/Upgrading_packages" $ "much older"+            " packages as well."+          B.li $ do+            "The hackage-server attempts to build documentation for library packages, but this can fail. Maintainers can generate their own documentation and upload it by using something along the lines of the shell script below (note that the last two commands are the key ones):"+            B.pre $ do+              fromString $ unlines+                [ "#!/bin/sh"+                , "set -e"+                , ""+                , "dir=$(mktemp -d dist-docs.XXXXXX)"+                , "trap 'rm -r \"$dir\"' EXIT"+                , "# assumes cabal 2.4 or later"+                , "cabal v2-haddock --builddir=\"$dir\" --haddock-for-hackage --enable-doc"+                , "cabal upload -d --publish $dir/*-docs.tar.gz"+                ]

@@ -0,0 +1,217 @@+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}+{-# LANGUAGE RebindableSyntax #-}++module ExampleTypeOfHtml (hackageUpload) where++import Prelude+import Html+import qualified Html.Obsolete as O++-- [2020-11-07] http://hackage.haskell.org/upload+hackageUpload title = let (>>) = (#) in do+  DOCTYPE+  Html :> do+    Head :> do+      Meta :@ (NameA:="viewport" # ContentA:="width=device-width, initial-scale=1")+      Link :@ (HrefA:="https://fonts.googleapis.com/css?family=PT+Sans:400,400i,700" # RelA:="stylesheet")+      Link :@ (RelA:="stylesheet" # HrefA:="/static/hackage.css" # TypeA:="text/css")+      Link :@ (RelA:="icon" # TypeA:="image/png" # HrefA:="/static/favicon.png")+      Link :@ (RelA:="search" # TypeA:="application/opensearchdescription+xml" # TitleA:="Hackage" # HrefA:="/packages/opensearch.xml")+      Raw "<!-- Global site tag (gtag.js) - Google Analytics -->"+      Script :@ (AsyncA # SrcA:="https://www.googletagmanager.com/gtag/js?id=UA-83290513-3")+      Script :> do+        Raw $ unlines+          [ "window.dataLayer = window.dataLayer || [];"+          , "function gtag(){dataLayer.push(arguments);}"+          , "gtag('js', new Date());"+          , "gtag('config', 'UA-83290513-3');"+          ]+      Title :> title -- "Uploading packages and package candidates | Hackage"+    Body :> do+      Div :@ IdA:="page-header" :> do+        A :@ (ClassA:="caption" # HrefA:="/") :> "Hackage :: [Package]"+        Ul :@ (ClassA:="links" # IdA:="page-menu") :> do+          Li :> do+            Form :@ (ActionA:="/packages/search" # MethodA:="get" # ClassA:="search")+            Button :@ TypeA:="submit" :> "Search&nbsp;"+            Input :@ (TypeA:="text" # NameA:="terms")+          Li :> do+            A :@ HrefA:="/packages/browse" :> "Browse"+          Li :> do+            A :@ HrefA:="/packages/recent" :> "What's new"+          Li :> do+            A :@ HrefA:="/upload" :> "Upload"+          Li :> do+            A :@ HrefA:="/accounts" :> "User accounts"+      Div :@ IdA:="content" :> do+        H2 :> "Uploading packages"+        Div :@ StyleA:="font-size: large; text-align: center;" :> do+          "Upload and publish a package "+          Strong :> "permanently"+          ": "+          A :@ HrefA:="/packages/upload" :> "Upload"+        P :> do+          "Uploading a package puts it in the "+          A :@ HrefA:="/packages/browse" :> "package index"+          "so that anyone can download it and view information about it. "+          Strong :> "You can only upload a package version once and this cannot be undone"+          ", so try to get it right the first time! To reduce the risk of mistakes it's recommended to use the "+          A :@ HrefA:="#candidates" :> "package candidates feature"+          " described below."+        P :> do+          "Because each package added to the main package index has a cost of operation and maintenance associated to it, "+          Strong :> "your package should strive to provide value for the community by being intended to be useful to others"+          ", which entails giving your package a meaningful synopsis/description as well as ensuring your package is installable by helping with providing accurate meta-data."+        P :> do+          "Packages must be in the form produced by Cabal's "+          A :@ HrefA:="http://www.haskell.org/cabal/users-guide/installing-packages.html#setup-sdist" :> "sdist"+          " command: a gzipped tar file "+          Em :> "package"+          "-"+          Em :> "version"+          O.tt :> ".tar.gz"+          " comprising a directory "+          Em :> "package"+          "-"+          Em :> "version"+          " containing a package of that name and version, including "+          Em :> "package"+          O.tt :> ".cabal"+          ". See the notes at the bottom of the page."+        H3 :@ IdA:="versioning_and_curation" :> "Package versioning and curation"+        P :> do+          "By default, uploaded packages are "+          I :> "curated"+          " which means that both maintainers and hackage trustees may revise their metadata (particularly involving version bounds) to guide build tools in producing install-plans. (For more information on revisions, see the "+          A :@ HrefA:="https://github.com/haskell-infra/hackage-trustees/blob/master/revisions-information.md" :> "FAQ"+          ")."+        P :> do+          "In order to ensure the integrity and well-functioning of the Hackage/Cabal ecosystem, all curated packages "+          Abbr :@ TitleA:="[RFC2119] The word 'should' is intended to denote that there may exist valid reasons in particular circumstances to ignore a particular item, but the full implications MUST be understood and carefully weighed before choosing a different course" :> "should"+          " follow Haskell's "+          A :@ HrefA:="https://pvp.haskell.org/":>"Package Versioning Policy (PVP)"+          "."+        P :> do+          "In particular, be aware that although the "+          A :@ HrefA:="https://pvp.haskell.org/" :> "PVP"+          " and "+          A :@ HrefA:="http://semver.org/" :> "SemVer"+          " are based on the same concepts they differ significantly in structure and consequently are "+          Em :> "not compatible"+          " with each other. Please consult the "+          A :@ HrefA:="https://pvp.haskell.org/faq/#semver" :> "PVP/SemVer FAQ section"+          " for more details about the differences and related issues."+        P :> do+          "Further, an important property of the PVP contract is that it can only be effective and provide strong enough guarantees if it is followed not only by an individual package, but also by that package's transitive dependencies. Consequently, packages which are curated should aim to depend only on other curated packages."+        P :> do+          "In the course of the curation process, the "+          A :@ HrefA:="/packages/trustees" :> "Hackage Trustees"+          " need to be able to contact package maintainers, to inform them about and help to resolve issues with their packages (including its meta-data) which affect the Hackage ecosystem."+        P :> do+          "Package uploaders may choose to exclude individual package uploads from curation, by setting the "+          O.tt :> "x-curation:"+          " field of the package's cabal file to "+          O.tt :> "uncurated"+          ". Packages which are uncurated have no expectations on them regarding versioning policy.  Trustees or maintainers may "+          I :> "adopt"+          " uncurated packages into the curated layer through metadata revisions. Metadata revisions must not set the value of the"+          O.tt :> "x-curation"+          " field to any variant of "+          O.tt :> "uncurated"+          "."+        P :> do+          "Two variants of the "+          O.tt :> "uncurated"+          " property are supported. First, "+          O.tt :> "uncurated-no-trustee-contact"+          ", which indicates that maintainers do not wish to be contacted by trustees regarding any metadata issues with the package. (Contact may still occur over issues that are not related to curation, such as licensing, etc.). Second, "+          O.tt :> "uncurated-seeking-adoption"+          ", which indicates that maintainers would like their package to be adopted in the curated layer, but currently some issue prevents this, which they would like assistance with."+        P :> "In the future, metadata regarding curation will be made available in the UI of Hackage, and different derived indexes will be provided for the uncurated and curated layers of packages."+        H3 :> "Open source licenses"+        P :> do+          "The code and other material you upload and distribute via this site must be under an "+          Em :> "open source license"+          ". This is a service operated for the benefit of the community and that is our policy. It is also so that we can operate the service in compliance with copyright laws."+        P :> do+          "The Hackage operators do not want to be in the business of making judgements on what is and is not a valid open source license, but we retain the right to remove packages that are not under licenses that are open source in spirit, or that conflict with our ability to operate this service. (If you want advice, see the ones "+          A :@ HrefA:="/package/Cabal/docs/Distribution-License.html" :> "Cabal recommends"+          ".)"+        P :> do+          "The Hackage operators do "+          Em :> "not"+          " need and are "+          Em :> "not"+          " asking for any rights beyond those granted by the open source license you choose to use. All normal open source licenses grant enough rights to be able to operate this service."+        P :> do+          "In particular, we expect as a consequence of the license that:"+        Ol :> do+          Li :> do+            "we have the right to distribute what you have uploaded to other people"+          Li :> do+            "we have the right to distribute certain derivatives and format conversions, including but not limited to:"+            Ul :> do+              Li :> do+                "documentation derived from the package"+              Li :> do+                "alternative presentations and formats of code (e.g. html markup)"+              Li :> do+                "excerpts and presentation of package metadataw"+              Li :> do+                "modified versions of package metadata"+        P :> "Please make sure that you comply with the license of all code and other material that you upload. For example, check that your tarball includes the license files of any 3rd party code that you include."+        H3 :> "Privileges"+        P :> do+          "To upload a package, you'll need a Hackage "+          A :@ HrefA:="/accounts" :> "username"+          " and password."+        P :> "If you upload a package or package candidate and no other versions exist in the package database, you become part of the maintainer group for that package, and you can add other maintainers if you wish. If a maintainer group exists for a package, only its members can upload new versions of that package."+        P :> do+          "If there is no maintainer, the uploader can remove themselves from the group, and a "+          A :@ HrefA:="/packages/trustees" :> "package trustee"+          " can add anyone who wishes to assume the responsibility. The "+          Code :> "Maintainer"+          " field of the Cabal file should be "+          Code :> "None"+          " in this case. If a package is being maintained, any release not approved and supported by the maintainer should use a different package name. Then use the "+          Code :> "Maintainer"+          " field as above either to commit to supporting the fork yourself or to mark it as unsupported."+        H3 :@ IdA:="candidates" :> "Package Candidates"+        P :> do+          A :@ HrefA:="/packages/candidates" :> do+            "Package "+            Em :> "candidates"+          " are a way to preview the package page, view any warnings or possible errors you might encounter, and let others install it before publishing it to the main index. (Note: you can view these warnings with 'cabal check'.) You can have multiple candidates for each package at the same time so long as they each have different versions. Finally, you can publish a candidate to the main index if it's not there already."+        P :> do+          "Package candidates have not yet been fully implemented and are still being improved; see "+          A :@ HrefA:="https://github.com/haskell/hackage-server/projects/1" :> "Package Candidates Project Dashboard"+          " for an overview of what still needs to be done."+        Div :@ StyleA:="font-size: large; text-align: center;" :> do+          A :@ HrefA:="/packages/candidates/upload" :> "Upload a package candidate"+        H3 :> "Notes"+        Ul :> do+          Li :> do+            "You should check that your source bundle builds, including the haddock documentation if it's a library."+          Li :> do+            "Categories are determined by whatever you put in the "+            Code :> "Category"+            " field. You should try to pick existing categories when possible. You can have more than one category, separated by commas. If no other versions of the package exist, the categories automatically become the package's tags."+          Li :> do+            "Occasional changes to the GHC base package can mean that some work needs to be done to make packages compatible across a range of versions. See "+            A :@ HrefA:="https://github.com/haskell-infra/hackage-trustees/blob/master/cookbook.md" :> "these notes"+            " for some tips in how to do so. There are some notes for upgrading"+            A :@ HrefA:="http://www.haskell.org/haskellwiki/Upgrading_packages" :> "much older"+            " packages as well."+          Li :> do+            "The hackage-server attempts to build documentation for library packages, but this can fail. Maintainers can generate their own documentation and upload it by using something along the lines of the shell script below (note that the last two commands are the key ones):"+            Pre :> do+              Raw $ unlines+                [ "#!/bin/sh"+                , "set -e"+                , ""+                , "dir=$(mktemp -d dist-docs.XXXXXX)"+                , "trap 'rm -r \"$dir\"' EXIT"+                , "# assumes cabal 2.4 or later"+                , "cabal v2-haddock --builddir=\"$dir\" --haddock-for-hackage --enable-doc"+                , "cabal upload -d --publish $dir/*-docs.tar.gz"+                ]

@@ -1,112 +1,102 @@-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-do-bind -fno-warn-name-shadowing #-}  {-# LANGUAGE NoMonomorphismRestriction #-}+{-# LANGUAGE RebindableSyntax #-}  module Medium where +import Prelude import Html -helloWorld x =-  Html :>-    ( Head :>-      ( Title :> x-      )-    # Body :>-      ( P :> "Hello World!"-      )-    )+helloWorld x+  = Html+  :> ( Head :> Title :> x+     # Body :> P :> "Hello World!"+     )  table (n, m) = (Table :>) . replicate n . (Tr :>) $ map (Td :>) [(1::Int)..m] -page x =-  Html :>-    ( Body :>-      ( H1 :>-        ( Img-        # Strong :> (0 :: Int)-        )-      # Div :>-        ( Div :> (1 :: Int)-        )-      # Div :>-        ( Form :>-          ( Fieldset :>-            ( Div :>-              ( Div :>-                ( Label :> "a"-                # Select :>-                  ( Option :> "b"-                  # Option :> "c"-                  )-                # Div :> "d"-                )-              # I :> x+page x+  = Html+  :> ( Body+     :> ( H1+        :> ( Img+           # Strong :> (0 :: Int)+           )+        # Div :> Div :> (1 :: Int)+        # Div+        :> ( Form+           :> ( Fieldset+              :> ( Div+                 :> ( Div+                    :> ( Label :> "a"+                       # Select+                       :> ( Option :> "b"+                          # Option :> "c"+                          )+                       # Div :> "d"+                       )+                    # I :> x+                    )+                 # Button :> I :> "e"+                 )               )-            # Button :> (I :> "e")-            )-          )+           )         )-      )-    )+     ) -attrShort x =-  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"))))))))))))+attrShort x+  = 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 :@ ( 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"+  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 :@ (IdA := "a") :>-        ( Img-        # Strong :@ (ClassA := "b") :> (0 :: Int)-        )-      # Div :>-        ( Div :@ (IdA := "c") :> (1 :: Int)-        )-      # Div :>-        ( Form :@ (ClassA := "d") :>-          ( Fieldset :>-            ( Div :@ (IdA := "e") :>-              ( Div :>-                ( Label :@ (ClassA := "f") :> "h"-                # Select :>-                  ( Option :@ (IdA := "i") :> "j"-                  # Option :> "k"-                  )-                # Div :@ (ClassA := "l") :> "m"-                )-              # I :> x-              )-            # Button :@ (IdA := "n") :> (I :> "o")-            )-          )-        )-      )-    )+  Html :> do+    Body :> do+      H1 :@ IdA:="a" :> do+        Img+        Strong :@ ClassA:="b" :> (0 :: Int)+      Div :> do+        Div :@ IdA:="c" :> (1 :: Int)+      Div :> do+        Form :@ ClassA:="d" :> do+          Fieldset :> do+            Div :@ IdA:="e" :> do+              Div :> do+                Label :@ ClassA:="f" :> "a"+                Select :> do+                  Option :@ IdA:="g" :> "b"+                  Option :> "c"+                Div :@ ClassA:="h" :> "d"+              I :> x+            Button :@ IdA:="i" :> do+              I :> "e"+  where+    (>>) = (#)+

@@ -9,10 +9,11 @@  import Html -import qualified Blaze          as BL-import qualified Small          as S-import qualified Medium         as M-import qualified Big            as B+import qualified Blaze             as BL+import qualified ExampleBlaze      as BL+import qualified Small             as S+import qualified Medium            as M+import qualified ExampleTypeOfHtml as ET  import Criterion.Main import Data.String@@ -24,14 +25,13 @@ import qualified Data.Text        as T  #if __GLASGOW_HASKELL__ <= 802-import Data.Semigroup ((<>), Semigroup)+import Data.Semigroup ((<>)) #endif  main :: IO () main = defaultMain   [ small   , medium-  , big   , comparison   , scaling   ]@@ -71,7 +71,6 @@   , bench "randomStrictTextRaw" $ nf renderByteString randomStrictTextRaw   , bench "randomLazyText"      $ nf renderByteString randomLazyText   , bench "randomLazyTextRaw"   $ nf renderByteString randomLazyTextRaw-  , bench "table"               $ nf (renderByteString . M.table) (2,2)   , bench "page"                $ nf (renderByteString . M.page) "medium"   , bench "pageA"               $ nf (renderByteString . M.pageA) "medium"   , bench "attrShort"           $ nf (renderByteString . M.attrShort) "medium"@@ -102,37 +101,21 @@ randomLazyTextRaw :: Raw LT.Text randomLazyTextRaw = unsafePerformIO $ Raw . LT.pack . take 250 . randoms <$> newStdGen -big :: Benchmark-big = bgroup "Big"-  [ bench "table"  $ nf (renderByteString . M.table) (15,15)-  , bench "page"   $ nf (renderByteString . B.page) "big"-  ]- comparison :: Benchmark comparison = bgroup "Comparison"-  [ bgroup "hello world"-    [ bench "blaze-html"   $ nf (renderHtml . BL.blazeHelloWorld) (fromString "TEST")-    , bench "type-of-html" $ nf (renderByteString . M.helloWorld) "TEST"-    , bench "compactHTML"  $ nf (renderCompactByteString (compactHTML $ M.helloWorld (V @ "x"))) (Put "TEST")-    ]-  , bgroup "table"-    [ bench "blaze-html"   $ nf (renderHtml . BL.blazeTable) (4,4)-    , bench "type-of-html" $ nf (renderByteString . M.table) (4,4)-    ]-  , bgroup "small page"-    [ bench "blaze-html"   $ nf (renderHtml . BL.blazePageA) (fromString "TEST")-    , bench "type-of-html" $ nf (renderByteString . M.pageA) "TEST"-    , bench "compactHTML"  $ nf (renderCompactByteString (compactHTML $ M.pageA (V @ "x"))) (Put "TEST")-    ]-  , bgroup "medium page"-    [ bench "blaze-html"   $ nf (renderHtml . (\x -> BL.blazePageA x <> BL.blazePageA x)) (fromString "TEST")-    , bench "type-of-html" $ nf (renderByteString . (\x -> M.pageA x # M.pageA x)) "TEST"-    , bench "compactHTML"  $ nf (renderCompactByteString (compactHTML $ M.pageA (V @ "x") # M.pageA (V @ "x"))) (Put "TEST")-    ]-  , bgroup "big page"+  [ bgroup "synthetic page"     [ bench "blaze-html"   $ nf (renderHtml . (\x -> BL.blazePageA x <> BL.blazePageA x <> BL.blazePageA x <> BL.blazePageA x)) (fromString "TEST")     , bench "type-of-html" $ nf (renderByteString . (\x -> M.pageA x # M.pageA x # M.pageA x # M.pageA x)) "TEST"     , bench "compactHTML"  $ nf (renderCompactByteString (compactHTML $ M.pageA (V @ "x") # M.pageA (V @ "x") # M.pageA (V @ "x") # M.pageA (V @ "x"))) (Put "TEST")+    ]+  , bgroup "table 50x10"+    [ bench "blaze-html"   $ nf (renderHtml . BL.blazeTable) (50,10)+    , bench "type-of-html" $ nf (renderByteString . M.table) (50,10)+    ]+  , bgroup "hackage upload"+    [ bench "blaze-html"   $ nf (renderHtml . BL.hackageUpload) (fromString "Uploading packages and package candidates | Hackage")+    , bench "type-of-html" $ nf (renderByteString . ET.hackageUpload) "Uploading packages and package candidates | Hackage"+    , bench "compactHTML"  $ nf (renderCompactByteString (compactHTML $ ET.hackageUpload (V @ "x"))) (Put "Uploading packages and package candidates | Hackage")     ]   ] 

@@ -65,7 +65,7 @@   ) BL.empty . renderBuilder  renderCompactHTML :: Retrievable a => (Builder -> f) -> CompactHTML a -> Retrieve f a-renderCompactHTML = retrieve mempty+renderCompactHTML = retrieve id  -- | Render a compacted html document to a Builder. renderCompactBuilder :: Retrievable a => CompactHTML a -> Retrieve Builder a@@ -102,7 +102,7 @@             go _ = []             f = BL.toStrict . toLazyByteString . unConv . mconcat . lefts     indexVar :: forall a. Compactable a => a -> String -> Int-    indexVar _ s = fromJust (elemIndex s (showTypeList @ (Reverse (Variables a))))+    indexVar _ s = fromJust (elemIndex s (showTypeList @ (Variables a)))  -- | Show instances to faciliate ghci development. instance Document (a := b) => Show (a := b) where show = renderString

@@ -1,105 +0,0 @@-{-# 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"--- <center>barf</center>--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

@@ -0,0 +1,105 @@+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds     #-}+{-# LANGUAGE PolyKinds     #-}++module Html.Obsolete where++import Html.Type++-- | Functions to create obsolete html elements.+--+-- Usage:+--+-- >>> center :> "barf"+-- <center>barf</center>++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

@@ -29,7 +29,7 @@  import qualified Data.Sequence as S -type Compactable' a = (ShowTypeList (Reverse (Variables a)), R 'True (T (ToList a) a))+type Compactable' a = (ShowTypeList (Variables a), R 'True (T (ToList a) a))  -- | Constraint for compactable html documents.  It's a type family to avoid an -- error about FlexibleContexts and a warning about MonoLocalBinds.@@ -45,13 +45,13 @@  -- | List of Symbols for which a render function can be created. class Retrievable a where-  retrieve :: [Builder] -> (Builder -> f) -> CompactHTML a -> Retrieve f a+  retrieve :: ([Builder] -> [Builder]) -> (Builder -> f) -> CompactHTML a -> Retrieve f a  instance (KnownSymbol x, Retrievable xs) => Retrievable (x ': xs) where-  retrieve m f (MkCompactHTML c1 c2) (Put x) = retrieve (unConv (convert x) : m) f (MkCompactHTML @ xs c1 c2)+  retrieve m f (MkCompactHTML c1 c2) (Put x) = retrieve (m . (unConv (convert x) :)) f (MkCompactHTML @ xs c1 c2)  instance Retrievable '[] where-  retrieve m f (MkCompactHTML bs is) = f $ byteString bs <> foldMap (\(i,b) -> m !! i <> byteString b) is+  retrieve m f (MkCompactHTML bs is) = f $ byteString bs <> foldMap (\(i,b) -> m [] !! i <> byteString b) is  type Document' a = R 'False (T (ToList a) a) 

@@ -1321,10 +1321,10 @@  -- | Combine two elements or attributes sequentially. ----- >>> i_ () # div_ ()+-- >>> I # Div -- <i></i><div></div> ----- >>> i_A (A.id_ "a" # A.class_ "b") "c"+-- >>> I :@ (IdA:="a" # ClassA:="b") :> "c" -- <i id="a" class="b">c</i> data (#) a b = (:#:) a b {-# INLINE (#) #-}@@ -1491,9 +1491,15 @@ -- | 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+-- | A compacted html documented with it's variables annoted as a list+-- of Symbols.  It's Show instance is quite useful for developping: It+-- highlights variables and renders the rest of the html.+data CompactHTML (a :: [Symbol]) = MkCompactHTML ByteString [(Int, ByteString)] +instance ShowTypeList a => Show (CompactHTML a) where+  show (MkCompactHTML bs xs) = show bs ++ foldMap (\(i,b) -> "\n\ESC[36m" ++ vars !! i ++ "\ESC[0m\n" ++ show b) xs+    where vars = showTypeList @ a+ type family GetV a :: [Symbol] where   GetV (a # b)       = Append (GetV a) (GetV b)   GetV (a :> b)      = Append (GetV a) (GetV b)@@ -1504,13 +1510,6 @@   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)

@@ -1,5 +1,5 @@ name:                 type-of-html-version:              1.6.0.0+version:              1.6.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@@ -26,7 +26,7 @@   exposed-modules:    Html                     , Html.Type                     , Html.Convert-                    , Html.Element.Obsolete+                    , Html.Obsolete   other-modules:      Html.Type.Internal                     , Html.Reify   hs-source-dirs:     src@@ -76,7 +76,7 @@   main-is:            Alloc.hs   other-modules:      Small                     , Medium-                    , Big+                    , ExampleTypeOfHtml   hs-source-dirs:     bench   ghc-options:        -Wall -O2   default-language:   Haskell2010@@ -92,8 +92,9 @@   main-is:            Perf.hs   other-modules:      Small                     , Medium-                    , Big                     , Blaze+                    , ExampleBlaze+                    , ExampleTypeOfHtml   hs-source-dirs:     bench   ghc-options:        -Wall -O2   default-language:   Haskell2010