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