Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Old version bench #447

Merged
merged 4 commits into from
Jul 13, 2016
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion .travis.yml
Original file line number Diff line number Diff line change
Expand Up @@ -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]}}

Expand Down
4 changes: 2 additions & 2 deletions Data/Aeson/Types/ToJSON.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
69 changes: 49 additions & 20 deletions benchmarks/AesonFoldable.hs
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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
Expand All @@ -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
]
]
]
98 changes: 59 additions & 39 deletions benchmarks/AesonMap.hs
Original file line number Diff line number Diff line change
@@ -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 (..))
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand All @@ -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
Expand Down
2 changes: 2 additions & 0 deletions benchmarks/aeson-benchmarks.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand All @@ -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,
Expand Down
8 changes: 8 additions & 0 deletions stack-bench.yaml
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
resolver: lts-6.5
packages:
- benchmarks
extra-deps:
- semigroups-0.18.2
flags:
semigroups:
bytestring-builder: false