1{-# LANGUAGE CPP #-}
2{-# LANGUAGE BangPatterns #-}
3{-# LANGUAGE MagicHash #-}
4{-# LANGUAGE NoImplicitPrelude #-}
5{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE RecordWildCards #-}
7{-# LANGUAGE ScopedTypeVariables #-}
8
9-- Adapted from a buffer-builder benchmark:
10--
11-- https://github.com/chadaustin/buffer-builder/blob/master/test.json
12
13module Compare.JsonBench (benchmarks) where
14
15import Prelude.Compat hiding ((<>))
16
17import Control.DeepSeq (NFData(..))
18import Criterion
19import Data.Aeson ((.:))
20import Data.Monoid ((<>))
21import Data.Text (Text)
22import Typed.Common (load)
23import qualified Control.Monad.Fail as Fail
24import qualified Data.Aeson as Aeson
25import qualified Data.BufferBuilder.Json as Json
26
27#ifdef MIN_VERSION_json_builder
28import qualified Data.Json.Builder as JB
29#endif
30
31data EyeColor = Green | Blue | Brown
32    deriving (Eq, Show)
33data Gender = Male | Female
34    deriving (Eq, Show)
35data Fruit = Apple | Strawberry | Banana
36    deriving (Eq, Show)
37data Friend = Friend
38    { fId :: !Int
39    , fName :: !Text
40    } deriving (Eq, Show)
41
42data User = User
43    { uId       :: !Text
44    , uIndex    :: !Int
45    , uGuid     :: !Text
46    , uIsActive :: !Bool
47    , uBalance  :: !Text
48    , uPicture  :: !Text
49    , uAge      :: !Int
50    , uEyeColor :: !EyeColor
51    , uName     :: !Text
52    , uGender   :: !Gender
53    , uCompany  :: !Text
54    , uEmail    :: !Text
55    , uPhone    :: !Text
56    , uAddress  :: !Text
57    , uAbout    :: !Text
58    , uRegistered   :: !Text -- UTCTime?
59    , uLatitude :: !Double
60    , uLongitude    :: !Double
61    , uTags :: ![Text]
62    , uFriends  :: ![Friend]
63    , uGreeting :: !Text
64    , uFavouriteFruit   :: !Fruit
65    } deriving (Eq, Show)
66
67instance NFData EyeColor where rnf !_ = ()
68instance NFData Gender where rnf !_ = ()
69instance NFData Fruit where rnf !_ = ()
70
71instance NFData Friend where
72    rnf Friend {..} = rnf fId `seq` rnf fName
73
74instance NFData User where
75    rnf User {..} = rnf uId `seq` rnf uIndex `seq` rnf uGuid `seq` rnf uIsActive `seq` rnf uBalance `seq` rnf uPicture `seq` rnf uAge `seq` rnf uEyeColor `seq` rnf uName `seq` rnf uGender `seq` rnf uCompany `seq` rnf uEmail `seq` rnf uPhone `seq` rnf uAddress `seq` rnf uAbout `seq` rnf uRegistered `seq` rnf uLatitude `seq` rnf uLongitude `seq` rnf uTags `seq` rnf uFriends `seq` rnf uGreeting `seq` rnf uFavouriteFruit
76
77eyeColorTable :: [(Text, EyeColor)]
78eyeColorTable = [("brown", Brown), ("green", Green), ("blue", Blue)]
79
80genderTable :: [(Text, Gender)]
81genderTable = [("male", Male), ("female", Female)]
82
83fruitTable :: [(Text, Fruit)]
84fruitTable = [("apple", Apple), ("strawberry", Strawberry), ("banana", Banana)]
85
86enumFromJson :: Fail.MonadFail m => String -> [(Text, enum)] -> (json -> m Text) -> json -> m enum
87enumFromJson enumName table extract v = do
88    s <- extract v
89    case lookup s table of
90        Just r -> return r
91        Nothing -> fail $ "Bad " ++ enumName ++ ": " ++ show s
92
93--- Aeson instances ---
94
95instance Aeson.FromJSON EyeColor where
96    parseJSON = enumFromJson "EyeColor" eyeColorTable Aeson.parseJSON
97
98instance Aeson.FromJSON Gender where
99    parseJSON = enumFromJson "Gender" genderTable Aeson.parseJSON
100
101instance Aeson.FromJSON Fruit where
102    parseJSON = enumFromJson "Fruit" fruitTable Aeson.parseJSON
103
104instance Aeson.FromJSON Friend where
105    parseJSON = Aeson.withObject "Friend" $ \o -> do
106        fId <- o .: "id"
107        fName <- o .: "name"
108        return Friend {..}
109
110instance Aeson.FromJSON User where
111    parseJSON = Aeson.withObject "User" $ \o -> do
112        uId <- o .: "_id"
113        uIndex <- o .: "index"
114        uGuid <- o .: "guid"
115        uIsActive <- o .: "isActive"
116        uBalance <- o .: "balance"
117        uPicture <- o .: "picture"
118        uAge <- o .: "age"
119        uEyeColor <- o .: "eyeColor"
120        uName <- o .: "name"
121        uGender <- o .: "gender"
122        uCompany <- o .: "company"
123        uEmail <- o .: "email"
124        uPhone <- o .: "phone"
125        uAddress <- o .: "address"
126        uAbout <- o .: "about"
127        uRegistered <- o .: "registered"
128        uLatitude <- o .: "latitude"
129        uLongitude <- o .: "longitude"
130        uTags <- o .: "tags"
131        uFriends <- o .: "friends"
132        uGreeting <- o .: "greeting"
133        uFavouriteFruit <- o .: "favoriteFruit"
134        return User {..}
135
136instance Aeson.ToJSON EyeColor where
137    toJSON ec = Aeson.toJSON $ case ec of
138        Green -> "green" :: Text
139        Blue -> "blue"
140        Brown -> "brown"
141
142    toEncoding ec = Aeson.toEncoding $ case ec of
143        Green -> "green" :: Text
144        Blue -> "blue"
145        Brown -> "brown"
146
147instance Aeson.ToJSON Gender where
148    toJSON g = Aeson.toJSON $ case g of
149        Male -> "male" :: Text
150        Female -> "female"
151
152    toEncoding g = Aeson.toEncoding $ case g of
153        Male -> "male" :: Text
154        Female -> "female"
155
156instance Aeson.ToJSON Fruit where
157    toJSON f = Aeson.toJSON $ case f of
158        Apple -> "apple" :: Text
159        Banana -> "banana"
160        Strawberry -> "strawberry"
161
162    toEncoding f = Aeson.toEncoding $ case f of
163        Apple -> "apple" :: Text
164        Banana -> "banana"
165        Strawberry -> "strawberry"
166
167instance Aeson.ToJSON Friend where
168    toJSON Friend {..} = Aeson.object
169        [ "id" Aeson..= fId
170        , "name" Aeson..= fName
171        ]
172
173    toEncoding Friend {..} = Aeson.pairs $
174           "id" Aeson..= fId
175        <> "name" Aeson..= fName
176
177instance Aeson.ToJSON User where
178    toJSON User{..} = Aeson.object
179        [ "_id" Aeson..= uId
180        , "index" Aeson..= uIndex
181        , "guid" Aeson..= uGuid
182        , "isActive" Aeson..= uIsActive
183        , "balance" Aeson..= uBalance
184        , "picture" Aeson..= uPicture
185        , "age" Aeson..= uAge
186        , "eyeColor" Aeson..= uEyeColor
187        , "name" Aeson..= uName
188        , "gender" Aeson..= uGender
189        , "company" Aeson..= uCompany
190        , "email" Aeson..= uEmail
191        , "phone" Aeson..= uPhone
192        , "address" Aeson..= uAddress
193        , "about" Aeson..= uAbout
194        , "registered" Aeson..= uRegistered
195        , "latitude" Aeson..= uLatitude
196        , "longitude" Aeson..= uLongitude
197        , "tags" Aeson..= uTags
198        , "friends" Aeson..= uFriends
199        , "greeting" Aeson..= uGreeting
200        , "favoriteFruit" Aeson..= uFavouriteFruit
201        ]
202
203    toEncoding User{..} = Aeson.pairs $
204          "_id" Aeson..= uId
205        <> "index" Aeson..= uIndex
206        <> "guid" Aeson..= uGuid
207        <> "isActive" Aeson..= uIsActive
208        <> "balance" Aeson..= uBalance
209        <> "picture" Aeson..= uPicture
210        <> "age" Aeson..= uAge
211        <> "eyeColor" Aeson..= uEyeColor
212        <> "name" Aeson..= uName
213        <> "gender" Aeson..= uGender
214        <> "company" Aeson..= uCompany
215        <> "email" Aeson..= uEmail
216        <> "phone" Aeson..= uPhone
217        <> "address" Aeson..= uAddress
218        <> "about" Aeson..= uAbout
219        <> "registered" Aeson..= uRegistered
220        <> "latitude" Aeson..= uLatitude
221        <> "longitude" Aeson..= uLongitude
222        <> "tags" Aeson..= uTags
223        <> "friends" Aeson..= uFriends
224        <> "greeting" Aeson..= uGreeting
225        <> "favoriteFruit" Aeson..= uFavouriteFruit
226
227--- BufferBuilder instances ---
228
229instance Json.ToJson EyeColor where
230    toJson ec = Json.toJson $ case ec of
231        Green -> "green" :: Text
232        Blue -> "blue"
233        Brown -> "brown"
234
235instance Json.ToJson Gender where
236    toJson g = Json.toJson $ case g of
237        Male -> "male" :: Text
238        Female -> "female"
239
240instance Json.ToJson Fruit where
241    toJson f = Json.toJson $ case f of
242        Apple -> "apple" :: Text
243        Strawberry -> "strawberry"
244        Banana -> "banana"
245
246instance Json.ToJson Friend where
247    toJson Friend{..} = Json.toJson $
248            "_id" Json..= fId
249            <> "name" Json..= fName
250
251instance Json.ToJson User where
252    toJson User{..} = Json.toJson $
253            "_id"# Json..=# uId
254            <> "index"# Json..=# uIndex
255            <> "guid"# Json..=# uGuid
256            <> "isActive"# Json..=# uIsActive
257            <> "balance"# Json..=# uBalance
258            <> "picture"# Json..=# uPicture
259            <> "age"# Json..=# uAge
260            <> "eyeColor"# Json..=# uEyeColor
261            <> "name"# Json..=# uName
262            <> "gender"# Json..=# uGender
263            <> "company"# Json..=# uCompany
264            <> "email"# Json..=# uEmail
265            <> "phone"# Json..=# uPhone
266            <> "address"# Json..=# uAddress
267            <> "about"# Json..=# uAbout
268            <> "registered"# Json..=# uRegistered
269            <> "latitude"# Json..=# uLatitude
270            <> "longitude"# Json..=# uLongitude
271            <> "tags"# Json..=# uTags
272            <> "friends"# Json..=# uFriends
273            <> "greeting"# Json..=# uGreeting
274            <> "favoriteFruit"# Json..=# uFavouriteFruit
275
276#ifdef MIN_VERSION_json_builder
277---- json-builder instances ----
278
279instance JB.Value EyeColor where
280    toJson ec = JB.toJson $ case ec of
281        Green -> "green" :: Text
282        Blue -> "blue"
283        Brown -> "brown"
284
285instance JB.Value Gender where
286    toJson g = JB.toJson $ case g of
287        Male -> "male" :: Text
288        Female -> "female"
289
290instance JB.Value Fruit where
291    toJson f = JB.toJson $ case f of
292        Apple -> "apple" :: Text
293        Strawberry -> "strawberry"
294        Banana -> "banana"
295
296instance JB.Value Friend where
297    toJson Friend{..} = JB.toJson $
298            ("_id" :: Text) `JB.row` fId
299            <> ("name" :: Text) `JB.row` fName
300
301instance JB.Value User where
302    toJson User{..} =
303        let t :: Text -> Text
304            t = id
305        in JB.toJson $
306               t "_id" `JB.row` uId
307            <> t "index" `JB.row` uIndex
308            <> t "guid" `JB.row` uGuid
309            <> t "isActive" `JB.row` uIsActive
310            <> t "balance" `JB.row` uBalance
311            <> t "picture" `JB.row` uPicture
312            <> t "age" `JB.row` uAge
313            <> t "eyeColor" `JB.row` uEyeColor
314            <> t "name" `JB.row` uName
315            <> t "gender" `JB.row` uGender
316            <> t "company" `JB.row` uCompany
317            <> t "email" `JB.row` uEmail
318            <> t "phone" `JB.row` uPhone
319            <> t "address" `JB.row` uAddress
320            <> t "about" `JB.row` uAbout
321            <> t "registered" `JB.row` uRegistered
322            <> t "latitude" `JB.row` uLatitude
323            <> t "longitude" `JB.row` uLongitude
324            <> t "tags" `JB.row` uTags
325            <> t "friends" `JB.row` uFriends
326            <> t "greeting" `JB.row` uGreeting
327            <> t "favoriteFruit" `JB.row` uFavouriteFruit
328#endif
329
330benchmarks :: Benchmark
331benchmarks = env (load "json-data/buffer-builder.json") $
332    \ ~(parsedUserList :: [User]) ->
333    bgroup "json-bench" [
334      bench "aeson" $ nf Aeson.encode parsedUserList
335    , bench "buffer-builder" $ nf Json.encodeJson parsedUserList
336#ifdef MIN_VERSION_json_builder
337    , bench "json-builder" $ nf JB.toJsonLBS parsedUserList
338#endif
339    ]
340