Update benchmarks

- Remove warnings
- Update snap benchmarks to work with snap >= 0.3
- Separate benchmarks from criterion code

benchmarks/HtmlBenchmarks.hs

@@ -7,27 +7,12 @@ import Data.Monoid (Monoid, mempty, mconcat, mappend)
 import Prelude hiding (div, id)
 import qualified Prelude as P
 
-import Criterion.Main
-import Data.ByteString.Char8 (ByteString)
-import GHC.Exts (IsString, fromString)
-import qualified Data.Text.Lazy as LT
-import qualified Data.ByteString.Lazy as LB
-
 import Text.Blaze.Html5 hiding (map)
 import qualified Text.Blaze.Html5 as H
 import Text.Blaze.Html5.Attributes hiding (title, rows)
-import qualified Text.Blaze.Renderer.Utf8 as Utf8
-import qualified Text.Blaze.Renderer.String as String
-import qualified Text.Blaze.Renderer.Text as Text
-
-main = defaultMain $ concatMap benchHtml benchmarks
-  where
-    benchHtml (HtmlBenchmark name f x _) =
-        [ bench (name ++ " (Utf8)") $ nf (LB.length .  Utf8.renderHtml . f) x
-        , bench (name ++ " (String)") $ nf (String.renderHtml . f) x
-        , bench (name ++ " (Text)") $ nf (LT.length . Text.renderHtml . f) x
-        ]
 
+-- | Description of an HTML benchmark
+--
 data HtmlBenchmark = forall a. HtmlBenchmark
     String       -- ^ Name.
     (a -> Html)  -- ^ Rendering function.
@@ -68,7 +53,7 @@ basicData = ("Just a test", "joe", items)
 {-# NOINLINE basicData #-}
 
 items :: [String]
-items = map (("Number " `mappend`) . show) [1 .. 14]
+items = map (("Number " `mappend`) . show) [1 :: Int .. 14]
 {-# NOINLINE items #-}
 
 wideTreeData :: [String]
@@ -100,15 +85,15 @@ bigTable t = table $ mconcat $ map row t
 --
 basic :: (String, String, [String])  -- ^ (Title, User, Items)
       -> Html                        -- ^ Result.
-basic (title', user, items) = html $ do
+basic (title', user, items') = html $ do
     H.head $ title $ string title'
     body $ do
         div ! id "header" $ (h1 $ string title')
         p $ "Hello, " `mappend` string user `mappend` string "!"
         p $ "Hello, me!"
         p $ "Hello, world!"
         h2 $ "loop"
-        ol $ mconcat $ map (li . string) items
+        ol $ mconcat $ map (li . string) items'
         div ! id "footer" $ mempty
 
 -- | A benchmark producing a very wide but very shallow tree.
@@ -130,5 +115,5 @@ manyAttributes :: [String]  -- ^ List of attribute values.
                -> Html      -- ^ Result.
 manyAttributes = foldl setAttribute img
   where
-    setAttribute html value = html ! id (stringValue value)
+    setAttribute html' value' = html' ! id (stringValue value')
     {-# INLINE setAttribute #-}

benchmarks/RunHtmlBenchmarks.hs

@@ -0,0 +1,25 @@
+-- | This is a module which runs the 'HtmlBenchmarks' module using the different
+-- renderers available.
+--
+module RunHtmlBenchmarks where
+
+import Criterion.Main
+import qualified Data.Text.Lazy as LT
+import qualified Data.ByteString.Lazy as LB
+
+import qualified Text.Blaze.Renderer.Utf8 as Utf8
+import qualified Text.Blaze.Renderer.String as String
+import qualified Text.Blaze.Renderer.Text as Text
+
+import HtmlBenchmarks (HtmlBenchmark (..), benchmarks)
+
+-- | Function to run the benchmarks using criterion
+--
+main :: IO ()
+main = defaultMain $ concatMap benchHtml benchmarks
+  where
+    benchHtml (HtmlBenchmark name f x _) =
+        [ bench (name ++ " (Utf8)")   $ nf (LB.length .  Utf8.renderHtml . f) x
+        , bench (name ++ " (String)") $ nf (String.renderHtml . f) x
+        , bench (name ++ " (Text)")   $ nf (LT.length . Text.renderHtml . f) x
+        ]

doc/examples/SnapBenchmarkServer.lhs

@@ -6,7 +6,6 @@ Haskell web framework.
 > {-# LANGUAGE OverloadedStrings #-}
 > module SnapBenchmarkServer where
 
-> import System (getArgs)
 > import Data.Maybe (fromMaybe)
 > import Data.Char (toLower)
 > import Control.Applicative ((<$>))
@@ -19,9 +18,8 @@ Haskell web framework.
 We re-use most of the `BenchmarkServer`, and the `blazeTemplate` function from
 the simple `SnapFramework` example as well.
 
-> import Text.Blaze.Renderer.Utf8 (renderHtml)
 > import BenchmarkServer hiding (main)
-> import HtmlBenchmarks hiding (main)
+> import HtmlBenchmarks (HtmlBenchmark (..))
 > import SnapFramework (blazeTemplate)
 
 We now present "Handlers" for our templates: these are values of the type
@@ -63,9 +61,4 @@ the top, and then we can access the benchmarks by name.
 The main function is simply the same as in the `SnapFramework` example.
 
 > main :: IO ()
-> main = do
->     args <- getArgs
->     let port = case args of
->                    []  -> 8000
->                    p:_ -> read p
->     httpServe "*" port "myserver" (Just "access.log") (Just "error.log") site
+> main = httpServe defaultConfig site

doc/examples/SnapFramework.hs

@@ -4,8 +4,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module SnapFramework where
 
-import System (getArgs)
-
 import Snap.Http.Server
 import Snap.Types
 
@@ -38,12 +36,4 @@ site = blazeTemplate welcomePage
 -- | Snap main function.
 --
 main :: IO ()
-main = do
-    args <- getArgs
-    let port = case args of
-                   []  -> 8000
-                   p:_ -> read p
-    httpServe "*" port "myserver"
-        (Just "access.log")
-        (Just "error.log")
-        site
+main = httpServe defaultConfig site