1{-# LANGUAGE OverloadedStrings #-}
2-- |
3-- Module      : BlazeVsBinary
4-- Copyright   : (c) 2010 Jasper Van der Jeught & Simon Meier
5-- License     : BSD3-style (see LICENSE)
6--
7-- Maintainer  : Leon P Smith <leon@melding-monads.com>
8-- Stability   : experimental
9-- Portability : tested on GHC only
10--
11-- A comparison between 'blaze-builder' and the Data.Binary.Builder from
12-- 'binary'. The goal is to measure the performance on serializing dynamic
13-- data referenced by a list.
14--
15-- Note that some of the benchmarks are a bit unfair with respect to
16-- blaze-builder, as it does more than 'binary':
17--
18--   1. It encodes chars as utf-8 strings and does not just truncate character
19--      value to one byte.
20--
21--   2. It copies the contents of the lazy bytestring chunks if they are
22--      shorter than 4kb. This ensures efficient processing of the resulting
23--      lazy bytestring. 'binary' just inserts the chunks directly in the
24--      resulting output stream.
25--
26module BlazeVsBinary where
27
28import Data.Char (ord)
29import Data.Monoid (mconcat)
30import Data.Word (Word8)
31
32import qualified Data.Binary.Builder as Binary
33import Criterion.Main
34import qualified Data.ByteString.Lazy as L
35import qualified Data.ByteString as S
36import Data.Text (Text)
37import Data.Text.Encoding (encodeUtf8)
38
39import qualified Blaze.ByteString.Builder           as Blaze
40import qualified Blaze.ByteString.Builder.Char.Utf8 as Blaze
41
42main :: IO ()
43main = defaultMain $ concat
44    [ benchmark "[String]"
45        (mconcat . map (mconcat . (map $ Binary.singleton .  fromIntegral . ord)))
46        (mconcat . map Blaze.fromString)
47        strings
48    , benchmark "L.ByteString"
49        (Binary.fromLazyByteString)
50        (Blaze.fromLazyByteString)
51        byteStrings
52    , benchmark "[Text]"
53        (mconcat . map (Binary.fromByteString . encodeUtf8))
54        (mconcat . map Blaze.fromText)
55        texts
56    , benchmark "[Word8]"
57        (mconcat . map Binary.singleton)
58        (Blaze.fromWord8s)
59        word8s
60    ]
61  where
62    benchmark name binaryF blazeF x =
63        [ bench (name ++ " (Data.Binary builder)") $
64            whnf (L.length . Binary.toLazyByteString . binaryF) x
65        , bench (name ++ " (blaze builder)") $
66            whnf (L.length . Blaze.toLazyByteString . blazeF) x
67        ]
68
69strings :: [String]
70strings = replicate 10000 "<img>"
71{-# NOINLINE strings #-}
72
73byteStrings :: L.ByteString
74byteStrings = L.fromChunks $ replicate 10000 "<img>"
75{-# NOINLINE byteStrings #-}
76
77texts :: [Text]
78texts = replicate 10000 "<img>"
79{-# NOINLINE texts #-}
80
81word8s :: [Word8]
82word8s = replicate 10000 $ fromIntegral $ ord 'a'
83{-# NOINLINE word8s #-}
84