lucid 2.9.5 → 2.9.6
raw patch · 5 files changed
+158/−2 lines, 5 files
Files
- CHANGELOG.md +6/−0
- README.md +1/−1
- benchmarks/HtmlBenchmarks.hs +135/−0
- lucid.cabal +2/−1
- src/Lucid/Base.hs +14/−0
CHANGELOG.md view
@@ -1,3 +1,9 @@+## 2.9.6++* Fix compilation of benchmarks+* Add @athanclark's version of relaxHtmlT+* Add a utility to generalize the underlying monad from Identity+ ## 2.9.5 * Add ToHtml instance for ByteString (both)
README.md view
@@ -1,4 +1,4 @@-lucid [](https://hackage.haskell.org/package/lucid)+lucid [](https://hackage.haskell.org/package/lucid) [](https://travis-ci.org/chrisdone/lucid) ===== Clear to write, read and edit DSL for writing HTML
+ benchmarks/HtmlBenchmarks.hs view
@@ -0,0 +1,135 @@+-- | This is a collection of HTML benchmarks for BlazeMarkup.++--+{-# LANGUAGE ExtendedDefaultRules #-}+{-# LANGUAGE OverloadedStrings, ExistentialQuantification #-}+{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}+module HtmlBenchmarks where++import Data.Monoid (Monoid,mappend,mempty)+import qualified Data.Text as T+-- import qualified Data.Text.Lazy.Builder as B++import qualified Prelude as P+import Prelude hiding (div, id)+import Data.String++-- import BenchmarkUtils+import Lucid+import Lucid.Base+-- import qualified BenchmarkUtils as H++-- | Description of an HTML benchmark+--+data HtmlBenchmark = forall a. HtmlBenchmark+ String -- ^ Name.+ (a -> Html ()) -- ^ Rendering function.+ a -- ^ Data.+ (Html ()) -- ^ Longer description.++-- | List containing all benchmarks.+--+benchmarks :: [HtmlBenchmark]+benchmarks =+ [ HtmlBenchmark "bigTable" bigTable bigTableData $+ let h = toHtml $ show $ length bigTableData+ w = toHtml $ show $ length $ P.head bigTableData+ in "Rendering of a big (" >> h >> "x" >> w >> ") HTML table"+ , HtmlBenchmark "basic" basic basicData+ "A simple, small basic template with a few holes to fill in"+ , HtmlBenchmark "wideTree" wideTree wideTreeData $+ "A very wide tree (" >> toHtml (show (length wideTreeData)) >> " elements)"+ , HtmlBenchmark "wideTreeEscaping" wideTree wideTreeEscapingData $ do+ "A very wide tree (" >> toHtml (show (length wideTreeData)) >> " elements)"+ " with lots of escaping"+ , HtmlBenchmark "deepTree" deepTree deepTreeData $ do+ "A really deep tree (" >> toHtml (show deepTreeData) >> " nested templates)"+ , HtmlBenchmark "manyAttributes" manyAttributes manyAttributesData $ do+ "A single element with " >> toHtml (show (length manyAttributesData))+ " attributes."+ , HtmlBenchmark "customAttribute" customAttributes customAttributesData $+ "Creating custom attributes"+ ]++rows :: Int+rows = 1000++bigTableData :: [[Int]]+bigTableData = replicate rows [1..10]+{-# NOINLINE bigTableData #-}++basicData :: (String, String, [String])+basicData = ("Just a test", "joe", items)+{-# NOINLINE basicData #-}++items :: [String]+items = map (("Number " `mappend`) . show) [1 :: Int .. 14]+{-# NOINLINE items #-}++wideTreeData :: [String]+wideTreeData = take 5000 $+ cycle ["λf.(λx.fxx)(λx.fxx)", "These old days", "Foobar", "lol", "x ∈ A"]+{-# NOINLINE wideTreeData #-}++wideTreeEscapingData :: [String]+wideTreeEscapingData = take 1000 $+ cycle ["<><>", "\"lol\"", "<&>", "'>>'"]+{-# NOINLINE wideTreeEscapingData #-}++deepTreeData :: Int+deepTreeData = 1000+{-# NOINLINE deepTreeData #-}++manyAttributesData :: [String]+manyAttributesData = wideTreeData++customAttributesData :: [(String, String)]+customAttributesData = zip wideTreeData wideTreeData++-- | Render the argument matrix as an HTML table.+--+bigTable :: [[Int]] -- ^ Matrix.+ -> Html () -- ^ Result.+bigTable t = table_ (mapM_ row t)++row :: [Int] -> Html ()+row r = tr_ (mapM_ (td_ . toHtml . show) r)++-- | Render a simple HTML page with some data.+--+basic :: (String, String, [String]) -- ^ (Title, User, Items)+ -> Html () -- ^ Result.+basic (title', user, items') = html_ $ do+ head_ $ title_ $ toHtml title'+ body_ $ do+ with div_ [id_ "header"] $ (h1_ $ toHtml title')+ p_ $ do "Hello, "; toHtml user; "!"+ p_ $ "Hello, me!"+ p_ $ "Hello, world!"+ h2_ $ "loop"+ ol_ $ mapM_ (li_ . toHtml) items'+ with div_ [id_ "footer"] mempty++-- | A benchmark producing a very wide but very shallow tree.+--+wideTree :: [String] -- ^ Text to create a tree from.+ -> Html () -- ^ Result.+wideTree = div_ . mapM_ ((with p_ [id_ "foo"]) . toHtml)++-- | Create a very deep tree.+--+deepTree :: Int -- ^ Depth of the tree.+ -> Html () -- ^ Result.+deepTree 0 = "foo"+deepTree n = p_ $ table_ $ tr_ $ td_ $ div_ $ deepTree (n - 1)++-- | Create an element with many attributes.+--+manyAttributes :: [String] -- ^ List of attribute values.+ -> Html () -- ^ Result.+manyAttributes as = img_ (map (id_ . T.pack) as)++customAttributes :: [(String, String)] -- ^ List of attribute name, value pairs+ -> Html () -- ^ Result+customAttributes xs =+ img_ (map (\(key,val) -> makeAttribute (fromString key) (T.pack val)) xs)
lucid.cabal view
@@ -1,5 +1,5 @@ name: lucid-version: 2.9.5+version: 2.9.6 synopsis: Clear to write, read and edit DSL for HTML description: Clear to write, read and edit DSL for HTML. See the 'Lucid' module for description and documentation.@@ -51,6 +51,7 @@ type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Main.hs+ other-modules: HtmlBenchmarks build-depends: base, deepseq, criterion,
src/Lucid/Base.hs view
@@ -18,6 +18,7 @@ ,execHtmlT ,evalHtmlT ,runHtmlT+ ,relaxHtmlT -- * Combinators ,makeElement ,makeElementNoEnd@@ -343,6 +344,19 @@ execHtmlT m = do (f,_) <- runHtmlT m return (f mempty)++-- | Generalize the underlying monad.+--+-- Some builders are happy to deliver results in a pure underlying+-- monad, here 'Identity', but have trouble maintaining the polymorphic+-- type. This utility generalizes from 'Identity'.+relaxHtmlT :: Monad m+ => HtmlT Identity a -- ^ The HTML generated purely.+ -> HtmlT m a -- ^ Same HTML accessible in a polymorphic context.+relaxHtmlT = hoist go+ where+ go :: Monad m => Identity a -> m a+ go = return . runIdentity -- | Evaluate the HTML to its return value. Analogous to @evalState@. --