git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #453 from phadej/old-typed-bench
8869d71Adam Bergmark
benchmarks/AesonParse.hs+2−1
compare with master
unifiedsplit
@@ -1,8 +1,9 @@
1{-# LANGUAGE BangPatterns, OverloadedStrings #-}
1{-# LANGUAGE BangPatterns, OverloadedStrings #-}
2+{-# LANGUAGE PackageImports #-}
2
3
3import Control.Exception
4import Control.Exception
4import Control.Monad
5import Control.Monad
5−import Data.Aeson
6+import "aeson-benchmarks" Data.Aeson
6import Data.Attoparsec.ByteString (IResult(..), parseWith)
7import Data.Attoparsec.ByteString (IResult(..), parseWith)
7import Data.Time.Clock
8import Data.Time.Clock
8import System.Environment (getArgs)
9import System.Environment (getArgs)
benchmarks/Compare.hs+2−1
@@ -1,4 +1,5 @@
1{-# LANGUAGE ScopedTypeVariables #-}
1{-# LANGUAGE ScopedTypeVariables #-}
2+{-# LANGUAGE PackageImports #-}
2
3
3module Main (main) where
4module Main (main) where
4
5
@@ -11,7 +12,7 @@ import Twitter
11import Twitter.Manual ()
12import Twitter.Manual ()
12import Typed.Common
13import Typed.Common
13import qualified Compare.JsonBench as JsonBench
14import qualified Compare.JsonBench as JsonBench
14−import qualified Data.Aeson as Aeson
15+import qualified "aeson-benchmarks" Data.Aeson as Aeson
15
16
16main :: IO ()
17main :: IO ()
17main =
18main =
benchmarks/Typed/Common.hs+7
@@ -1,6 +1,13 @@
1+{-# LANGUAGE CPP, PackageImports #-}
1module Typed.Common (load) where
2module Typed.Common (load) where
2
3
4+#ifndef HAS_BOTH_AESON_AND_BENCHMARKS
3import Data.Aeson hiding (Result)
5import Data.Aeson hiding (Result)
6+#else
7+import "aeson" Data.Aeson hiding (Result)
8+import qualified "aeson-benchmarks" Data.Aeson as B
9+#endif
10+
4import Data.ByteString.Lazy as L
11import Data.ByteString.Lazy as L
5import Control.Applicative
12import Control.Applicative
6import System.IO
13import System.IO
benchmarks/Typed/Generic.hs+22−10
@@ -1,29 +1,41 @@
1+{-# LANGUAGE PackageImports #-}
1module Typed.Generic (benchmarks) where
2module Typed.Generic (benchmarks) where
2
3
4+import "aeson" Data.Aeson hiding (Result)
5+import qualified "aeson-benchmarks" Data.Aeson as B
6+
3import Control.Applicative
7import Control.Applicative
4import Criterion
8import Criterion
5−import Data.Aeson hiding (Result)
6−import Data.ByteString.Builder as B
7import Data.ByteString.Lazy as L
9import Data.ByteString.Lazy as L
8import Twitter.TH
10import Twitter.TH
9import Typed.Common
11import Typed.Common
10
12
13+encodeDirectA :: Result -> L.ByteString
14+encodeDirectA = encode
15+
16+encodeViaValueA :: Result -> L.ByteString
17+encodeViaValueA = encode . toJSON
18+
11−encodeDirect :: Result -> L.ByteString
19+encodeDirectB :: Result -> L.ByteString
12−encodeDirect = encode
20+encodeDirectB = B.encode
13
21
14−encodeViaValue :: Result -> L.ByteString
22+encodeViaValueB :: Result -> L.ByteString
15−encodeViaValue = encode . toJSON
23+encodeViaValueB = B.encode . B.toJSON
16
24
17benchmarks :: Benchmark
25benchmarks :: Benchmark
18benchmarks =
26benchmarks =
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
27 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
20 bgroup "generic" [
28 bgroup "generic" [
21 bgroup "direct" [
29 bgroup "direct" [
22− bench "twitter100" $ nf encodeDirect twitter100
30+ bench "twitter100" $ nf encodeDirectB twitter100
31+ , bench "jp100" $ nf encodeDirectB jp100
32+ , bench "twitter100 baseline" $ nf encodeDirectA twitter100
23− , bench "jp100" $ nf encodeDirect jp100
33+ , bench "jp100 baseline" $ nf encodeDirectA jp100
24 ]
34 ]
25 , bgroup "viaValue" [
35 , bgroup "viaValue" [
26− bench "twitter100" $ nf encodeViaValue twitter100
36+ bench "twitter100" $ nf encodeViaValueB twitter100
37+ , bench "jp100" $ nf encodeViaValueB jp100
38+ , bench "twitter100 baseline" $ nf encodeViaValueA twitter100
27− , bench "jp100" $ nf encodeViaValue jp100
39+ , bench "jp100 baseline" $ nf encodeViaValueA jp100
28 ]
40 ]
29 ]
41 ]
benchmarks/Typed/Manual.hs+22−10
@@ -1,29 +1,41 @@
1+{-# LANGUAGE PackageImports #-}
1module Typed.Manual (benchmarks) where
2module Typed.Manual (benchmarks) where
2
3
4+import "aeson" Data.Aeson hiding (Result)
5+import qualified "aeson-benchmarks" Data.Aeson as B
6+
3import Control.Applicative
7import Control.Applicative
4import Criterion
8import Criterion
5−import Data.Aeson hiding (Result)
6−import Data.ByteString.Builder as B
7import Data.ByteString.Lazy as L
9import Data.ByteString.Lazy as L
8import Twitter.Manual
10import Twitter.Manual
9import Typed.Common
11import Typed.Common
10
12
13+encodeDirectA :: Result -> L.ByteString
14+encodeDirectA = encode
15+
16+encodeViaValueA :: Result -> L.ByteString
17+encodeViaValueA = encode . toJSON
18+
11−encodeDirect :: Result -> L.ByteString
19+encodeDirectB :: Result -> L.ByteString
12−encodeDirect = encode
20+encodeDirectB = B.encode
13
21
14−encodeViaValue :: Result -> L.ByteString
22+encodeViaValueB :: Result -> L.ByteString
15−encodeViaValue = encode . toJSON
23+encodeViaValueB = B.encode . B.toJSON
16
24
17benchmarks :: Benchmark
25benchmarks :: Benchmark
18benchmarks =
26benchmarks =
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
27 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
20 bgroup "manual" [
28 bgroup "manual" [
21 bgroup "direct" [
29 bgroup "direct" [
22− bench "twitter100" $ nf encodeDirect twitter100
30+ bench "twitter100" $ nf encodeDirectB twitter100
31+ , bench "jp100" $ nf encodeDirectB jp100
32+ , bench "twitter100 baseline" $ nf encodeDirectA twitter100
23− , bench "jp100" $ nf encodeDirect jp100
33+ , bench "jp100 baseline" $ nf encodeDirectA jp100
24 ]
34 ]
25 , bgroup "viaValue" [
35 , bgroup "viaValue" [
26− bench "twitter100" $ nf encodeViaValue twitter100
36+ bench "twitter100" $ nf encodeViaValueB twitter100
37+ , bench "jp100" $ nf encodeViaValueB jp100
38+ , bench "twitter100 baseline" $ nf encodeViaValueA twitter100
27− , bench "jp100" $ nf encodeViaValue jp100
39+ , bench "jp100 baseline" $ nf encodeViaValueA jp100
28 ]
40 ]
29 ]
41 ]
benchmarks/Typed/TH.hs+22−9
@@ -1,29 +1,42 @@
1+{-# LANGUAGE PackageImports #-}
1module Typed.TH (benchmarks) where
2module Typed.TH (benchmarks) where
2
3
4+import "aeson" Data.Aeson hiding (Result)
5+import qualified "aeson-benchmarks" Data.Aeson as B
6+
3import Control.Applicative
7import Control.Applicative
4import Criterion
8import Criterion
5−import Data.Aeson hiding (Result)
6import Data.ByteString.Builder as B
9import Data.ByteString.Builder as B
7import Data.ByteString.Lazy as L
10import Data.ByteString.Lazy as L
8import Twitter.TH
11import Twitter.TH
9import Typed.Common
12import Typed.Common
10
13
14+encodeDirectA :: Result -> L.ByteString
15+encodeDirectA = encode
16+
17+encodeViaValueA :: Result -> L.ByteString
18+encodeViaValueA = encode . toJSON
19+
11−encodeDirect :: Result -> L.ByteString
20+encodeDirectB :: Result -> L.ByteString
12−encodeDirect = encode
21+encodeDirectB = B.encode
13
22
14−encodeViaValue :: Result -> L.ByteString
23+encodeViaValueB :: Result -> L.ByteString
15−encodeViaValue = encode . toJSON
24+encodeViaValueB = B.encode . B.toJSON
16
25
17benchmarks :: Benchmark
26benchmarks :: Benchmark
18benchmarks =
27benchmarks =
19 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
28 env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
20 bgroup "th" [
29 bgroup "th" [
21 bgroup "direct" [
30 bgroup "direct" [
22− bench "twitter100" $ nf encodeDirect twitter100
31+ bench "twitter100" $ nf encodeDirectB twitter100
32+ , bench "jp100" $ nf encodeDirectB jp100
33+ , bench "twitter100 baseline" $ nf encodeDirectA twitter100
23− , bench "jp100" $ nf encodeDirect jp100
34+ , bench "jp100 baseline" $ nf encodeDirectA jp100
24 ]
35 ]
25 , bgroup "viaValue" [
36 , bgroup "viaValue" [
26− bench "twitter100" $ nf encodeViaValue twitter100
37+ bench "twitter100" $ nf encodeViaValueA twitter100
38+ , bench "jp100" $ nf encodeViaValueA jp100
39+ , bench "twitter100 baseline" $ nf encodeViaValueB twitter100
27− , bench "jp100" $ nf encodeViaValue jp100
40+ , bench "jp100 baseline" $ nf encodeViaValueB jp100
28 ]
41 ]
29 ]
42 ]
benchmarks/aeson-benchmarks.cabal+4
@@ -106,7 +106,11 @@ executable aeson-benchmark-typed
106 main-is: Typed.hs
106 main-is: Typed.hs
107 hs-source-dirs: ../examples .
107 hs-source-dirs: ../examples .
108 ghc-options: -Wall -O2 -rtsopts
108 ghc-options: -Wall -O2 -rtsopts
109+ -- We must help ourself in situations when there is both
110+ -- aeson and aeson-benchmakrs
111+ cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS
109 build-depends:
112 build-depends:
113+ aeson,
110 aeson-benchmarks,
114 aeson-benchmarks,
111 base,
115 base,
112 criterion >= 1.0,
116 criterion >= 1.0,
examples/Twitter/Generic.hs+22−1
@@ -1,5 +1,6 @@
1-- Use GHC generics to automatically generate good instances.
1-- Use GHC generics to automatically generate good instances.
2
2
3+{-# LANGUAGE CPP, PackageImports #-}
3{-# OPTIONS_GHC -fno-warn-orphans #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
4
5
5module Twitter.Generic
6module Twitter.Generic
@@ -10,9 +11,15 @@ module Twitter.Generic
10 , Result(..)
11 , Result(..)
11 ) where
12 ) where
12
13
13−import Data.Aeson (ToJSON, FromJSON)
14import Twitter
14import Twitter
15
15
16+#ifndef HAS_BOTH_AESON_AND_BENCHMARKS
17+import Data.Aeson (ToJSON, FromJSON)
18+#else
19+import "aeson" Data.Aeson (ToJSON, FromJSON)
20+import qualified "aeson-benchmarks" Data.Aeson as B
21+#endif
22+
16instance ToJSON Metadata
23instance ToJSON Metadata
17instance FromJSON Metadata
24instance FromJSON Metadata
18
25
@@ -24,3 +31,17 @@ instance FromJSON Story
24
31
25instance ToJSON Result
32instance ToJSON Result
26instance FromJSON Result
33instance FromJSON Result
34+
35+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
36+instance B.ToJSON Metadata
37+instance B.FromJSON Metadata
38+
39+instance B.ToJSON Geo
40+instance B.FromJSON Geo
41+
42+instance B.ToJSON Story
43+instance B.FromJSON Story
44+
45+instance B.ToJSON Result
46+instance B.FromJSON Result
47+#endif
examples/Twitter/Manual.hs+134−1
@@ -1,5 +1,6 @@
1-- Manually write instances.
1-- Manually write instances.
2
2
3+{-# LANGUAGE CPP, PackageImports #-}
3{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
4{-# LANGUAGE OverloadedStrings, RecordWildCards #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
5
6
@@ -12,12 +13,19 @@ module Twitter.Manual
12 ) where
13 ) where
13
14
14import Control.Applicative
15import Control.Applicative
15−import Data.Aeson hiding (Result)
16import Data.Monoid ((<>))
16import Data.Monoid ((<>))
17import Prelude hiding (id)
17import Prelude hiding (id)
18import Twitter
18import Twitter
19
19
20+#ifndef HAS_BOTH_AESON_AND_BENCHMARKS
21+import Data.Aeson hiding (Result)
22+#else
23+import "aeson" Data.Aeson hiding (Result)
24+import qualified "aeson-benchmarks" Data.Aeson as B
25+#endif
26+
20instance ToJSON Metadata where
27instance ToJSON Metadata where
28+
21 toJSON Metadata{..} = object [
29 toJSON Metadata{..} = object [
22 "result_type" .= result_type
30 "result_type" .= result_type
23 ]
31 ]
@@ -139,3 +147,128 @@ instance FromJSON Result where
139 <*> v .: "max_id_str"
147 <*> v .: "max_id_str"
140 <*> v .: "query"
148 <*> v .: "query"
141 parseJSON _ = empty
149 parseJSON _ = empty
150+
151+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
152+instance B.ToJSON Metadata where
153+ toJSON Metadata{..} = B.object [
154+ "result_type" B..= result_type
155+ ]
156+
157+ toEncoding Metadata{..} = B.pairs $
158+ "result_type" B..= result_type
159+
160+instance B.FromJSON Metadata where
161+ parseJSON (B.Object v) = Metadata <$> v B..: "result_type"
162+ parseJSON _ = empty
163+
164+instance B.ToJSON Geo where
165+ toJSON Geo{..} = B.object [
166+ "type_" B..= type_
167+ , "coordinates" B..= coordinates
168+ ]
169+
170+ toEncoding Geo{..} = B.pairs $
171+ "type_" B..= type_
172+ <> "coordinates" B..= coordinates
173+
174+instance B.FromJSON Geo where
175+ parseJSON (B.Object v) = Geo <$>
176+ v B..: "type_"
177+ <*> v B..: "coordinates"
178+ parseJSON _ = empty
179+
180+instance B.ToJSON Story where
181+ toJSON Story{..} = B.object [
182+ "from_user_id_str" B..= from_user_id_str
183+ , "profile_image_url" B..= profile_image_url
184+ , "created_at" B..= created_at
185+ , "from_user" B..= from_user
186+ , "id_str" B..= id_str
187+ , "metadata" B..= metadata
188+ , "to_user_id" B..= to_user_id
189+ , "text" B..= text
190+ , "id" B..= id
191+ , "from_user_id" B..= from_user_id
192+ , "geo" B..= geo
193+ , "iso_language_code" B..= iso_language_code
194+ , "to_user_id_str" B..= to_user_id_str
195+ , "source" B..= source
196+ ]
197+
198+ toEncoding Story{..} = B.pairs $
199+ "from_user_id_str" B..= from_user_id_str
200+ <> "profile_image_url" B..= profile_image_url
201+ <> "created_at" B..= created_at
202+ <> "from_user" B..= from_user
203+ <> "id_str" B..= id_str
204+ <> "metadata" B..= metadata
205+ <> "to_user_id" B..= to_user_id
206+ <> "text" B..= text
207+ <> "id" B..= id
208+ <> "from_user_id" B..= from_user_id
209+ <> "geo" B..= geo
210+ <> "iso_language_code" B..= iso_language_code
211+ <> "to_user_id_str" B..= to_user_id_str
212+ <> "source" B..= source
213+
214+instance B.FromJSON Story where
215+ parseJSON (B.Object v) = Story <$>
216+ v B..: "from_user_id_str"
217+ <*> v B..: "profile_image_url"
218+ <*> v B..: "created_at"
219+ <*> v B..: "from_user"
220+ <*> v B..: "id_str"
221+ <*> v B..: "metadata"
222+ <*> v B..: "to_user_id"
223+ <*> v B..: "text"
224+ <*> v B..: "id"
225+ <*> v B..: "from_user_id"
226+ <*> v B..: "geo"
227+ <*> v B..: "iso_language_code"
228+ <*> v B..: "to_user_id_str"
229+ <*> v B..: "source"
230+ parseJSON _ = empty
231+
232+instance B.ToJSON Result where
233+ toJSON Result{..} = B.object [
234+ "results" B..= results
235+ , "max_id" B..= max_id
236+ , "since_id" B..= since_id
237+ , "refresh_url" B..= refresh_url
238+ , "next_page" B..= next_page
239+ , "results_per_page" B..= results_per_page
240+ , "page" B..= page
241+ , "completed_in" B..= completed_in
242+ , "since_id_str" B..= since_id_str
243+ , "max_id_str" B..= max_id_str
244+ , "query" B..= query
245+ ]
246+
247+ toEncoding Result{..} = B.pairs $
248+ "results" B..= results
249+ <> "max_id" B..= max_id
250+ <> "since_id" B..= since_id
251+ <> "refresh_url" B..= refresh_url
252+ <> "next_page" B..= next_page
253+ <> "results_per_page" B..= results_per_page
254+ <> "page" B..= page
255+ <> "completed_in" B..= completed_in
256+ <> "since_id_str" B..= since_id_str
257+ <> "max_id_str" B..= max_id_str
258+ <> "query" B..= query
259+
260+instance B.FromJSON Result where
261+ parseJSON (B.Object v) = Result <$>
262+ v B..: "results"
263+ <*> v B..: "max_id"
264+ <*> v B..: "since_id"
265+ <*> v B..: "refresh_url"
266+ <*> v B..: "next_page"
267+ <*> v B..: "results_per_page"
268+ <*> v B..: "page"
269+ <*> v B..: "completed_in"
270+ <*> v B..: "since_id_str"
271+ <*> v B..: "max_id_str"
272+ <*> v B..: "query"
273+ parseJSON _ = empty
274+#endif
examples/Twitter/TH.hs+14−1
@@ -1,5 +1,6 @@
1-- Use Template Haskell to generate good instances.
1-- Use Template Haskell to generate good instances.
2
2
3+{-# LANGUAGE CPP, PackageImports #-}
3{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE TemplateHaskell #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
5
6
@@ -10,11 +11,23 @@ module Twitter.TH
10 , Story(..)
11 , Story(..)
11 , Result(..)
12 , Result(..)
12 ) where
13 ) where
14+import Twitter
13
15
16+#ifndef HAS_BOTH_AESON_AND_BENCHMARKS
14import Data.Aeson.TH
17import Data.Aeson.TH
15−import Twitter
18+#else
19+import "aeson" Data.Aeson.TH
20+import qualified "aeson-benchmarks" Data.Aeson.TH as B
21+#endif
16
22
17$(deriveJSON defaultOptions ''Metadata)
23$(deriveJSON defaultOptions ''Metadata)
18$(deriveJSON defaultOptions ''Geo)
24$(deriveJSON defaultOptions ''Geo)
19$(deriveJSON defaultOptions ''Story)
25$(deriveJSON defaultOptions ''Story)
20$(deriveJSON defaultOptions ''Result)
26$(deriveJSON defaultOptions ''Result)
27+
28+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
29+$(B.deriveJSON B.defaultOptions ''Metadata)
30+$(B.deriveJSON B.defaultOptions ''Geo)
31+$(B.deriveJSON B.defaultOptions ''Story)
32+$(B.deriveJSON B.defaultOptions ''Result)
33+#endif