@@ -1,5 +1,5 @@
1−{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
2+{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
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
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
26+gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString
27+gEncode = toBS . genericToEncoding opts
21--------------------------------------------------------------------------------
29--------------------------------------------------------------------------------
@@ -27,7 +35,7 @@ data D a = Nullary
27 , testTwo :: Bool
35 , testTwo :: Bool
28 , testThree :: D a
36 , testThree :: D a
30− deriving (Show, Eq, Data, Typeable)
38+ deriving (Show, Eq)
32deriveJSON opts ''D
40deriveJSON opts ''D
@@ -60,7 +68,7 @@ data D' a = Nullary'
60 , testTwo' :: Bool
68 , testTwo' :: Bool
61 , testThree' :: D' a
69 , testThree' :: D' a
63− deriving (Show, Eq, Generic, Data, Typeable)
71+ deriving (Show, Eq, Generic)
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)
101instance NFData BigRecord
109instance NFData BigRecord
@@ -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
109gBigRecordToJSON :: BigRecord -> Value
119gBigRecordToJSON :: BigRecord -> Value
110gBigRecordToJSON = genericToJSON opts
120gBigRecordToJSON = genericToJSON opts
122+gBigRecordEncode :: BigRecord -> ByteString
123+gBigRecordEncode = gEncode
112gBigRecordFromJSON :: Value -> Result BigRecord
125gBigRecordFromJSON :: Value -> Result BigRecord
113gBigRecordFromJSON = parse $ genericParseJSON opts
126gBigRecordFromJSON = parse $ genericParseJSON opts
115thBigRecordToJSON :: BigRecord -> Value
128thBigRecordToJSON :: BigRecord -> Value
116thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
129thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
131+thBigRecordEncode :: BigRecord -> ByteString
132+thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
118thBigRecordFromJSON :: Value -> Result BigRecord
134thBigRecordFromJSON :: Value -> Result BigRecord
119thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
135thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
@@ -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)
131instance NFData BigProduct
147instance NFData BigProduct
@@ -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
139gBigProductToJSON :: BigProduct -> Value
157gBigProductToJSON :: BigProduct -> Value
140gBigProductToJSON = genericToJSON opts
158gBigProductToJSON = genericToJSON opts
160+gBigProductEncode :: BigProduct -> ByteString
161+gBigProductEncode = gEncode
142gBigProductFromJSON :: Value -> Result BigProduct
163gBigProductFromJSON :: Value -> Result BigProduct
143gBigProductFromJSON = parse $ genericParseJSON opts
164gBigProductFromJSON = parse $ genericParseJSON opts
145thBigProductToJSON :: BigProduct -> Value
166thBigProductToJSON :: BigProduct -> Value
146thBigProductToJSON = $(mkToJSON opts ''BigProduct)
167thBigProductToJSON = $(mkToJSON opts ''BigProduct)
169+thBigProductEncode :: BigProduct -> ByteString
170+thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)
148thBigProductFromJSON :: Value -> Result BigProduct
172thBigProductFromJSON :: Value -> Result BigProduct
149thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
173thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
@@ -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)
160instance NFData BigSum
184instance NFData BigSum
162bigSum = F25
186bigSum = F25
164gBigSumToJSON :: BigSum -> Value
190gBigSumToJSON :: BigSum -> Value
165gBigSumToJSON = genericToJSON opts
191gBigSumToJSON = genericToJSON opts
193+gBigSumEncode :: BigSum -> ByteString
194+gBigSumEncode = gEncode
167gBigSumFromJSON :: Value -> Result BigSum
196gBigSumFromJSON :: Value -> Result BigSum
168gBigSumFromJSON = parse $ genericParseJSON opts
197gBigSumFromJSON = parse $ genericParseJSON opts
170thBigSumToJSON :: BigSum -> Value
199thBigSumToJSON :: BigSum -> Value
171thBigSumToJSON = $(mkToJSON opts ''BigSum)
200thBigSumToJSON = $(mkToJSON opts ''BigSum)
202+thBigSumEncode :: BigSum -> ByteString
203+thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)
173thBigSumFromJSON :: Value -> Result BigSum
205thBigSumFromJSON :: Value -> Result BigSum
174thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
206thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
@@ -177,53 +209,74 @@ thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
178type FJ a = Value -> Result a
210type FJ a = Value -> Result a
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)
187 (nf toJSON d')
218 (nf toJSON d')
219+ , group "encode" (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)
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)
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)
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)
224−group n th syb gen = bcompare
225− [ bgroup n [ bench "th" th
256+group n th gen = bgroup n [ bench "th" th
227− , bench "generic" gen
257+ , bench "generic" gen
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
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
276+ decode' s = case decode s of
277+ Just v -> fromJSON v