git.iko.soy/typeable/aeson
on master help sign in
Basic benchmarking for direct (new) vs via-Value (old) encoding

We beat via-Value by over 2x! Woohoo!

commitde6a3a34dd8d31373bc3b3b33a8b64ee3cdd7756 authorBryan O'Sullivan <bos@serpentine.com> dateTue 26 May 2015, 12:57 (11 years ago) parentd56c8c8
11 files changed+326−11
compare with master
unifiedsplit
Data/Aeson.hs+2−1 Data/Aeson/Types.hs+2−1 Data/Aeson/Types/Class.hs+8−3 Data/Aeson/Types/Instances.hs+13−5 benchmarks/Twitter.hs+55 benchmarks/Twitter/Generic.hs+24 benchmarks/Twitter/Manual.hs+139 benchmarks/Twitter/TH.hs+18 benchmarks/Typed.hs+31 benchmarks/Typed/Manual.hs+16 benchmarks/aeson-benchmarks.cabal+18−1
Data/Aeson.hs+2−1
@@ -68,7 +68,8 @@ module Data.Aeson
6868 , withScientific
6969 , withBool
7070 -- * Constructors and accessors
71− , (.=)
71+ , Pairable(..)
72+ , series
7273 , (.:)
7374 , (.:?)
7475 , (.!=)
Data/Aeson/Types.hs+2−1
@@ -48,7 +48,8 @@ module Data.Aeson.Types
4848 , withBool
4949
5050 -- * Constructors and accessors
51− , (.=)
51+ , Pairable(..)
52+ , series
5253 , (.:)
5354 , (.:?)
5455 , (.!=)
Data/Aeson/Types/Class.hs+8−3
@@ -13,18 +13,20 @@
1313
1414module Data.Aeson.Types.Class
1515 (
16− -- * Type classes
17− -- ** Core JSON classes
16+ -- * Core JSON classes
1817 FromJSON(..)
1918 , ToJSON(..)
20− -- ** Generic JSON classes
19+ -- * Generic JSON classes
2120 , GFromJSON(..)
2221 , GToJSON(..)
2322 , genericToJSON
2423 , genericToEncoding
2524 , genericParseJSON
25+ -- * Object key-value pairs
26+ , Pairable(..)
2627 ) where
2728
29+import Data.Text (Text)
2830import Data.Aeson.Types.Internal
2931import GHC.Generics
3032
@@ -196,3 +198,6 @@ class FromJSON a where
196198
197199 default parseJSON :: (Generic a, GFromJSON (Rep a)) => Value -> Parser a
198200 parseJSON = genericParseJSON defaultOptions
201+
202+class Pairable t where
203+ (.=) :: ToJSON a => Text -> a -> t
Data/Aeson/Types/Instances.hs+13−5
@@ -46,7 +46,8 @@ module Data.Aeson.Types.Instances
4646 , (.:)
4747 , (.:?)
4848 , (.!=)
49− , (.=)
49+ , Pairable(..)
50+ , series
5051 , typeMismatch
5152 ) where
5253
@@ -1417,10 +1418,17 @@ withBool _ f (Bool arr) = f arr
14171418withBool expected _ v = typeMismatch expected v
14181419{-# INLINE withBool #-}
14191420
1420−-- | Construct a 'Pair' from a key and a value.
1421−(.=) :: ToJSON a => Text -> a -> Pair
1422−name .= value = (name, toJSON value)
1423−{-# INLINE (.=) #-}
1421+instance Pairable Pair where
1422+ name .= value = (name, toJSON value)
1423+ {-# INLINE (.=) #-}
1424+
1425+instance Pairable Series where
1426+ name .= value = Value (E.text name <> B.char7 ':' <> toEncoding value)
1427+ {-# INLINE (.=) #-}
1428+
1429+series :: Series -> B.Builder
1430+series Empty = mempty
1431+series (Value v) = v
14241432
14251433-- | Convert a value from JSON, failing if the types do not match.
14261434fromJSON :: (FromJSON a) => Value -> Result a
benchmarks/Twitter.hsnew file+55
@@ -0,0 +1,55 @@
1+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
2+
3+module Twitter (
4+ Metadata(..)
5+ , Geo(..)
6+ , Story(..)
7+ , Result(..)
8+ ) where
9+
10+import Data.Data (Typeable, Data)
11+import Data.Int (Int64)
12+import Data.Text (Text)
13+-- import Data.Time (ZonedTime)
14+import GHC.Generics (Generic)
15+import Prelude hiding (id)
16+
17+data Metadata = Metadata {
18+ result_type :: Text
19+ } deriving (Eq, Show, Typeable, Data, Generic)
20+
21+data Geo = Geo {
22+ type_ :: Text
23+ , coordinates :: (Double, Double)
24+ } deriving (Eq, Show, Typeable, Data, Generic)
25+
26+data Story = Story {
27+ from_user_id_str :: Text
28+ , profile_image_url :: Text
29+ , created_at :: Text -- ZonedTime
30+ , from_user :: Text
31+ , id_str :: Text
32+ , metadata :: Metadata
33+ , to_user_id :: Maybe Int64
34+ , text :: Text
35+ , id :: Int64
36+ , from_user_id :: Int64
37+ , geo :: Maybe Geo
38+ , iso_language_code :: Text
39+ , to_user_id_str :: Maybe Text
40+ , source :: Text
41+ } deriving (Show, Typeable, Data, Generic)
42+
43+data Result = Result {
44+ results :: [Story]
45+ , max_id :: Int64
46+ , since_id :: Int64
47+ , refresh_url :: Text
48+ , next_page :: Text
49+ , results_per_page :: Int
50+ , page :: Int
51+ , completed_in :: Double
52+ , since_id_str :: Text
53+ , max_id_str :: Text
54+ , query :: Text
55+ } deriving (Show, Typeable, Data, Generic)
benchmarks/Twitter/Generic.hsnew file+24
@@ -0,0 +1,24 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
2+
3+module Twitter.Generic
4+ (
5+ Metadata(..)
6+ , Geo(..)
7+ , Story(..)
8+ , Result(..)
9+ ) where
10+
11+import Data.Aeson (ToJSON, FromJSON)
12+import Twitter
13+
14+instance ToJSON Metadata
15+instance FromJSON Metadata
16+
17+instance ToJSON Geo
18+instance FromJSON Geo
19+
20+instance ToJSON Story
21+instance FromJSON Story
22+
23+instance ToJSON Result
24+instance FromJSON Result
benchmarks/Twitter/Manual.hsnew file+139
@@ -0,0 +1,139 @@
1+{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+
4+module Twitter.Manual
5+ (
6+ Metadata(..)
7+ , Geo(..)
8+ , Story(..)
9+ , Result(..)
10+ ) where
11+
12+import Control.Applicative
13+import Data.Aeson hiding (Result)
14+import Data.Monoid ((<>))
15+import Prelude hiding (id)
16+import Twitter
17+
18+instance ToJSON Metadata where
19+ toJSON Metadata{..} = object [
20+ "result_type" .= result_type
21+ ]
22+
23+ toEncoding Metadata{..} = series $
24+ "result_type" .= result_type
25+
26+instance FromJSON Metadata where
27+ parseJSON (Object v) = Metadata <$> v .: "result_type"
28+ parseJSON _ = empty
29+
30+instance ToJSON Geo where
31+ toJSON Geo{..} = object [
32+ "type_" .= type_
33+ , "coordinates" .= coordinates
34+ ]
35+
36+ toEncoding Geo{..} = series $
37+ "type_" .= type_
38+ <> "coordinates" .= coordinates
39+
40+instance FromJSON Geo where
41+ parseJSON (Object v) = Geo <$>
42+ v .: "type_"
43+ <*> v .: "coordinates"
44+ parseJSON _ = empty
45+
46+instance ToJSON Story where
47+ toJSON Story{..} = object [
48+ "from_user_id_str" .= from_user_id_str
49+ , "profile_image_url" .= profile_image_url
50+ , "created_at" .= created_at
51+ , "from_user" .= from_user
52+ , "id_str" .= id_str
53+ , "metadata" .= metadata
54+ , "to_user_id" .= to_user_id
55+ , "text" .= text
56+ , "id" .= id
57+ , "from_user_id" .= from_user_id
58+ , "geo" .= geo
59+ , "iso_language_code" .= iso_language_code
60+ , "to_user_id_str" .= to_user_id_str
61+ , "source" .= source
62+ ]
63+
64+ toEncoding Story{..} = series $
65+ "from_user_id_str" .= from_user_id_str
66+ <> "profile_image_url" .= profile_image_url
67+ <> "created_at" .= created_at
68+ <> "from_user" .= from_user
69+ <> "id_str" .= id_str
70+ <> "metadata" .= metadata
71+ <> "to_user_id" .= to_user_id
72+ <> "text" .= text
73+ <> "id" .= id
74+ <> "from_user_id" .= from_user_id
75+ <> "geo" .= geo
76+ <> "iso_language_code" .= iso_language_code
77+ <> "to_user_id_str" .= to_user_id_str
78+ <> "source" .= source
79+
80+instance FromJSON Story where
81+ parseJSON (Object v) = Story <$>
82+ v .: "from_user_id_str"
83+ <*> v .: "profile_image_url"
84+ <*> v .: "created_at"
85+ <*> v .: "from_user"
86+ <*> v .: "id_str"
87+ <*> v .: "metadata"
88+ <*> v .: "to_user_id"
89+ <*> v .: "text"
90+ <*> v .: "id"
91+ <*> v .: "from_user_id"
92+ <*> v .: "geo"
93+ <*> v .: "iso_language_code"
94+ <*> v .: "to_user_id_str"
95+ <*> v .: "source"
96+ parseJSON _ = empty
97+
98+instance ToJSON Result where
99+ toJSON Result{..} = object [
100+ "results" .= results
101+ , "max_id" .= max_id
102+ , "since_id" .= since_id
103+ , "refresh_url" .= refresh_url
104+ , "next_page" .= next_page
105+ , "results_per_page" .= results_per_page
106+ , "page" .= page
107+ , "completed_in" .= completed_in
108+ , "since_id_str" .= since_id_str
109+ , "max_id_str" .= max_id_str
110+ , "query" .= query
111+ ]
112+
113+ toEncoding Result{..} = series $
114+ "results" .= results
115+ <> "max_id" .= max_id
116+ <> "since_id" .= since_id
117+ <> "refresh_url" .= refresh_url
118+ <> "next_page" .= next_page
119+ <> "results_per_page" .= results_per_page
120+ <> "page" .= page
121+ <> "completed_in" .= completed_in
122+ <> "since_id_str" .= since_id_str
123+ <> "max_id_str" .= max_id_str
124+ <> "query" .= query
125+
126+instance FromJSON Result where
127+ parseJSON (Object v) = Result <$>
128+ v .: "results"
129+ <*> v .: "max_id"
130+ <*> v .: "since_id"
131+ <*> v .: "refresh_url"
132+ <*> v .: "next_page"
133+ <*> v .: "results_per_page"
134+ <*> v .: "page"
135+ <*> v .: "completed_in"
136+ <*> v .: "since_id_str"
137+ <*> v .: "max_id_str"
138+ <*> v .: "query"
139+ parseJSON _ = empty
benchmarks/Twitter/TH.hsnew file+18
@@ -0,0 +1,18 @@
1+{-# LANGUAGE TemplateHaskell #-}
2+{-# OPTIONS_GHC -fno-warn-orphans #-}
3+
4+module Twitter.TH
5+ (
6+ Metadata(..)
7+ , Geo(..)
8+ , Story(..)
9+ , Result(..)
10+ ) where
11+
12+import Data.Aeson.TH
13+import Twitter
14+
15+$(deriveJSON defaultOptions ''Metadata)
16+$(deriveJSON defaultOptions ''Geo)
17+$(deriveJSON defaultOptions ''Story)
18+$(deriveJSON defaultOptions ''Result)
benchmarks/Typed.hsnew file+31
@@ -0,0 +1,31 @@
1+module Main (main) where
2+
3+import qualified Data.ByteString.Lazy as L
4+import Criterion.Main
5+import Data.Aeson
6+import Typed.Manual
7+import Control.Applicative ((<$>))
8+import System.Exit
9+import System.IO
10+
11+deeecode fileName = do
12+ mv <- eitherDecode' <$> L.readFile fileName
13+ case mv of
14+ Right v -> return v
15+ Left err -> do
16+ hPutStrLn stderr $ fileName ++ ": JSON decode failed - " ++ err
17+ exitWith (ExitFailure 1)
18+
19+main = do
20+ twitter100 <- deeecode "json-data/twitter100.json"
21+ jp100 <- deeecode "json-data/jp100.json"
22+ defaultMain [
23+ bgroup "direct" [
24+ bench "twitter100" $ nf encodeDirect twitter100
25+ , bench "jp100" $ nf encodeDirect jp100
26+ ]
27+ , bgroup "viaValue" [
28+ bench "twitter100" $ nf encodeViaValue twitter100
29+ , bench "jp100" $ nf encodeViaValue jp100
30+ ]
31+ ]
benchmarks/Typed/Manual.hsnew file+16
@@ -0,0 +1,16 @@
1+module Typed.Manual
2+ (
3+ encodeDirect
4+ , encodeViaValue
5+ ) where
6+
7+import Twitter.Manual
8+import Data.Aeson hiding (Result)
9+import Data.ByteString.Lazy as L
10+import Data.ByteString.Builder as B
11+
12+encodeDirect :: Result -> L.ByteString
13+encodeDirect = B.toLazyByteString . toEncoding
14+
15+encodeViaValue :: Result -> L.ByteString
16+encodeViaValue = encode
benchmarks/aeson-benchmarks.cabal+18−1
@@ -11,7 +11,7 @@ flag old-locale
1111 default: False
1212
1313library
14− hs-source-dirs: ..
14+ hs-source-dirs: .. .
1515
1616 exposed-modules:
1717 Data.Aeson
@@ -19,6 +19,9 @@ library
1919 Data.Aeson.Parser
2020 Data.Aeson.Types
2121 Data.Aeson.TH
22+ Twitter.Generic
23+ Twitter.Manual
24+ Twitter.TH
2225
2326 other-modules:
2427 Data.Aeson.Encode.ByteString
@@ -28,6 +31,7 @@ library
2831 Data.Aeson.Types.Generic
2932 Data.Aeson.Types.Instances
3033 Data.Aeson.Types.Internal
34+ Twitter
3135
3236 build-depends:
3337 attoparsec >= 0.13.0.0,
@@ -43,6 +47,7 @@ library
4347 syb,
4448 template-haskell >= 2.4,
4549 text >= 1.1.1.0,
50+ time,
4651 transformers,
4752 unordered-containers >= 0.2.3.0,
4853 vector >= 0.7.1
@@ -55,6 +60,18 @@ library
5560 ghc-options: -O2 -Wall
5661 cpp-options: -DGENERICS
5762
63+executable aeson-benchmark-typed
64+ main-is: Typed.hs
65+ ghc-options: -Wall -O2 -rtsopts
66+ build-depends:
67+ aeson-benchmarks,
68+ base,
69+ bytestring,
70+ criterion,
71+ deepseq,
72+ text,
73+ time
74+
5875executable aeson-benchmark-compare-with-json
5976 main-is: CompareWithJSON.hs
6077 ghc-options: -Wall -O2 -rtsopts