Add benchmark vs blaze-html

snapframework · May 26, 2012 · 9178514 · 9178514
1 parent 17bbd9c
commit 9178514
Show file tree

Hide file tree

Showing 4 changed files with 351 additions and 5 deletions.
diff --git a/src/Text/XmlHtml/HTML/Render.hs b/src/Text/XmlHtml/HTML/Render.hs
@@ -233,10 +233,16 @@ ambiguousAmpersand _ = False
 -- | Function for rendering HTML nodes without the overhead of creating a
 -- Document structure.
 renderHtmlFragment :: Encoding -> [Node] -> Builder
-renderHtmlFragment _ []     = mempty
+renderHtmlFragment e =
-renderHtmlFragment e (n:ns) =
+    case e of
-    firstNode e n `mappend` (mconcat $ map (node e) ns)
+      UTF8 -> goUtf8
+      _    -> goUtf16
 
+  where
+    goUtf8 = foldr (mappend . utf8Node) mempty
+
+    goUtf16 = foldr (mappend . utf16Node e) mempty
+{-# INLINE renderHtmlFragment #-}
 
 ------------------------------------------------------------------------------
 -- | HTML allows & so long as it is not "ambiguous" (i.e., looks like an

diff --git a/test/benchmark/Benchmark.hs b/test/benchmark/Benchmark.hs
@@ -9,9 +9,15 @@ import           Criterion.Main
 ------------------------------------------------------------------------------
 import           Blaze.ByteString.Builder
 import qualified Data.ByteString as B
+import qualified Data.ByteString.Lazy as L
+import           Data.List
 import           Data.Text (Text)
 import qualified Data.Text as T
 import           Text.XmlHtml
+import           Text.Blaze.Html.Renderer.Utf8
+import           Text.Blaze.Html (Html)
+------------------------------------------------------------------------------
+import           BlazeExample
 
 ------------------------------------------------------------------------------
 main :: IO ()
@@ -21,6 +27,7 @@ main = do
 
     defaultMain [
          bench "renderHtml" $ renderHtmlBenchmark exampleHTML
+       , bench "renderBlaze" $ renderBlazeBenchmark blazeHtmlExample
        ]
 
 
@@ -34,3 +41,10 @@ parseExample = do
 ------------------------------------------------------------------------------
 renderHtmlBenchmark :: Document -> Pure
 renderHtmlBenchmark = whnf (toByteString . render)
+
+
+------------------------------------------------------------------------------
+renderBlazeBenchmark :: Html -> Pure
+renderBlazeBenchmark = whnf (touch . renderHtml)
+  where
+    touch l = foldl' seq "" (L.toChunks l) `seq` ()