Skip to content

Commit 55b360d

Browse files
LysxiaLysxia
committed
Update generic benchmark
1 parent 19e3efe commit 55b360d

File tree

2 files changed

+81
-28
lines changed

2 files changed

+81
-28
lines changed

‎benchmarks/AesonCompareAutoInstances.hs

Lines changed: 80 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,22 +1,30 @@
1-
{-# LANGUAGE DeriveDataTypeable #-}
21
{-# LANGUAGE DeriveGeneric #-}
2+
{-# LANGUAGE FlexibleContexts #-}
33
{-# LANGUAGE TemplateHaskell #-}
44

55
module Main (main) where
66

77
import Prelude ()
88
import Prelude.Compat
99

10+
import Control.Monad
1011
import Control.DeepSeq (NFData, rnf, deepseq)
1112
import Criterion.Main hiding (defaultOptions)
12-
import Data.Aeson.Encode
13+
import Data.Aeson
14+
import Data.Aeson.Encoding
1315
import Data.Aeson.TH
1416
import Data.Aeson.Types
17+
import Data.ByteString.Lazy (ByteString)
1518
import Data.Data (Data)
1619
import Data.Typeable (Typeable)
17-
import GHC.Generics (Generic)
20+
import GHC.Generics (Generic, Rep)
1821
import 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
2028

2129
--------------------------------------------------------------------------------
2230

@@ -27,7 +35,7 @@ data D a = Nullary
2735
, testTwo :: Bool
2836
, testThree :: D a
2937
}
30-
deriving (Show, Eq, Data, Typeable)
38+
deriving (Show, Eq)
3139

3240
deriveJSON opts ''D
3341

@@ -60,7 +68,7 @@ data D' a = Nullary'
6068
, testTwo' :: Bool
6169
, testThree' :: D' a
6270
}
63-
deriving (Show, Eq, Generic, Data, Typeable)
71+
deriving (Show, Eq, Generic)
6472

6573
instance ToJSON a => ToJSON (D' a) where
6674
toJSON = genericToJSON opts
@@ -96,7 +104,7 @@ data BigRecord = BigRecord
96104
, field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
97105
, field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
98106
, field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
99-
} deriving (Show, Eq, Generic, Data, Typeable)
107+
} deriving (Show, Eq, Generic)
100108

101109
instance NFData BigRecord
102110

@@ -106,15 +114,23 @@ bigRecord = BigRecord 1 2 3 4 5
106114
16 17 18 19 20
107115
21 22 23 24 25
108116

117+
return []
118+
109119
gBigRecordToJSON :: BigRecord -> Value
110120
gBigRecordToJSON = genericToJSON opts
111121

122+
gBigRecordEncode :: BigRecord -> ByteString
123+
gBigRecordEncode = gEncode
124+
112125
gBigRecordFromJSON :: Value -> Result BigRecord
113126
gBigRecordFromJSON = parse $ genericParseJSON opts
114127

115128
thBigRecordToJSON :: BigRecord -> Value
116129
thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
117130

131+
thBigRecordEncode :: BigRecord -> ByteString
132+
thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
133+
118134
thBigRecordFromJSON :: Value -> Result BigRecord
119135
thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
120136

@@ -126,7 +142,7 @@ data BigProduct = BigProduct
126142
!Int !Int !Int !Int !Int
127143
!Int !Int !Int !Int !Int
128144
!Int !Int !Int !Int !Int
129-
deriving (Show, Eq, Generic, Data, Typeable)
145+
deriving (Show, Eq, Generic)
130146

131147
instance NFData BigProduct
132148

@@ -136,15 +152,23 @@ bigProduct = BigProduct 1 2 3 4 5
136152
16 17 18 19 20
137153
21 22 23 24 25
138154

155+
return []
156+
139157
gBigProductToJSON :: BigProduct -> Value
140158
gBigProductToJSON = genericToJSON opts
141159

160+
gBigProductEncode :: BigProduct -> ByteString
161+
gBigProductEncode = gEncode
162+
142163
gBigProductFromJSON :: Value -> Result BigProduct
143164
gBigProductFromJSON = parse $ genericParseJSON opts
144165

145166
thBigProductToJSON :: BigProduct -> Value
146167
thBigProductToJSON = $(mkToJSON opts ''BigProduct)
147168

169+
thBigProductEncode :: BigProduct -> ByteString
170+
thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)
171+
148172
thBigProductFromJSON :: Value -> Result BigProduct
149173
thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
150174

@@ -155,75 +179,104 @@ data BigSum = F01 | F02 | F03 | F04 | F05
155179
| F11 | F12 | F13 | F14 | F15
156180
| F16 | F17 | F18 | F19 | F20
157181
| F21 | F22 | F23 | F24 | F25
158-
deriving (Show, Eq, Generic, Data, Typeable)
182+
deriving (Show, Eq, Generic)
159183

160184
instance NFData BigSum
161185

162186
bigSum = F25
163187

188+
return []
189+
164190
gBigSumToJSON :: BigSum -> Value
165191
gBigSumToJSON = genericToJSON opts
166192

193+
gBigSumEncode :: BigSum -> ByteString
194+
gBigSumEncode = gEncode
195+
167196
gBigSumFromJSON :: Value -> Result BigSum
168197
gBigSumFromJSON = parse $ genericParseJSON opts
169198

170199
thBigSumToJSON :: BigSum -> Value
171200
thBigSumToJSON = $(mkToJSON opts ''BigSum)
172201

202+
thBigSumEncode :: BigSum -> ByteString
203+
thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)
204+
173205
thBigSumFromJSON :: Value -> Result BigSum
174206
thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
175207

176208
--------------------------------------------------------------------------------
177209

178210
type FJ a = Value -> Result a
179211

180-
main :: IO ()
181-
main = defaultMain
212+
runBench :: IO ()
213+
runBench = defaultMain
182214
[ let v = toJSON d
183215
in (d, d', v) `deepseq`
184216
bgroup "D"
185217
[ group "toJSON" (nf toJSON d)
186-
(nf G.toJSON d)
187218
(nf toJSON d')
219+
, group "encode" (nf encode d)
220+
(nf encode d')
188221
, group "fromJSON" (nf ( fromJSON :: FJ T ) v)
189-
(nf (G.fromJSON :: FJ T ) v)
190222
(nf ( fromJSON :: FJ T') v)
191223
]
192224
, let v = thBigRecordToJSON bigRecord
193225
in bigRecord `deepseq` v `deepseq`
194226
bgroup "BigRecord"
195227
[ 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)
198231
, 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)
201233
]
202234
, let v = thBigProductToJSON bigProduct
203235
in bigProduct `deepseq` v `deepseq`
204236
bgroup "BigProduct"
205237
[ group "toJSON" (nf thBigProductToJSON bigProduct)
206-
(nf G.toJSON bigProduct)
207238
(nf gBigProductToJSON bigProduct)
239+
, group "encode" (nf thBigProductEncode bigProduct)
240+
(nf gBigProductEncode bigProduct)
208241
, group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
209-
(nf (G.fromJSON :: FJ BigProduct) v)
210242
(nf (gBigProductFromJSON :: FJ BigProduct) v)
211243
]
212244
, let v = thBigSumToJSON bigSum
213245
in bigSum `deepseq` v `deepseq`
214246
bgroup "BigSum"
215247
[ group "toJSON" (nf thBigSumToJSON bigSum)
216-
(nf G.toJSON bigSum)
217248
(nf gBigSumToJSON bigSum)
249+
, group "encode" (nf thBigSumEncode bigSum)
250+
(nf gBigSumEncode bigSum)
218251
, group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
219-
(nf (G.fromJSON :: FJ BigSum) v)
220252
(nf (gBigSumFromJSON :: FJ BigSum) v)
221253
]
222254
]
223255

224-
group n th syb gen = bcompare
225-
[ bgroup n [ bench "th" th
226-
, bench "syb" syb
227-
, bench "generic" gen
228-
]
229-
]
256+
group n th gen = bgroup n [ bench "th" th
257+
, bench "generic" gen
258+
]
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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
module Options () where
1+
module Options where
22

33
import Prelude ()
44
import Prelude.Compat

0 commit comments

Comments
 (0)