@@ -1,282 +0,0 @@
1−{-# LANGUAGE DeriveGeneric #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE TemplateHaskell #-}
4−
5−module Main (main) where
6−
7−import Prelude ()
8−import Prelude.Compat
9−
10−import Control.Monad
11−import Control.DeepSeq (NFData, rnf, deepseq)
12−import Criterion.Main hiding (defaultOptions)
13−import Data.Aeson
14−import Data.Aeson.Encoding
15−import Data.Aeson.TH
16−import Data.Aeson.Types
17−import Data.ByteString.Lazy (ByteString)
18−import Data.Data (Data)
19−import Data.Typeable (Typeable)
20−import GHC.Generics (Generic, Rep)
21−import Options
22−
23−toBS :: Encoding -> ByteString
24−toBS = encodingToLazyByteString
25−
26−gEncode :: (Generic a, GToEncoding Zero (Rep a)) => a -> ByteString
27−gEncode = toBS . genericToEncoding opts
28−
29−--------------------------------------------------------------------------------
30−
31−data D a = Nullary
32− | Unary Int
33− | Product String Char a
34− | Record { testOne :: Double
35− , testTwo :: Bool
36− , testThree :: D a
37− }
38− deriving (Show, Eq)
39−
40−deriveJSON opts ''D
41−
42−instance NFData a => NFData (D a) where
43− rnf Nullary = ()
44− rnf (Unary n) = rnf n
45− rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
46− rnf (Record d b y) = d `deepseq` b `deepseq` rnf y
47−
48−type T = D (D (D ()))
49−
50−d :: T
51−d = Record
52− { testOne = 1234.56789
53− , testTwo = True
54− , testThree = Product "Hello World!" 'a'
55− Record
56− { testOne = 9876.54321
57− , testTwo = False
58− , testThree = Product "Yeehaa!!!" '\n' Nullary
59− }
60− }
61−
62−--------------------------------------------------------------------------------
63−
64−data D' a = Nullary'
65− | Unary' Int
66− | Product' String Char a
67− | Record' { testOne' :: Double
68− , testTwo' :: Bool
69− , testThree' :: D' a
70− }
71− deriving (Show, Eq, Generic)
72−
73−instance ToJSON a => ToJSON (D' a) where
74− toJSON = genericToJSON opts
75−
76−instance FromJSON a => FromJSON (D' a) where
77− parseJSON = genericParseJSON opts
78−
79−instance NFData a => NFData (D' a) where
80− rnf Nullary' = ()
81− rnf (Unary' n) = rnf n
82− rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
83− rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y
84−
85−type T' = D' (D' (D' ()))
86−
87−d' :: T'
88−d' = Record'
89− { testOne' = 1234.56789
90− , testTwo' = True
91− , testThree' = Product' "Hello World!" 'a'
92− Record'
93− { testOne' = 9876.54321
94− , testTwo' = False
95− , testThree' = Product' "Yeehaa!!!" '\n' Nullary'
96− }
97− }
98−
99−--------------------------------------------------------------------------------
100−
101−data BigRecord = BigRecord
102− { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
103− , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
104− , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
105− , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
106− , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
107− } deriving (Show, Eq, Generic)
108−
109−instance NFData BigRecord
110−
111−bigRecord = BigRecord 1 2 3 4 5
112− 6 7 8 9 10
113− 11 12 13 14 15
114− 16 17 18 19 20
115− 21 22 23 24 25
116−
117−return []
118−
119−gBigRecordToJSON :: BigRecord -> Value
120−gBigRecordToJSON = genericToJSON opts
121−
122−gBigRecordEncode :: BigRecord -> ByteString
123−gBigRecordEncode = gEncode
124−
125−gBigRecordFromJSON :: Value -> Result BigRecord
126−gBigRecordFromJSON = parse $ genericParseJSON opts
127−
128−thBigRecordToJSON :: BigRecord -> Value
129−thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
130−
131−thBigRecordEncode :: BigRecord -> ByteString
132−thBigRecordEncode = toBS . $(mkToEncoding opts ''BigRecord)
133−
134−thBigRecordFromJSON :: Value -> Result BigRecord
135−thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
136−
137−--------------------------------------------------------------------------------
138−
139−data BigProduct = BigProduct
140− !Int !Int !Int !Int !Int
141− !Int !Int !Int !Int !Int
142− !Int !Int !Int !Int !Int
143− !Int !Int !Int !Int !Int
144− !Int !Int !Int !Int !Int
145− deriving (Show, Eq, Generic)
146−
147−instance NFData BigProduct
148−
149−bigProduct = BigProduct 1 2 3 4 5
150− 6 7 8 9 10
151− 11 12 13 14 15
152− 16 17 18 19 20
153− 21 22 23 24 25
154−
155−return []
156−
157−gBigProductToJSON :: BigProduct -> Value
158−gBigProductToJSON = genericToJSON opts
159−
160−gBigProductEncode :: BigProduct -> ByteString
161−gBigProductEncode = gEncode
162−
163−gBigProductFromJSON :: Value -> Result BigProduct
164−gBigProductFromJSON = parse $ genericParseJSON opts
165−
166−thBigProductToJSON :: BigProduct -> Value
167−thBigProductToJSON = $(mkToJSON opts ''BigProduct)
168−
169−thBigProductEncode :: BigProduct -> ByteString
170−thBigProductEncode = toBS . $(mkToEncoding opts ''BigProduct)
171−
172−thBigProductFromJSON :: Value -> Result BigProduct
173−thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
174−
175−--------------------------------------------------------------------------------
176−
177−data BigSum = F01 | F02 | F03 | F04 | F05
178− | F06 | F07 | F08 | F09 | F10
179− | F11 | F12 | F13 | F14 | F15
180− | F16 | F17 | F18 | F19 | F20
181− | F21 | F22 | F23 | F24 | F25
182− deriving (Show, Eq, Generic)
183−
184−instance NFData BigSum
185−
186−bigSum = F25
187−
188−return []
189−
190−gBigSumToJSON :: BigSum -> Value
191−gBigSumToJSON = genericToJSON opts
192−
193−gBigSumEncode :: BigSum -> ByteString
194−gBigSumEncode = gEncode
195−
196−gBigSumFromJSON :: Value -> Result BigSum
197−gBigSumFromJSON = parse $ genericParseJSON opts
198−
199−thBigSumToJSON :: BigSum -> Value
200−thBigSumToJSON = $(mkToJSON opts ''BigSum)
201−
202−thBigSumEncode :: BigSum -> ByteString
203−thBigSumEncode = toBS . $(mkToEncoding opts ''BigSum)
204−
205−thBigSumFromJSON :: Value -> Result BigSum
206−thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
207−
208−--------------------------------------------------------------------------------
209−
210−type FJ a = Value -> Result a
211−
212−runBench :: IO ()
213−runBench = defaultMain
214− [ let v = toJSON d
215− in (d, d', v) `deepseq`
216− bgroup "D"
217− [ group "toJSON" (nf toJSON d)
218− (nf toJSON d')
219− , group "encode" (nf encode d)
220− (nf encode d')
221− , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
222− (nf ( fromJSON :: FJ T') v)
223− ]
224− , let v = thBigRecordToJSON bigRecord
225− in bigRecord `deepseq` v `deepseq`
226− bgroup "BigRecord"
227− [ group "toJSON" (nf thBigRecordToJSON bigRecord)
228− (nf gBigRecordToJSON bigRecord)
229− , group "encode" (nf thBigRecordEncode bigRecord)
230− (nf gBigRecordEncode bigRecord)
231− , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
232− (nf ( gBigRecordFromJSON :: FJ BigRecord) v)
233− ]
234− , let v = thBigProductToJSON bigProduct
235− in bigProduct `deepseq` v `deepseq`
236− bgroup "BigProduct"
237− [ group "toJSON" (nf thBigProductToJSON bigProduct)
238− (nf gBigProductToJSON bigProduct)
239− , group "encode" (nf thBigProductEncode bigProduct)
240− (nf gBigProductEncode bigProduct)
241− , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
242− (nf (gBigProductFromJSON :: FJ BigProduct) v)
243− ]
244− , let v = thBigSumToJSON bigSum
245− in bigSum `deepseq` v `deepseq`
246− bgroup "BigSum"
247− [ group "toJSON" (nf thBigSumToJSON bigSum)
248− (nf gBigSumToJSON bigSum)
249− , group "encode" (nf thBigSumEncode bigSum)
250− (nf gBigSumEncode bigSum)
251− , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
252− (nf (gBigSumFromJSON :: FJ BigSum) v)
253− ]
254− ]
255−
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