git.iko.soy/typeable/aeson
on 0.11.1.0 help sign in
typeable/aeson/benchmarks/AesonCompareAutoInstances.hs
231 lines 7.6 kB history raw
1{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, TemplateHaskell #-}
3module Main where
5--------------------------------------------------------------------------------
7import Criterion.Main hiding (defaultOptions)
9import Control.DeepSeq (NFData, rnf, deepseq)
11import Data.Typeable (Typeable)
12import Data.Data (Data)
13import GHC.Generics (Generic)
15import Data.Aeson.Types
16import Data.Aeson.TH
17import qualified Data.Aeson.Generic as G (fromJSON, toJSON)
19import Data.Aeson.Encode
21import Options
23--------------------------------------------------------------------------------
25data D a = Nullary
26 | Unary Int
27 | Product String Char a
28 | Record { testOne :: Double
29 , testTwo :: Bool
30 , testThree :: D a
31 }
32 deriving (Show, Eq, Data, Typeable)
34deriveJSON opts ''D
36instance NFData a => NFData (D a) where
37 rnf Nullary = ()
38 rnf (Unary n) = rnf n
39 rnf (Product s c x) = s `deepseq` c `deepseq` rnf x
40 rnf (Record d b y) = d `deepseq` b `deepseq` rnf y
42type T = D (D (D ()))
44d :: T
45d = Record
46 { testOne = 1234.56789
47 , testTwo = True
48 , testThree = Product "Hello World!" 'a' $
49 Record
50 { testOne = 9876.54321
51 , testTwo = False
52 , testThree = Product "Yeehaa!!!" '\n' Nullary
53 }
54 }
56--------------------------------------------------------------------------------
58data D' a = Nullary'
59 | Unary' Int
60 | Product' String Char a
61 | Record' { testOne' :: Double
62 , testTwo' :: Bool
63 , testThree' :: D' a
64 }
65 deriving (Show, Eq, Generic, Data, Typeable)
67instance ToJSON a => ToJSON (D' a) where
68 toJSON = genericToJSON opts
70instance FromJSON a => FromJSON (D' a) where
71 parseJSON = genericParseJSON opts
73instance NFData a => NFData (D' a) where
74 rnf Nullary' = ()
75 rnf (Unary' n) = rnf n
76 rnf (Product' s c x) = s `deepseq` c `deepseq` rnf x
77 rnf (Record' d b y) = d `deepseq` b `deepseq` rnf y
79type T' = D' (D' (D' ()))
81d' :: T'
82d' = Record'
83 { testOne' = 1234.56789
84 , testTwo' = True
85 , testThree' = Product' "Hello World!" 'a' $
86 Record'
87 { testOne' = 9876.54321
88 , testTwo' = False
89 , testThree' = Product' "Yeehaa!!!" '\n' Nullary'
90 }
91 }
93--------------------------------------------------------------------------------
95data BigRecord = BigRecord
96 { field01 :: !Int, field02 :: !Int, field03 :: !Int, field04 :: !Int, field05 :: !Int
97 , field06 :: !Int, field07 :: !Int, field08 :: !Int, field09 :: !Int, field10 :: !Int
98 , field11 :: !Int, field12 :: !Int, field13 :: !Int, field14 :: !Int, field15 :: !Int
99 , field16 :: !Int, field17 :: !Int, field18 :: !Int, field19 :: !Int, field20 :: !Int
100 , field21 :: !Int, field22 :: !Int, field23 :: !Int, field24 :: !Int, field25 :: !Int
101 } deriving (Show, Eq, Generic, Data, Typeable)
103instance NFData BigRecord
105bigRecord = BigRecord 1 2 3 4 5
106 6 7 8 9 10
107 11 12 13 14 15
108 16 17 18 19 20
109 21 22 23 24 25
111gBigRecordToJSON :: BigRecord -> Value
112gBigRecordToJSON = genericToJSON opts
114gBigRecordFromJSON :: Value -> Result BigRecord
115gBigRecordFromJSON = parse $ genericParseJSON opts
117thBigRecordToJSON :: BigRecord -> Value
118thBigRecordToJSON = $(mkToJSON opts ''BigRecord)
120thBigRecordFromJSON :: Value -> Result BigRecord
121thBigRecordFromJSON = parse $(mkParseJSON opts ''BigRecord)
123--------------------------------------------------------------------------------
125data BigProduct = BigProduct
126 !Int !Int !Int !Int !Int
127 !Int !Int !Int !Int !Int
128 !Int !Int !Int !Int !Int
129 !Int !Int !Int !Int !Int
130 !Int !Int !Int !Int !Int
131 deriving (Show, Eq, Generic, Data, Typeable)
133instance NFData BigProduct
135bigProduct = BigProduct 1 2 3 4 5
136 6 7 8 9 10
137 11 12 13 14 15
138 16 17 18 19 20
139 21 22 23 24 25
141gBigProductToJSON :: BigProduct -> Value
142gBigProductToJSON = genericToJSON opts
144gBigProductFromJSON :: Value -> Result BigProduct
145gBigProductFromJSON = parse $ genericParseJSON opts
147thBigProductToJSON :: BigProduct -> Value
148thBigProductToJSON = $(mkToJSON opts ''BigProduct)
150thBigProductFromJSON :: Value -> Result BigProduct
151thBigProductFromJSON = parse $(mkParseJSON opts ''BigProduct)
153--------------------------------------------------------------------------------
155data BigSum = F01 | F02 | F03 | F04 | F05
156 | F06 | F07 | F08 | F09 | F10
157 | F11 | F12 | F13 | F14 | F15
158 | F16 | F17 | F18 | F19 | F20
159 | F21 | F22 | F23 | F24 | F25
160 deriving (Show, Eq, Generic, Data, Typeable)
162instance NFData BigSum
164bigSum = F25
166gBigSumToJSON :: BigSum -> Value
167gBigSumToJSON = genericToJSON opts
169gBigSumFromJSON :: Value -> Result BigSum
170gBigSumFromJSON = parse $ genericParseJSON opts
172thBigSumToJSON :: BigSum -> Value
173thBigSumToJSON = $(mkToJSON opts ''BigSum)
175thBigSumFromJSON :: Value -> Result BigSum
176thBigSumFromJSON = parse $(mkParseJSON opts ''BigSum)
178--------------------------------------------------------------------------------
180type FJ a = Value -> Result a
182main :: IO ()
183main = defaultMain
184 [ let v = toJSON d
185 in (d, d', v) `deepseq`
186 bgroup "D"
187 [ group "toJSON" (nf toJSON d)
188 (nf G.toJSON d)
189 (nf toJSON d')
190 , group "fromJSON" (nf ( fromJSON :: FJ T ) v)
191 (nf (G.fromJSON :: FJ T ) v)
192 (nf ( fromJSON :: FJ T') v)
193 ]
194 , let v = thBigRecordToJSON bigRecord
195 in bigRecord `deepseq` v `deepseq`
196 bgroup "BigRecord"
197 [ group "toJSON" (nf thBigRecordToJSON bigRecord)
198 (nf G.toJSON bigRecord)
199 (nf gBigRecordToJSON bigRecord)
200 , group "fromJSON" (nf (thBigRecordFromJSON :: FJ BigRecord) v)
201 (nf (G.fromJSON :: FJ BigRecord) v)
202 (nf (gBigRecordFromJSON :: FJ BigRecord) v)
203 ]
204 , let v = thBigProductToJSON bigProduct
205 in bigProduct `deepseq` v `deepseq`
206 bgroup "BigProduct"
207 [ group "toJSON" (nf thBigProductToJSON bigProduct)
208 (nf G.toJSON bigProduct)
209 (nf gBigProductToJSON bigProduct)
210 , group "fromJSON" (nf (thBigProductFromJSON :: FJ BigProduct) v)
211 (nf (G.fromJSON :: FJ BigProduct) v)
212 (nf (gBigProductFromJSON :: FJ BigProduct) v)
213 ]
214 , let v = thBigSumToJSON bigSum
215 in bigSum `deepseq` v `deepseq`
216 bgroup "BigSum"
217 [ group "toJSON" (nf thBigSumToJSON bigSum)
218 (nf G.toJSON bigSum)
219 (nf gBigSumToJSON bigSum)
220 , group "fromJSON" (nf (thBigSumFromJSON :: FJ BigSum) v)
221 (nf (G.fromJSON :: FJ BigSum) v)
222 (nf (gBigSumFromJSON :: FJ BigSum) v)
223 ]
224 ]
226group n th syb gen = bcompare
227 [ bgroup n [ bench "th" th
228 , bench "syb" syb
229 , bench "generic" gen
230 ]
231 ]