1{-# language DeriveAnyClass, DeriveGeneric, OverloadedStrings #-}
2module Main where
3
4import Gauge
5
6import qualified Blaze.ByteString.Builder.HTTP as Blaze
7import Data.ByteString.Builder.HTTP.Chunked
8
9import Control.DeepSeq
10import qualified Data.ByteString as S
11import qualified Data.ByteString.Builder as B
12import qualified Data.ByteString.Builder.Extra as B
13import qualified Data.ByteString.Lazy as L
14import Data.Semigroup
15import GHC.Generics
16
17main :: IO ()
18main = defaultMain
19  [ benchEncode "clone village"
20                cloneVillage
21                (foldMap fromPerson)
22  , benchEncode "100 4kB chunks"
23                (S.replicate 4096 95)
24                (stimes (100 :: Int) . B.byteString)
25  , benchEncode "200kB strict bytestring"
26                (S.replicate (200 * 1000) 95)
27                B.byteString
28  , benchEncode "1000 small chunks"
29                "Hello"
30                (stimes (1000 :: Int) . B.byteString)
31  , benchEncode "1000 small chunks nocopy"
32                "Hello"
33                (stimes (1000 :: Int) . B.byteStringInsert)
34  ]
35
36-- Example adapted from
37-- http://lambda-view.blogspot.de/2010/11/blaze-builder-library-faster.html
38
39data Person = Person { pName :: String, pAge :: Int }
40  deriving (Generic, NFData)
41
42people :: [Person]
43people = zipWith Person ["Haskell 98", "Switzerland", "λ-bot"] [12, 719, 7]
44
45fromStringLen32le :: String -> B.Builder
46fromStringLen32le cs =
47  B.int32LE (fromIntegral $ length cs) <> B.stringUtf8 cs
48
49fromPerson :: Person -> B.Builder
50fromPerson p =
51  fromStringLen32le (pName p) <> B.int32LE (fromIntegral $ pAge p)
52
53cloneVillage :: [Person]
54cloneVillage = take 10000 $ cycle $ people
55
56-- Utils
57
58benchEncode :: NFData input => String -> input -> (input -> B.Builder) -> Benchmark
59benchEncode name input mkBuilder =
60  env (return input) $ \input' -> bgroup name
61    [ bench "bsbhc" $ nf (encode . mkBuilder) input'
62    , bench "Blaze" $ nf (encodeBlaze . mkBuilder) input'
63    ]
64
65encode :: B.Builder -> L.ByteString
66encode = B.toLazyByteString . chunkedTransferEncoding
67
68encodeBlaze :: B.Builder -> L.ByteString
69encodeBlaze = B.toLazyByteString . Blaze.chunkedTransferEncoding
70