@@ -1,5 +1,5 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
21{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
33{-# LANGUAGE TemplateHaskell #-}
44
55module Main (main) where
@@ -7,16 +7,24 @@ module Main (main) where
77import Prelude ()
88import Prelude.Compat
99
10+import Control.Monad
1011import Control.DeepSeq (NFData, rnf, deepseq)
1112import Criterion.Main hiding (defaultOptions)
12−import Data.Aeson.Encode
13+import Data.Aeson
14+import Data.Aeson.Encoding
1315import Data.Aeson.TH
1416import Data.Aeson.Types
17+import Data.ByteString.Lazy (ByteString)
1518import Data.Data (Data)
1619import Data.Typeable (Typeable)
17−import GHC.Generics (Generic)
20+import GHC.Generics (Generic, Rep)
1821import 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
3240deriveJSON 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
6573instance 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
101109instance 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+
109119gBigRecordToJSON :: BigRecord -> Value
110120gBigRecordToJSON = genericToJSON opts
111121
122+gBigRecordEncode :: BigRecord -> ByteString
123+gBigRecordEncode = gEncode
124+
112125gBigRecordFromJSON :: Value -> Result BigRecord
113126gBigRecordFromJSON = parse $ genericParseJSON opts
114127
115128thBigRecordToJSON :: BigRecord -> Value
116129thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
117130
131+thBigRecordEncode :: BigRecord -> ByteString
132+thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
133+
118134thBigRecordFromJSON :: Value -> Result BigRecord
119135thBigRecordFromJSON = 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
131147instance 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+
139157gBigProductToJSON :: BigProduct -> Value
140158gBigProductToJSON = genericToJSON opts
141159
160+gBigProductEncode :: BigProduct -> ByteString
161+gBigProductEncode = gEncode
162+
142163gBigProductFromJSON :: Value -> Result BigProduct
143164gBigProductFromJSON = parse $ genericParseJSON opts
144165
145166thBigProductToJSON :: BigProduct -> Value
146167thBigProductToJSON = $(mkToJSON opts ''BigProduct)
147168
169+thBigProductEncode :: BigProduct -> ByteString
170+thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)
171+
148172thBigProductFromJSON :: Value -> Result BigProduct
149173thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
150174
@@ -155,21 +179,29 @@ 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
160184instance NFData BigSum
161185
162186bigSum = F25
163187
188+return []
189+
164190gBigSumToJSON :: BigSum -> Value
165191gBigSumToJSON = genericToJSON opts
166192
193+gBigSumEncode :: BigSum -> ByteString
194+gBigSumEncode = gEncode
195+
167196gBigSumFromJSON :: Value -> Result BigSum
168197gBigSumFromJSON = parse $ genericParseJSON opts
169198
170199thBigSumToJSON :: BigSum -> Value
171200thBigSumToJSON = $(mkToJSON opts ''BigSum)
172201
202+thBigSumEncode :: BigSum -> ByteString
203+thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)
204+
173205thBigSumFromJSON :: Value -> Result BigSum
174206thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
175207
@@ -177,53 +209,74 @@ thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
177209
178210type 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