on master help sign in
Update generic benchmark
55b360dlyxia
benchmarks/AesonCompareAutoInstances.hs+80−27
@@ -1,5 +1,5 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
4
4
5module Main (main) where
5module Main (main) where
@@ -7,16 +7,24 @@ module Main (main) where
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
9
9
10+import Control.Monad
10import Control.DeepSeq (NFData, rnf, deepseq)
11import Control.DeepSeq (NFData, rnf, deepseq)
11import Criterion.Main hiding (defaultOptions)
12import Criterion.Main hiding (defaultOptions)
12−import Data.Aeson.Encode
13+import Data.Aeson
14+import Data.Aeson.Encoding
13import Data.Aeson.TH
15import Data.Aeson.TH
14import Data.Aeson.Types
16import Data.Aeson.Types
17+import Data.ByteString.Lazy (ByteString)
15import Data.Data (Data)
18import Data.Data (Data)
16import Data.Typeable (Typeable)
19import Data.Typeable (Typeable)
17−import GHC.Generics (Generic)
20+import GHC.Generics (Generic, Rep)
18import Options
21import Options
19−import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
22+
23+toBS :: Encoding -> ByteString
24+toBS = encodingToLazyByteString
25+
26+gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString
27+gEncode = toBS . genericToEncoding opts
20
28
21--------------------------------------------------------------------------------
29--------------------------------------------------------------------------------
22
30
@@ -27,7 +35,7 @@ data D a = Nullary
27 , testTwo :: Bool
35 , testTwo :: Bool
28 , testThree :: D a
36 , testThree :: D a
29 }
37 }
30− deriving (Show, Eq, Data, Typeable)
38+ deriving (Show, Eq)
31
39
32deriveJSON opts ''D
40deriveJSON opts ''D
33
41
@@ -60,7 +68,7 @@ data D' a = Nullary'
60 , testTwo' :: Bool
68 , testTwo' :: Bool
61 , testThree' :: D' a
69 , testThree' :: D' a
62 }
70 }
63− deriving (Show, Eq, Generic, Data, Typeable)
71+ deriving (Show, Eq, Generic)
64
72
65instance ToJSON a => ToJSON (D' a) where
73instance ToJSON a => ToJSON (D' a) where
66 toJSON = genericToJSON opts
74 toJSON = genericToJSON opts
@@ -96,7 +104,7 @@ data BigRecord = BigRecord
96 , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
104 , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
97 , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
105 , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
98 , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
106 , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
99− } deriving (Show, Eq, Generic, Data, Typeable)
107+ } deriving (Show, Eq, Generic)
100
108
101instance NFData BigRecord
109instance NFData BigRecord
102
110
@@ -106,15 +114,23 @@ bigRecord = BigRecord 1 2 3 4 5
106 16 17 18 19 20
114 16 17 18 19 20
107 21 22 23 24 25
115 21 22 23 24 25
108
116
117+return []
118+
109gBigRecordToJSON :: BigRecord -> Value
119gBigRecordToJSON :: BigRecord -> Value
110gBigRecordToJSON = genericToJSON opts
120gBigRecordToJSON = genericToJSON opts
111
121
122+gBigRecordEncode :: BigRecord -> ByteString
123+gBigRecordEncode = gEncode
124+
112gBigRecordFromJSON :: Value -> Result BigRecord
125gBigRecordFromJSON :: Value -> Result BigRecord
113gBigRecordFromJSON = parse $ genericParseJSON opts
126gBigRecordFromJSON = parse $ genericParseJSON opts
114
127
115thBigRecordToJSON :: BigRecord -> Value
128thBigRecordToJSON :: BigRecord -> Value
116thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
129thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
117
130
131+thBigRecordEncode :: BigRecord -> ByteString
132+thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
133+
118thBigRecordFromJSON :: Value -> Result BigRecord
134thBigRecordFromJSON :: Value -> Result BigRecord
119thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
135thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
120
136
@@ -126,7 +142,7 @@ data BigProduct = BigProduct
126 !Int !Int !Int !Int !Int
142 !Int !Int !Int !Int !Int
127 !Int !Int !Int !Int !Int
143 !Int !Int !Int !Int !Int
128 !Int !Int !Int !Int !Int
144 !Int !Int !Int !Int !Int
129− deriving (Show, Eq, Generic, Data, Typeable)
145+ deriving (Show, Eq, Generic)
130
146
131instance NFData BigProduct
147instance NFData BigProduct
132
148
@@ -136,15 +152,23 @@ bigProduct = BigProduct 1 2 3 4 5
136 16 17 18 19 20
152 16 17 18 19 20
137 21 22 23 24 25
153 21 22 23 24 25
138
154
155+return []
156+
139gBigProductToJSON :: BigProduct -> Value
157gBigProductToJSON :: BigProduct -> Value
140gBigProductToJSON = genericToJSON opts
158gBigProductToJSON = genericToJSON opts
141
159
160+gBigProductEncode :: BigProduct -> ByteString
161+gBigProductEncode = gEncode
162+
142gBigProductFromJSON :: Value -> Result BigProduct
163gBigProductFromJSON :: Value -> Result BigProduct
143gBigProductFromJSON = parse $ genericParseJSON opts
164gBigProductFromJSON = parse $ genericParseJSON opts
144
165
145thBigProductToJSON :: BigProduct -> Value
166thBigProductToJSON :: BigProduct -> Value
146thBigProductToJSON = $(mkToJSON opts ''BigProduct)
167thBigProductToJSON = $(mkToJSON opts ''BigProduct)
147
168
169+thBigProductEncode :: BigProduct -> ByteString
170+thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)
171+
148thBigProductFromJSON :: Value -> Result BigProduct
172thBigProductFromJSON :: Value -> Result BigProduct
149thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
173thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
150
174
@@ -155,21 +179,29 @@ data BigSum = F01 | F02 | F03 | F04 | F05
155 | F11 | F12 | F13 | F14 | F15
179 | F11 | F12 | F13 | F14 | F15
156 | F16 | F17 | F18 | F19 | F20
180 | F16 | F17 | F18 | F19 | F20
157 | F21 | F22 | F23 | F24 | F25
181 | F21 | F22 | F23 | F24 | F25
158− deriving (Show, Eq, Generic, Data, Typeable)
182+ deriving (Show, Eq, Generic)
159
183
160instance NFData BigSum
184instance NFData BigSum
161
185
162bigSum = F25
186bigSum = F25
163
187
188+return []
189+
164gBigSumToJSON :: BigSum -> Value
190gBigSumToJSON :: BigSum -> Value
165gBigSumToJSON = genericToJSON opts
191gBigSumToJSON = genericToJSON opts
166
192
193+gBigSumEncode :: BigSum -> ByteString
194+gBigSumEncode = gEncode
195+
167gBigSumFromJSON :: Value -> Result BigSum
196gBigSumFromJSON :: Value -> Result BigSum
168gBigSumFromJSON = parse $ genericParseJSON opts
197gBigSumFromJSON = parse $ genericParseJSON opts
169
198
170thBigSumToJSON :: BigSum -> Value
199thBigSumToJSON :: BigSum -> Value
171thBigSumToJSON = $(mkToJSON opts ''BigSum)
200thBigSumToJSON = $(mkToJSON opts ''BigSum)
172
201
202+thBigSumEncode :: BigSum -> ByteString
203+thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)
204+
173thBigSumFromJSON :: Value -> Result BigSum
205thBigSumFromJSON :: Value -> Result BigSum
174thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
206thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
175
207
@@ -177,53 +209,74 @@ thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
177
209
178type FJ a = Value -> Result a
210type FJ a = Value -> Result a
179
211
180−main :: IO ()
212+runBench :: IO ()
181−main = defaultMain
213+runBench = defaultMain
182 [ let v = toJSON d
214 [ let v = toJSON d
183 in (d, d', v) `deepseq`
215 in (d, d', v) `deepseq`
184 bgroup "D"
216 bgroup "D"
185 [ group "toJSON" (nf toJSON d)
217 [ group "toJSON" (nf toJSON d)
186− (nf G.toJSON d)
187 (nf toJSON d')
218 (nf toJSON d')
219+ , group "encode" (nf encode d)
220+ (nf encode d')
188 , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
221 , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
189− (nf (G.fromJSON :: FJ T ) v)
190 (nf ( fromJSON :: FJ T') v)
222 (nf ( fromJSON :: FJ T') v)
191 ]
223 ]
192 , let v = thBigRecordToJSON bigRecord
224 , let v = thBigRecordToJSON bigRecord
193 in bigRecord `deepseq` v `deepseq`
225 in bigRecord `deepseq` v `deepseq`
194 bgroup "BigRecord"
226 bgroup "BigRecord"
195 [ group "toJSON" (nf thBigRecordToJSON bigRecord)
227 [ group "toJSON" (nf thBigRecordToJSON bigRecord)
196− (nf G.toJSON bigRecord)
197− (nf gBigRecordToJSON bigRecord)
228+ (nf gBigRecordToJSON bigRecord)
229+ , group "encode" (nf thBigRecordEncode bigRecord)
230+ (nf gBigRecordEncode bigRecord)
198 , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
231 , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
199− (nf (G.fromJSON :: FJ BigRecord) v)
200− (nf (gBigRecordFromJSON :: FJ BigRecord) v)
232+ (nf ( gBigRecordFromJSON :: FJ BigRecord) v)
201 ]
233 ]
202 , let v = thBigProductToJSON bigProduct
234 , let v = thBigProductToJSON bigProduct
203 in bigProduct `deepseq` v `deepseq`
235 in bigProduct `deepseq` v `deepseq`
204 bgroup "BigProduct"
236 bgroup "BigProduct"
205 [ group "toJSON" (nf thBigProductToJSON bigProduct)
237 [ group "toJSON" (nf thBigProductToJSON bigProduct)
206− (nf G.toJSON bigProduct)
207 (nf gBigProductToJSON bigProduct)
238 (nf gBigProductToJSON bigProduct)
239+ , group "encode" (nf thBigProductEncode bigProduct)
240+ (nf gBigProductEncode bigProduct)
208 , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
241 , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
209− (nf (G.fromJSON :: FJ BigProduct) v)
210 (nf (gBigProductFromJSON :: FJ BigProduct) v)
242 (nf (gBigProductFromJSON :: FJ BigProduct) v)
211 ]
243 ]
212 , let v = thBigSumToJSON bigSum
244 , let v = thBigSumToJSON bigSum
213 in bigSum `deepseq` v `deepseq`
245 in bigSum `deepseq` v `deepseq`
214 bgroup "BigSum"
246 bgroup "BigSum"
215 [ group "toJSON" (nf thBigSumToJSON bigSum)
247 [ group "toJSON" (nf thBigSumToJSON bigSum)
216− (nf G.toJSON bigSum)
217 (nf gBigSumToJSON bigSum)
248 (nf gBigSumToJSON bigSum)
249+ , group "encode" (nf thBigSumEncode bigSum)
250+ (nf gBigSumEncode bigSum)
218 , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
251 , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
219− (nf (G.fromJSON :: FJ BigSum) v)
220 (nf (gBigSumFromJSON :: FJ BigSum) v)
252 (nf (gBigSumFromJSON :: FJ BigSum) v)
221 ]
253 ]
222 ]
254 ]
223
255
224−group n th syb gen = bcompare
225− [ bgroup n [ bench "th" th
256+group n th gen = bgroup n [ bench "th" th
226− , bench "syb" syb
227− , bench "generic" gen
257+ , bench "generic" gen
228− ]
258+ ]
229− ]
259+
260+sanityCheck = do
261+ check d toJSON fromJSON encode
262+ check d' toJSON fromJSON encode
263+ check bigRecord thBigRecordToJSON thBigRecordFromJSON thBigRecordEncode
264+ check bigRecord gBigRecordToJSON gBigRecordFromJSON gBigRecordEncode
265+ check bigProduct thBigProductToJSON thBigProductFromJSON thBigProductEncode
266+ check bigProduct gBigProductToJSON gBigProductFromJSON gBigProductEncode
267+ check bigSum thBigSumToJSON thBigSumFromJSON thBigSumEncode
268+ check bigSum gBigSumToJSON gBigSumFromJSON gBigSumEncode
269+
270+check :: (Show a, Eq a)
271+ => a -> (a -> Value) -> (Value -> Result a) -> (a -> ByteString) -> IO ()
272+check x toJSON fromJSON encode = do
273+ unless (Success x == (fromJSON . toJSON) x) $ fail $ "toJSON: " ++ show x
274+ unless (Success x == (decode' . encode) x) $ fail $ "encode: " ++ show x
275+ where
276+ decode' s = case decode s of
277+ Just v -> fromJSON v
278+ Nothing -> fail ""
279+
280+main = do
281+ sanityCheck
282+ runBench
benchmarks/Options.hs+1−1
@@ -1,4 +1,4 @@
1−module Options () where
1+module Options where
2
2
3import Prelude ()
3import Prelude ()
4import Prelude.Compat
4import Prelude.Compat