From 054a5c2367b38ee48eb24d578b527657d5256c2c Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jul 2016 17:22:07 +0300 Subject: [PATCH 1/4] Run vector benchmarks with released aeson --- Data/Aeson/Types/ToJSON.hs | 4 +- benchmarks/AesonFoldable.hs | 69 ++++++++++++++++++++++--------- benchmarks/AesonMap.hs | 6 +-- benchmarks/aeson-benchmarks.cabal | 2 + 4 files changed, 56 insertions(+), 25 deletions(-) diff --git a/Data/Aeson/Types/ToJSON.hs b/Data/Aeson/Types/ToJSON.hs index 6cf163da7..20ec31009 100644 --- a/Data/Aeson/Types/ToJSON.hs +++ b/Data/Aeson/Types/ToJSON.hs @@ -1808,10 +1808,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 diff --git a/benchmarks/AesonFoldable.hs b/benchmarks/AesonFoldable.hs index 6bba6a575..8294b41fc 100644 --- a/benchmarks/AesonFoldable.hs +++ b/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,9 +16,13 @@ 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 @@ -23,9 +30,13 @@ instance Foldable f => ToJSON (L f) where 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 ] ] ] diff --git a/benchmarks/AesonMap.hs b/benchmarks/AesonMap.hs index 3800daae3..2d70282c9 100644 --- a/benchmarks/AesonMap.hs +++ b/benchmarks/AesonMap.hs @@ -1,9 +1,9 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, PackageImports #-} import Control.DeepSeq import Criterion.Main -import Data.Aeson -import Data.Aeson.Types (fromJSONKeyCoerce) +import "aeson-benchmarks" Data.Aeson +import "aeson-benchmarks" Data.Aeson.Types (fromJSONKeyCoerce) import Data.Hashable import Data.Proxy (Proxy (..)) import Data.Tagged (Tagged (..)) diff --git a/benchmarks/aeson-benchmarks.cabal b/benchmarks/aeson-benchmarks.cabal index 84f2b103d..697fc2a6e 100644 --- a/benchmarks/aeson-benchmarks.cabal +++ b/benchmarks/aeson-benchmarks.cabal @@ -180,6 +180,7 @@ executable aeson-benchmark-map main-is: AesonMap.hs ghc-options: -Wall -O2 -rtsopts build-depends: + aeson, 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, From c385f29478c236e842135be2199ea4b142e587d2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jul 2016 17:39:32 +0300 Subject: [PATCH 2/4] Add bench stack.yaml --- stack-bench.yaml | 8 ++++++++ 1 file changed, 8 insertions(+) create mode 100644 stack-bench.yaml diff --git a/stack-bench.yaml b/stack-bench.yaml new file mode 100644 index 000000000..3a96f94fd --- /dev/null +++ b/stack-bench.yaml @@ -0,0 +1,8 @@ +resolver: lts-6.5 +packages: +- benchmarks +extra-deps: +- semigroups-0.18.2 +flags: + semigroups: + bytestring-builder: false From af4bc018239bf5d0759135b73efb4ea5ae7c9b2f Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 8 Jul 2016 17:39:53 +0300 Subject: [PATCH 3/4] Run map benchmarks with released aeson --- benchmarks/AesonMap.hs | 98 +++++++++++++++++++------------ benchmarks/aeson-benchmarks.cabal | 2 +- 2 files changed, 60 insertions(+), 40 deletions(-) diff --git a/benchmarks/AesonMap.hs b/benchmarks/AesonMap.hs index 2d70282c9..4780d7164 100644 --- a/benchmarks/AesonMap.hs +++ b/benchmarks/AesonMap.hs @@ -1,9 +1,7 @@ -{-# LANGUAGE OverloadedStrings, RankNTypes, PackageImports #-} +{-# LANGUAGE OverloadedStrings, RankNTypes, PackageImports, FlexibleContexts #-} import Control.DeepSeq import Criterion.Main -import "aeson-benchmarks" Data.Aeson -import "aeson-benchmarks" 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,14 +148,15 @@ 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 @@ -147,10 +164,11 @@ benchDecodeMap -> 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 @@ -158,7 +176,8 @@ benchEncodeHM -> 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 @@ -166,7 +185,8 @@ benchEncodeMap -> 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 diff --git a/benchmarks/aeson-benchmarks.cabal b/benchmarks/aeson-benchmarks.cabal index 697fc2a6e..f739aa9aa 100644 --- a/benchmarks/aeson-benchmarks.cabal +++ b/benchmarks/aeson-benchmarks.cabal @@ -180,7 +180,7 @@ executable aeson-benchmark-map main-is: AesonMap.hs ghc-options: -Wall -O2 -rtsopts build-depends: - aeson, + aeson == 0.11.*, aeson-benchmarks, base, criterion >= 1.0, From 763b6914b6ee482dae132e31629b4ff5f2f6cdc2 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Sun, 10 Jul 2016 22:43:05 +0300 Subject: [PATCH 4/4] Use stack-bench.yaml in stack-travis-job --- .travis.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index aaea8df73..71cde3fa9 100644 --- a/.travis.yml +++ b/.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]}}