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