c713a0ed98f95d39eea993f386a6870b0185cb80
[packages/binary.git] / benchmarks / Put.hs
1 {-# LANGUAGE CPP, ExistentialQuantification #-}
2 #ifdef GENERICS
3 {-# LANGUAGE DeriveGeneric #-}
4 #endif
5
6 module Main (main) where
7
8 import Control.DeepSeq
9 import Control.Exception (evaluate)
10 import Criterion.Main
11 import qualified Data.ByteString as S
12 import qualified Data.ByteString.Char8 as C
13 import qualified Data.ByteString.Lazy as L
14
15 #ifdef GENERICS
16 import GHC.Generics
17 #endif
18
19 import Data.Binary
20 import Data.Binary.Put
21 import Data.ByteString.Builder as BB
22
23 main :: IO ()
24 main = do
25 evaluate $ rnf
26 [ rnf bigIntegers
27 , rnf smallIntegers
28 , rnf smallByteStrings
29 , rnf smallStrings
30 , rnf word8s
31 ]
32 defaultMain
33 [
34 bench "small Integers" $ whnf (run . fromIntegers) smallIntegers,
35 bench "big Integers" $ whnf (run . fromIntegers) bigIntegers,
36
37 bench "[small Integer]" $ whnf (run . put) smallIntegers,
38 bench "[big Integer]" $ whnf (run . put) bigIntegers,
39
40 bench "small ByteStrings" $ whnf (run . fromByteStrings) smallByteStrings,
41 bench "[small ByteString]" $ whnf (run . put) smallByteStrings,
42
43 bench "small Strings" $ whnf (run . fromStrings) smallStrings,
44 bench "[small String]" $ whnf (run . put) smallStrings,
45
46 bench "Word8s" $ whnf (run . fromWord8s) word8s,
47 bench "Word8s builder" $ whnf (L.length . toLazyByteString . fromWord8sBuilder) word8s,
48 bench "[Word8]" $ whnf (run . put) word8s,
49 bench "Word16s" $ whnf (run . fromWord16s) word16s,
50 bench "Word16s builder" $ whnf (L.length . toLazyByteString . fromWord16sBuilder) word16s,
51 bench "[Word16]" $ whnf (run . put) word16s,
52 bench "Word32s" $ whnf (run . fromWord32s) word32s,
53 bench "Word32s builder" $ whnf (L.length . toLazyByteString . fromWord32sBuilder) word32s,
54 bench "[Word32]" $ whnf (run . put) word32s,
55 bench "Word64s" $ whnf (run . fromWord64s) word64s,
56 bench "Word64s builder" $ whnf (L.length . toLazyByteString . fromWord64sBuilder) word64s,
57 bench "[Word64]" $ whnf (run . put) word64s
58
59 #ifdef GENERICS
60 , bgroup "Generics" [
61 bench "Struct monoid put" $ whnf (run . fromStructs) structs,
62 bench "Struct put as list" $ whnf (run . put) structs,
63 bench "StructList monoid put" $ whnf (run . fromStructLists) structLists,
64 bench "StructList put as list" $ whnf (run . put) structLists
65 ]
66 #endif
67 ]
68 where
69 run = L.length . runPut
70
71 #ifdef GENERICS
72 data Struct = Struct Word8 Word16 Word32 Word64 deriving Generic
73 instance Binary Struct
74
75 data StructList = StructList [Struct] deriving Generic
76 instance Binary StructList
77
78 structs :: [Struct]
79 structs = take 10000 $ [ Struct a b 0 0 | a <- [0 .. maxBound], b <- [0 .. maxBound] ]
80
81 structLists :: [StructList]
82 structLists = replicate 1000 (StructList (take 10 structs))
83 #endif
84
85 -- Input data
86
87 smallIntegers :: [Integer]
88 smallIntegers = [0..10000]
89 {-# NOINLINE smallIntegers #-}
90
91 bigIntegers :: [Integer]
92 bigIntegers = [max .. max + 10000]
93 where
94 max :: Integer
95 max = fromIntegral (maxBound :: Word64)
96 {-# NOINLINE bigIntegers #-}
97
98 smallByteStrings :: [S.ByteString]
99 smallByteStrings = replicate 10000 $ C.pack "abcdefghi"
100 {-# NOINLINE smallByteStrings #-}
101
102 smallStrings :: [String]
103 smallStrings = replicate 10000 "abcdefghi"
104 {-# NOINLINE smallStrings #-}
105
106 word8s :: [Word8]
107 word8s = take 10000 $ cycle [minBound .. maxBound]
108 {-# NOINLINE word8s #-}
109
110 word16s :: [Word16]
111 word16s = take 10000 $ cycle [minBound .. maxBound]
112 {-# NOINLINE word16s #-}
113
114 word32s :: [Word32]
115 word32s = take 10000 $ cycle [minBound .. maxBound]
116 {-# NOINLINE word32s #-}
117
118 word64s :: [Word64]
119 word64s = take 10000 $ cycle [minBound .. maxBound]
120 {-# NOINLINE word64s #-}
121
122 ------------------------------------------------------------------------
123 -- Benchmarks
124
125 fromIntegers :: [Integer] -> Put
126 fromIntegers [] = return ()
127 fromIntegers (x:xs) = put x >> fromIntegers xs
128
129 fromByteStrings :: [S.ByteString] -> Put
130 fromByteStrings [] = return ()
131 fromByteStrings (x:xs) = put x >> fromByteStrings xs
132
133 fromStrings :: [String] -> Put
134 fromStrings [] = return ()
135 fromStrings (x:xs) = put x >> fromStrings xs
136
137 fromWord8s :: [Word8] -> Put
138 fromWord8s [] = return ()
139 fromWord8s (x:xs) = put x >> fromWord8s xs
140
141 fromWord8sBuilder :: [Word8] -> BB.Builder
142 fromWord8sBuilder [] = mempty
143 fromWord8sBuilder (x:xs) = BB.word8 x `mappend` fromWord8sBuilder xs
144
145 fromWord16s :: [Word16] -> Put
146 fromWord16s [] = return ()
147 fromWord16s (x:xs) = put x >> fromWord16s xs
148
149 fromWord16sBuilder :: [Word16] -> BB.Builder
150 fromWord16sBuilder [] = mempty
151 fromWord16sBuilder (x:xs) = BB.word16BE x `mappend` fromWord16sBuilder xs
152
153 fromWord32s :: [Word32] -> Put
154 fromWord32s [] = return ()
155 fromWord32s (x:xs) = put x >> fromWord32s xs
156
157 fromWord32sBuilder :: [Word32] -> BB.Builder
158 fromWord32sBuilder [] = mempty
159 fromWord32sBuilder (x:xs) = BB.word32BE x `mappend` fromWord32sBuilder xs
160
161 fromWord64s :: [Word64] -> Put
162 fromWord64s [] = return ()
163 fromWord64s (x:xs) = put x >> fromWord64s xs
164
165 fromWord64sBuilder :: [Word64] -> BB.Builder
166 fromWord64sBuilder [] = mempty
167 fromWord64sBuilder (x:xs) = BB.word64BE x `mappend` fromWord64sBuilder xs
168
169 #ifdef GENERICS
170 fromStructs :: [Struct] -> Put
171 fromStructs [] = return ()
172 fromStructs (x:xs) = put x >> fromStructs xs
173
174 fromStructLists :: [StructList] -> Put
175 fromStructLists [] = return ()
176 fromStructLists (x:xs) = put x >> fromStructLists xs
177 #endif