Merge pull request #563 from phadej/benchmarks-fix-562

Benchmarks fix #562

Author: bergmark

.gitignore

@@ -4,6 +4,7 @@ dist-newstyle
 .cabal-sandbox/
 cabal.sandbox.config
 .stack-work/
+.stack-work-bench/
 
 *.o
 *.hi

benchmarks/AesonMap.hs

@@ -160,7 +160,7 @@ benchDecodeHM name val = bgroup name
     ,  bench "Identity"        $ nf (decodeHMB proxyT1)   val
     ,  bench "Coerce"          $ nf (decodeHMB proxyT2)   val
     ,  bench "Parser"          $ nf (decodeHMB proxyT3)   val
-    ,  bench "aeson-0.11"      $ nf (decodeHMA proxyText) val
+    ,  bench "aeson-hackage"   $ nf (decodeHMA proxyText) val
     ,  bench "Tagged Text"     $ nf (decodeHMB $ proxyTagged proxyText) val
     ,  bench "Tagged Identity" $ nf (decodeHMB $ proxyTagged proxyT1)   val
     ,  bench "Tagged Coerce"   $ nf (decodeHMB $ proxyTagged proxyT2)   val
@@ -172,11 +172,11 @@ benchDecodeMap
     -> LBS.ByteString
     -> Benchmark
 benchDecodeMap name val = bgroup name
-    [  bench "Text"        $ nf (decodeMapB proxyText) val
-    ,  bench "Identity"    $ nf (decodeMapB proxyT1)   val
-    ,  bench "Coerce"      $ nf (decodeMapB proxyT2)   val
-    ,  bench "Parser"      $ nf (decodeMapB proxyT3)   val
-    ,  bench "aeson-0.11"  $ nf (decodeMapA proxyText) val
+    [  bench "Text"           $ nf (decodeMapB proxyText) val
+    ,  bench "Identity"       $ nf (decodeMapB proxyT1)   val
+    ,  bench "Coerce"         $ nf (decodeMapB proxyT2)   val
+    ,  bench "Parser"         $ nf (decodeMapB proxyT3)   val
+    ,  bench "aeson-hackage"  $ nf (decodeMapA proxyText) val
     ]
 
 benchEncodeHM

benchmarks/CompareWithJSON.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PackageImports #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
 module Main (main) where
@@ -10,8 +11,11 @@ import Blaze.ByteString.Builder.Char.Utf8 (fromString)
 import Control.DeepSeq (NFData(rnf))
 import Criterion.Main
 import Data.Maybe (fromMaybe)
-import qualified Data.Aeson as A
-import qualified Data.Aeson.Text as A
+import qualified "aeson-benchmarks" Data.Aeson as A
+import qualified "aeson-benchmarks" Data.Aeson.Text as A
+import qualified "aeson-benchmarks" Data.Aeson.Parser.Internal as I
+import qualified "aeson" Data.Aeson as B
+import qualified Data.ByteString as BS
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.Text.Lazy          as TL
 import qualified Data.Text.Lazy.Builder  as TLB
@@ -41,6 +45,19 @@ decodeA s = fromMaybe (error "fail to parse via Aeson") $ A.decode s
 decodeA' :: BL.ByteString -> A.Value
 decodeA' s = fromMaybe (error "fail to parse via Aeson") $ A.decode' s
 
+decodeAS :: BS.ByteString -> A.Value
+decodeAS s = fromMaybe (error "fail to parse via Aeson") $ A.decodeStrict' s
+
+decodeB :: BL.ByteString -> B.Value
+decodeB s = fromMaybe (error "fail to parse via Aeson") $ B.decode s
+
+decodeBS :: BS.ByteString -> B.Value
+decodeBS s = fromMaybe (error "fail to parse via Aeson") $ B.decodeStrict' s
+
+decodeIP :: BL.ByteString -> A.Value
+decodeIP s = fromMaybe (error "fail to parse via Parser.decodeWith") $
+    I.decodeWith I.jsonEOF A.fromJSON s
+
 encodeJ :: J.JSValue -> BL.ByteString
 encodeJ = toLazyByteString . fromString . J.encode
 
@@ -55,19 +72,27 @@ main = do
   let enFile = "json-data/twitter100.json"
       jpFile = "json-data/jp100.json"
   enA <- BL.readFile enFile
+  enS <- BS.readFile enFile
   enJ <- readFile enFile
   jpA <- BL.readFile jpFile
+  jpS <- BS.readFile jpFile
   jpJ <- readFile jpFile
   defaultMain [
       bgroup "decode" [
         bgroup "en" [
-          bench "aeson/lazy" $ nf decodeA enA
-        , bench "aeson/strict" $ nf decodeA' enA
-        , bench "json"  $ nf decodeJ enJ
+          bench "aeson/lazy"     $ nf decodeA enA
+        , bench "aeson/strict"   $ nf decodeA' enA
+        , bench "aeson/stricter" $ nf decodeAS enS
+        , bench "aeson/hackage"  $ nf decodeB enA
+        , bench "aeson/hackage'" $ nf decodeBS enS
+        , bench "aeson/parser"   $ nf decodeIP enA
+        , bench "json"           $ nf decodeJ enJ
         ]
       , bgroup "jp" [
-          bench "aeson" $ nf decodeA jpA
-        , bench "json"  $ nf decodeJ jpJ
+          bench "aeson"          $ nf decodeA jpA
+        , bench "aeson/stricter" $ nf decodeAS jpS
+        , bench "aeson/hackage"  $ nf decodeB jpA
+        , bench "json"           $ nf decodeJ jpJ
         ]
       ]
     , bgroup "encode" [

benchmarks/Dates.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fsimpl-tick-factor=0 #-}
 module Main (main) where
 
 import Prelude ()

benchmarks/Typed.hs

@@ -13,4 +13,7 @@ main = defaultMain [
     Generic.benchmarks
   , Manual.benchmarks
   , TH.benchmarks
+  , Generic.decodeBenchmarks
+  , Manual.decodeBenchmarks
+  , TH.decodeBenchmarks
   ]

benchmarks/Typed/Generic.hs

@@ -1,13 +1,13 @@
 {-# LANGUAGE PackageImports #-}
-module Typed.Generic (benchmarks) where
+module Typed.Generic (benchmarks, decodeBenchmarks) where
 
 import Prelude ()
 import Prelude.Compat
 
 import "aeson" Data.Aeson hiding (Result)
 import Criterion
 import Data.ByteString.Lazy as L
-import Twitter.TH
+import Twitter.Generic
 import Typed.Common
 import qualified "aeson-benchmarks" Data.Aeson as B
 
@@ -26,7 +26,7 @@ encodeViaValueB = B.encode . B.toJSON
 benchmarks :: Benchmark
 benchmarks =
   env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
-  bgroup "generic" [
+  bgroup "encodeGeneric" [
       bgroup "direct" [
         bench "twitter100"          $ nf encodeDirectB twitter100
       , bench "jp100"               $ nf encodeDirectB jp100
@@ -40,3 +40,21 @@ benchmarks =
       , bench "jp100 baseline"      $ nf encodeViaValueA jp100
       ]
     ]
+
+decodeDirectA :: L.ByteString -> Maybe Result
+decodeDirectA = decode
+
+decodeDirectB :: L.ByteString -> Maybe Result
+decodeDirectB = B.decode
+
+decodeBenchmarks :: Benchmark
+decodeBenchmarks =
+  env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
+  bgroup "decodeGeneric"
+    [ bgroup "direct"
+      [ bench "twitter100"          $ nf decodeDirectB twitter100
+      , bench "jp100"               $ nf decodeDirectB jp100
+      , bench "twitter100 baseline" $ nf decodeDirectA twitter100
+      , bench "jp100 baseline"      $ nf decodeDirectA jp100
+      ]
+    ]

benchmarks/Typed/Manual.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE PackageImports #-}
-module Typed.Manual (benchmarks) where
+module Typed.Manual (benchmarks, decodeBenchmarks) where
 
 import Prelude ()
 import Prelude.Compat
@@ -26,7 +26,7 @@ encodeViaValueB = B.encode . B.toJSON
 benchmarks :: Benchmark
 benchmarks =
   env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
-  bgroup "manual" [
+  bgroup "encodeManual" [
       bgroup "direct" [
         bench "twitter100"          $ nf encodeDirectB twitter100
       , bench "jp100"               $ nf encodeDirectB jp100
@@ -40,3 +40,21 @@ benchmarks =
       , bench "jp100 baseline"      $ nf encodeViaValueA jp100
       ]
     ]
+
+decodeDirectA :: L.ByteString -> Maybe Result
+decodeDirectA = decode
+
+decodeDirectB :: L.ByteString -> Maybe Result
+decodeDirectB = B.decode
+
+decodeBenchmarks :: Benchmark
+decodeBenchmarks =
+  env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
+  bgroup "decodeManual"
+    [ bgroup "direct"
+      [ bench "twitter100"          $ nf decodeDirectB twitter100
+      , bench "jp100"               $ nf decodeDirectB jp100
+      , bench "twitter100 baseline"  $ nf decodeDirectA twitter100
+      , bench "jp100 baseline"      $ nf decodeDirectA jp100
+      ]
+    ]

benchmarks/Typed/TH.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE PackageImports #-}
-module Typed.TH (benchmarks) where
+module Typed.TH (benchmarks, decodeBenchmarks) where
 
 import Prelude ()
 import Prelude.Compat
@@ -26,7 +26,7 @@ encodeViaValueB = B.encode . B.toJSON
 benchmarks :: Benchmark
 benchmarks =
   env ((,) <$> load "json-data/twitter100.json" <*> load "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
-  bgroup "th" [
+  bgroup "encodeTH" [
       bgroup "direct" [
         bench "twitter100"          $ nf encodeDirectB twitter100
       , bench "jp100"               $ nf encodeDirectB jp100
@@ -40,3 +40,21 @@ benchmarks =
       , bench "jp100 baseline"      $ nf encodeViaValueB jp100
       ]
     ]
+
+decodeDirectA :: L.ByteString -> Maybe Result
+decodeDirectA = decode
+
+decodeDirectB :: L.ByteString -> Maybe Result
+decodeDirectB = B.decode
+
+decodeBenchmarks :: Benchmark
+decodeBenchmarks =
+  env ((,) <$> L.readFile "json-data/twitter100.json" <*> L.readFile "json-data/jp100.json") $ \ ~(twitter100, jp100) ->
+  bgroup "decodeTH"
+    [ bgroup "direct"
+      [ bench "twitter100"          $ nf decodeDirectB twitter100
+      , bench "jp100"               $ nf decodeDirectB jp100
+      , bench "twitter100 baseline"  $ nf decodeDirectA twitter100
+      , bench "jp100 baseline"      $ nf decodeDirectA jp100
+      ]
+    ]

benchmarks/aeson-benchmarks.cabal

@@ -83,6 +83,13 @@ executable aeson-benchmark-compare
   main-is: Compare.hs
   hs-source-dirs: ../examples .
   ghc-options: -Wall -O2 -rtsopts
+  other-modules:
+    Compare.BufferBuilder
+    Compare.JsonBench
+    Compare.JsonBuilder
+    Twitter
+    Twitter.Manual
+    Typed.Common
   build-depends:
     aeson-benchmarks,
     base,
@@ -116,6 +123,16 @@ executable aeson-benchmark-typed
   -- We must help ourself in situations when there is both
   -- aeson and aeson-benchmakrs
   cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS
+  other-modules:
+    Twitter
+    Twitter.Generic
+    Twitter.Manual
+    Twitter.Options
+    Twitter.TH
+    Typed.Common
+    Typed.Generic
+    Typed.Manual
+    Typed.TH
   build-depends:
     aeson,
     aeson-benchmarks,
@@ -136,7 +153,9 @@ executable aeson-benchmark-typed
 executable aeson-benchmark-compare-with-json
   main-is: CompareWithJSON.hs
   ghc-options: -Wall -O2 -rtsopts
+  cpp-options: -DHAS_BOTH_AESON_AND_BENCHMARKS
   build-depends:
+    aeson,
     aeson-benchmarks,
     base,
     base-compat,

examples/Twitter/Generic.hs

@@ -1,7 +1,12 @@
 -- Use GHC generics to automatically generate good instances.
+
 {-# LANGUAGE CPP #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
+#ifdef HAS_BOTH_AESON_AND_BENCHMARKS
+{-# LANGUAGE PackageImports #-}
+#endif
+
 module Twitter.Generic
     (
       Metadata(..)
@@ -11,39 +16,64 @@ module Twitter.Generic
     ) where
 
 import Prelude ()
-import Prelude.Compat
+import Prelude.Compat ()
 
 import Twitter
+import Twitter.Options
 
 #ifndef HAS_BOTH_AESON_AND_BENCHMARKS
-import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)
 #else
-import "aeson" Data.Aeson (ToJSON, FromJSON)
+import "aeson" Data.Aeson (ToJSON (..), FromJSON (..), genericToJSON, genericToEncoding, genericParseJSON)
 import qualified "aeson-benchmarks" Data.Aeson as B
 #endif
 
-instance ToJSON Metadata
-instance FromJSON Metadata
+instance ToJSON Metadata where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Metadata where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Geo
-instance FromJSON Geo
+instance ToJSON Geo where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Geo where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Story
-instance FromJSON Story
+instance ToJSON Story where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Story where
+    parseJSON = genericParseJSON twitterOptions
 
-instance ToJSON Result
-instance FromJSON Result
+instance ToJSON Result where
+    toJSON = genericToJSON twitterOptions
+    toEncoding = genericToEncoding twitterOptions
+instance FromJSON Result where
+    parseJSON = genericParseJSON twitterOptions
 
 #ifdef HAS_BOTH_AESON_AND_BENCHMARKS
-instance B.ToJSON Metadata
-instance B.FromJSON Metadata
+instance B.ToJSON Metadata where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Metadata where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Geo
-instance B.FromJSON Geo
+instance B.ToJSON Geo where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Geo where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Story
-instance B.FromJSON Story
+instance B.ToJSON Story where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Story where
+    parseJSON = B.genericParseJSON btwitterOptions
 
-instance B.ToJSON Result
-instance B.FromJSON Result
+instance B.ToJSON Result where
+    toJSON = B.genericToJSON btwitterOptions
+    toEncoding = B.genericToEncoding btwitterOptions
+instance B.FromJSON Result where
+    parseJSON = B.genericParseJSON btwitterOptions
 #endif