From b32be57fe85fe8d9c2504279cee29aa0a9f96483 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Mon, 24 Feb 2014 19:02:04 +0200
Subject: [PATCH] Added widgets benchmark

---
 .../{widget-benchmark.hs => bench/widget.hs}  | 59 ++++++++-----------
 yesod-core/yesod-core.cabal                   | 14 +++++
 2 files changed, 38 insertions(+), 35 deletions(-)
 rename yesod-core/{widget-benchmark.hs => bench/widget.hs} (52%)

diff --git a/yesod-core/widget-benchmark.hs b/yesod-core/bench/widget.hs
similarity index 52%
rename from yesod-core/widget-benchmark.hs
rename to yesod-core/bench/widget.hs
index 9be4acd8..59b18922 100644
--- a/yesod-core/widget-benchmark.hs
+++ b/yesod-core/bench/widget.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE OverloadedStrings #-}
 -- | BigTable benchmark implemented using Hamlet.
 --
 {-# LANGUAGE QuasiQuotes #-}
@@ -7,19 +8,22 @@ import Criterion.Main
 import Text.Hamlet
 import Numeric (showInt)
 import qualified Data.ByteString.Lazy as L
-import qualified Text.Blaze.Renderer.Utf8 as Utf8
+import qualified Text.Blaze.Html.Renderer.Utf8 as Utf8
 import Data.Monoid (mconcat)
 import Text.Blaze.Html5 (table, tr, td)
-import Yesod.Widget
+import Text.Blaze.Html (toHtml)
+import Yesod.Core.Widget
 import Control.Monad.Trans.Writer
 import Control.Monad.Trans.RWS
 import Data.Functor.Identity
-import Yesod.Internal
+import Yesod.Core.Types
+import Data.Monoid
+import Data.IORef
 
 main = defaultMain
     [ bench "bigTable html" $ nf bigTableHtml bigTableData
     , bench "bigTable hamlet" $ nf bigTableHamlet bigTableData
-    , bench "bigTable widget" $ nf bigTableWidget bigTableData
+    , bench "bigTable widget" $ nfIO (bigTableWidget bigTableData)
     , bench "bigTable blaze" $ nf bigTableBlaze bigTableData
     ]
   where
@@ -30,50 +34,35 @@ main = defaultMain
     bigTableData = replicate rows [1..10]
     {-# NOINLINE bigTableData #-}
 
-bigTableHtml rows = L.length $ renderHtml [$hamlet|
-<table
+bigTableHtml rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet|
+<table>
     $forall row <- rows
-        <tr
+        <tr>
             $forall cell <- row
                 <td>#{show cell}
 |]
 
-bigTableHamlet rows = L.length $ renderHamlet id [$hamlet|
-<table
+bigTableHamlet rows = L.length $ Utf8.renderHtml $ ($ id) [hamlet|
+<table>
     $forall row <- rows
-        <tr
+        <tr>
             $forall cell <- row
                 <td>#{show cell}
 |]
 
-bigTableWidget rows = L.length $ renderHtml $ (run [$hamlet|
-<table
+bigTableWidget rows = fmap (L.length . Utf8.renderHtml . ($ render)) (run [whamlet|
+<table>
     $forall row <- rows
-        <tr
+        <tr>
             $forall cell <- row
                 <td>#{show cell}
-|]) (\_ _ -> "foo")
+|])
   where
-  run (GWidget w) =
-    let (_, _, GWData (Body x) _ _ _ _ _ _) = runRWS w () 0
-     in x
-  {-
-  run (GWidget w) = runIdentity $ do
-    w' <- flip evalStateT 0
-        $ runWriterT $ runWriterT $ runWriterT $ runWriterT
-        $ runWriterT $ runWriterT $ runWriterT w
-    let ((((((((),
-         Body body),
-         _),
-         _),
-         _),
-         _),
-         _),
-         _) = w'
+  render _ _ = "foo"
+  run (WidgetT w) = do
+    (_, GWData { gwdBody = Body x }) <- w undefined
+    return x
 
-    return body
-    -}
-
-bigTableBlaze t = L.length $ renderHtml $ table $ mconcat $ map row t
+bigTableBlaze t = L.length $ Utf8.renderHtml $ table $ mconcat $ map row t
   where
-    row r = tr $ mconcat $ map (td . string . show) r
+    row r = tr $ mconcat $ map (td . toHtml . show) r
diff --git a/yesod-core/yesod-core.cabal b/yesod-core/yesod-core.cabal
index 80467d19..557362d8 100644
--- a/yesod-core/yesod-core.cabal
+++ b/yesod-core/yesod-core.cabal
@@ -125,6 +125,20 @@ test-suite tests
     ghc-options:     -Wall
     extensions: TemplateHaskell
 
+benchmark widgets
+    type: exitcode-stdio-1.0
+    hs-source-dirs: bench
+    build-depends:  base
+                  , criterion
+                  , bytestring
+                  , text
+                  , hamlet
+                  , transformers
+                  , yesod-core
+                  , blaze-html
+    main-is:        widget.hs
+    ghc-options:    -Wall -O2
+
 source-repository head
   type:     git
   location: https://github.com/yesodweb/yesod