Merge pull request #447 from phadej/old-version-bench

Old version bench

.travis.yml

@@ -34,7 +34,7 @@ matrix:
     - env: BUILD=cabal CABALVER=1.24 GHCVER=8.0.1
       compiler: ": #GHC 8.0.1"
       addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
-    - env: BUILD=stack CABALVER=1.22 GHCVER=7.10.3
+    - env: BUILD=stack CABALVER=1.22 GHCVER=7.10.3 STACK_YAML=stack-bench.yaml
       compiler: ": #GHC 7.10.3"
       addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
 

Data/Aeson/Types/ToJSON.hs

@@ -1870,10 +1870,10 @@ instance ToJSON1 Vector where
     {-# INLINE liftToEncoding #-}
 
 instance (ToJSON a) => ToJSON (Vector a) where
-    toJSON = Array . V.map toJSON
+    toJSON = toJSON1
     {-# INLINE toJSON #-}
 
-    toEncoding = encodeVector
+    toEncoding = toEncoding1
     {-# INLINE toEncoding #-}
 
 encodeVector :: (ToJSON a, VG.Vector v a) => v a -> Encoding

benchmarks/AesonFoldable.hs

@@ -1,6 +1,9 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedStrings, PackageImports #-}
 import Criterion.Main
-import Data.Aeson
+
+import qualified "aeson"            Data.Aeson as A
+import qualified "aeson-benchmarks" Data.Aeson as B
+
 import Data.Foldable (toList)
 
 import qualified Data.Sequence as S
@@ -13,19 +16,27 @@ import qualified Data.Vector.Unboxed as U
 
 newtype L f = L { getL :: f Int }
 
-instance Foldable f => ToJSON (L f) where
+instance Foldable f => B.ToJSON (L f) where
     toJSON = error "do not use this"
-    toEncoding = toEncoding . toList . getL
+    toEncoding = B.toEncoding . toList . getL
+
+instance Foldable f => A.ToJSON (L f) where
+    toJSON = error "do not use this"
+    toEncoding = A.toEncoding . toList . getL
 
 -------------------------------------------------------------------------------
 -- Foldable
 -------------------------------------------------------------------------------
 
 newtype F f = F { getF :: f Int }
 
-instance Foldable f => ToJSON (F f) where
+instance Foldable f => B.ToJSON (F f) where
+    toJSON = error "do not use this"
+    toEncoding = B.foldable . getF
+
+instance Foldable f => A.ToJSON (F f) where
     toJSON = error "do not use this"
-    toEncoding = foldable . getF
+    toEncoding = A.foldable . getF
 
 -------------------------------------------------------------------------------
 -- Values
@@ -47,34 +58,52 @@ valueUVector = U.fromList valueList
 -- Main
 -------------------------------------------------------------------------------
 
-benchEncode
-    :: ToJSON a
+benchEncodeA
+    :: A.ToJSON a
+    => String
+    -> a
+    -> Benchmark
+benchEncodeA name val
+    = bench ("A " ++ name) $ nf A.encode val
+
+benchEncodeB
+    :: B.ToJSON a
     => String
     -> a
     -> Benchmark
-benchEncode name val
-    = bench name $ nf encode val
+benchEncodeB name val
+    = bench ("B " ++ name) $ nf B.encode val
 
 main :: IO ()
 main =  defaultMain
     [ bgroup "encode"
         [ bgroup "List"
-            [ benchEncode "-"     valueList
-            , benchEncode "L" $ L valueList
-            , benchEncode "F" $ F valueList
+            [ benchEncodeB "-"     valueList
+            , benchEncodeB "L" $ L valueList
+            , benchEncodeB "F" $ F valueList
+            , benchEncodeA "-"     valueList
+            , benchEncodeA "L" $ L valueList
+            , benchEncodeA "F" $ F valueList
             ]
         , bgroup "Seq"
-            [ benchEncode "-"     valueSeq
-            , benchEncode "L" $ L valueSeq
-            , benchEncode "F" $ F valueSeq
+            [ benchEncodeB "-"     valueSeq
+            , benchEncodeB "L" $ L valueSeq
+            , benchEncodeB "F" $ F valueSeq
+            , benchEncodeA "-"     valueSeq
+            , benchEncodeA "L" $ L valueSeq
+            , benchEncodeA "F" $ F valueSeq
             ]
         , bgroup "Vector"
-            [ benchEncode "-"     valueVector
-            , benchEncode "L" $ L valueVector
-            , benchEncode "F" $ F valueVector
+            [ benchEncodeB "-"     valueVector
+            , benchEncodeB "L" $ L valueVector
+            , benchEncodeB "F" $ F valueVector
+            , benchEncodeA "-"     valueVector
+            , benchEncodeA "L" $ L valueVector
+            , benchEncodeA "F" $ F valueVector
             ]
         , bgroup "Vector.Unboxed"
-            [ benchEncode "-"     valueUVector
+            [ benchEncodeB "-"     valueUVector
+            , benchEncodeA "-"     valueUVector
             ]
         ]
     ]

benchmarks/AesonMap.hs

@@ -1,9 +1,7 @@
-{-# LANGUAGE OverloadedStrings, RankNTypes #-}
+{-# LANGUAGE OverloadedStrings, RankNTypes, PackageImports, FlexibleContexts #-}
 
 import Control.DeepSeq
 import Criterion.Main
-import Data.Aeson
-import Data.Aeson.Types (fromJSONKeyCoerce)
 import Data.Hashable
 import Data.Proxy (Proxy (..))
 import Data.Tagged (Tagged (..))
@@ -12,6 +10,11 @@ import qualified Data.Text as T
 import qualified Data.Map as M
 import qualified Data.HashMap.Strict as HM
 
+import qualified "aeson" Data.Aeson as A
+
+import qualified "aeson-benchmarks" Data.Aeson as B
+import qualified "aeson-benchmarks" Data.Aeson.Types as B (fromJSONKeyCoerce)
+
 value :: Int -> HM.HashMap T.Text T.Text
 value n = HM.fromList $ map f [1..n]
   where
@@ -35,10 +38,11 @@ instance NFData T1 where
     rnf (T1 t) = rnf t
 instance Hashable T1 where
     hashWithSalt salt (T1 t) = hashWithSalt salt t
-instance FromJSON T1 where
-    parseJSON = withText "T1" $ pure . T1
-instance FromJSONKey T1 where
-    fromJSONKey = FromJSONKeyText T1
+
+instance B.FromJSON T1 where
+    parseJSON = B.withText "T1" $ pure . T1
+instance B.FromJSONKey T1 where
+    fromJSONKey = B.FromJSONKeyText T1
 
 -------------------------------------------------------------------------------
 -- Coerce
@@ -51,10 +55,11 @@ instance NFData T2 where
     rnf (T2 t) = rnf t
 instance Hashable T2 where
     hashWithSalt salt (T2 t) = hashWithSalt salt t
-instance FromJSON T2 where
-    parseJSON = withText "T2" $ pure . T2
-instance FromJSONKey T2 where
-    fromJSONKey = fromJSONKeyCoerce
+
+instance B.FromJSON T2 where
+    parseJSON = B.withText "T2" $ pure . T2
+instance B.FromJSONKey T2 where
+    fromJSONKey = B.fromJSONKeyCoerce
 
 -------------------------------------------------------------------------------
 -- TextParser
@@ -67,10 +72,11 @@ instance NFData T3 where
     rnf (T3 t) = rnf t
 instance Hashable T3 where
     hashWithSalt salt (T3 t) = hashWithSalt salt t
-instance FromJSON T3 where
-    parseJSON = withText "T3" $ pure . T3
-instance FromJSONKey T3 where
-    fromJSONKey = FromJSONKeyTextParser (pure . T3)
+
+instance B.FromJSON T3 where
+    parseJSON = B.withText "T3" $ pure . T3
+instance B.FromJSONKey T3 where
+    fromJSONKey = B.FromJSONKeyTextParser (pure . T3)
 
 -------------------------------------------------------------------------------
 -- Values
@@ -83,30 +89,40 @@ value1000 = value 1000
 value10000 = value 10000
 
 encodedValue10 :: LBS.ByteString
-encodedValue10 = encode $ value10
+encodedValue10 = B.encode $ value10
 
 encodedValue100 :: LBS.ByteString
-encodedValue100 = encode $ value100
+encodedValue100 = B.encode $ value100
 
 encodedValue1000 :: LBS.ByteString
-encodedValue1000 = encode $ value1000
+encodedValue1000 = B.encode $ value1000
 
 encodedValue10000 :: LBS.ByteString
-encodedValue10000 = encode $ value10000
+encodedValue10000 = B.encode $ value10000
 
 -------------------------------------------------------------------------------
 -- Helpers
 -------------------------------------------------------------------------------
 
-decodeHM
-    :: (FromJSONKey k, Eq k, Hashable k)
+decodeHMB
+    :: (B.FromJSONKey k, Eq k, Hashable k)
     => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
-decodeHM _ = decode
+decodeHMB _ = B.decode
+
+decodeHMA
+    :: (A.FromJSON (HM.HashMap k T.Text), Eq k, Hashable k)
+    => Proxy k -> LBS.ByteString -> Maybe (HM.HashMap k T.Text)
+decodeHMA _ = A.decode
+
+decodeMapB
+    :: (B.FromJSONKey k, Ord k)
+    => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
+decodeMapB _ = B.decode
 
-decodeMap
-    :: (FromJSONKey k, Ord k)
+decodeMapA
+    :: (A.FromJSON (M.Map k T.Text), Ord k)
     => Proxy k -> LBS.ByteString -> Maybe (M.Map k T.Text)
-decodeMap _ = decode
+decodeMapA _ = A.decode
 
 proxyText :: Proxy T.Text
 proxyText = Proxy
@@ -132,41 +148,45 @@ benchDecodeHM
     -> LBS.ByteString
     -> Benchmark
 benchDecodeHM name val = bgroup name
-    [  bench "Text"            $ nf (decodeHM proxyText) val
-    ,  bench "Identity"        $ nf (decodeHM proxyT1)   val
-    ,  bench "Coerce"          $ nf (decodeHM proxyT2)   val
-    ,  bench "Parser"          $ nf (decodeHM proxyT3)   val
-    ,  bench "Tagged Text"     $ nf (decodeHM $ proxyTagged proxyText) val
-    ,  bench "Tagged Identity" $ nf (decodeHM $ proxyTagged proxyT1)   val
-    ,  bench "Tagged Coerce"   $ nf (decodeHM $ proxyTagged proxyT2)   val
-    ,  bench "Tagged Parser"   $ nf (decodeHM $ proxyTagged proxyT3)   val
+    [  bench "Text"            $ nf (decodeHMB proxyText) val
+    ,  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 "Tagged Text"     $ nf (decodeHMB $ proxyTagged proxyText) val
+    ,  bench "Tagged Identity" $ nf (decodeHMB $ proxyTagged proxyT1)   val
+    ,  bench "Tagged Coerce"   $ nf (decodeHMB $ proxyTagged proxyT2)   val
+    ,  bench "Tagged Parser"   $ nf (decodeHMB $ proxyTagged proxyT3)   val
     ]
 
 benchDecodeMap
     :: String
     -> LBS.ByteString
     -> Benchmark
 benchDecodeMap name val = bgroup name
-    [  bench "Text"     $ nf (decodeMap proxyText) val
-    ,  bench "Identity" $ nf (decodeMap proxyT1)   val
-    ,  bench "Coerce"   $ nf (decodeMap proxyT2)   val
-    ,  bench "Parser"   $ nf (decodeMap proxyT3)   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-0.11"  $ nf (decodeMapA proxyText) val
     ]
 
 benchEncodeHM
     :: String
     -> HM.HashMap T.Text T.Text
     -> Benchmark
 benchEncodeHM name val = bgroup name
-    [ bench "Text" $ nf encode val
+    [ bench "Text"       $ nf B.encode val
+    , bench "aeson-0.11" $ nf A.encode val
     ]
 
 benchEncodeMap
     :: String
     -> HM.HashMap T.Text T.Text
     -> Benchmark
 benchEncodeMap name val = bgroup name
-    [ bench "Text" $ nf encode val'
+    [ bench "Text"       $ nf B.encode val'
+    , bench "aeson-0.11" $ nf A.encode val'
     ]
   where
     val' :: M.Map T.Text T.Text

benchmarks/aeson-benchmarks.cabal

@@ -180,6 +180,7 @@ executable aeson-benchmark-map
   main-is: AesonMap.hs
   ghc-options: -Wall -O2 -rtsopts
   build-depends:
+    aeson == 0.11.*,
     aeson-benchmarks,
     base,
     criterion >= 1.0,
@@ -195,6 +196,7 @@ executable aeson-benchmark-foldable
   main-is: AesonFoldable.hs
   ghc-options: -Wall -O2 -rtsopts
   build-depends:
+    aeson,
     aeson-benchmarks,
     base,
     criterion >= 1.0,

stack-bench.yaml

@@ -0,0 +1,8 @@
+resolver: lts-6.5
+packages:
+- benchmarks
+extra-deps:
+- semigroups-0.18.2
+flags:
+  semigroups:
+    bytestring-builder: false