diff --git a/.github/workflows/haskell-ci.yaml b/.github/workflows/haskell-ci.yaml index 47b6ecdd..a594b6f9 100644 --- a/.github/workflows/haskell-ci.yaml +++ b/.github/workflows/haskell-ci.yaml @@ -34,10 +34,16 @@ jobs: run: cabal build --enable-tests - name: Test run: cabal test --enable-tests - # benchmarks currently don't compile for GHC 9.14 - # - name: Build benchmarks - # run: cabal build --enable-benchmarks - # - name: Bench - # run: cabal bench --enable-benchmarks + - name: Build benchmarks + run: cabal build --enable-benchmarks + - name: Bench + run: | + cabal run bench:throughput + cabal run bench:get + cabal run bench:put + cabal run bench:generics-bench + cabal run bench:builder + env: + TASTY_TIMEOUT: 100 - name: Haddock run: cabal haddock diff --git a/benchmarks/Benchmark.hs b/benchmarks/Benchmark.hs index a58bb192..dfaa27ff 100644 --- a/benchmarks/Benchmark.hs +++ b/benchmarks/Benchmark.hs @@ -26,11 +26,11 @@ main = do mb <- case args of (arg:_) -> readIO arg _ -> return 100 - memBench (mb*10) + memBench (mb*10) putStrLn "" putStrLn "Binary (de)serialisation benchmarks:" - -- do bytewise + -- do bytewise sequence_ [ test wordSize chunkSize Host mb | wordSize <- [1] diff --git a/benchmarks/Builder.hs b/benchmarks/Builder.hs index ade395e3..8466d290 100644 --- a/benchmarks/Builder.hs +++ b/benchmarks/Builder.hs @@ -12,12 +12,12 @@ import Data.Monoid (Monoid(mappend, mempty)) import Control.DeepSeq import Control.Exception (evaluate) -import Criterion.Main import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as L import Data.Char (ord) import Data.Word (Word8) +import Test.Tasty.Bench import Data.Binary.Builder diff --git a/benchmarks/GenericsBench.hs b/benchmarks/GenericsBench.hs index e70ac250..50ace4fe 100644 --- a/benchmarks/GenericsBench.hs +++ b/benchmarks/GenericsBench.hs @@ -4,7 +4,7 @@ module Main where import qualified Data.ByteString.Lazy as L import Cabal24 (PackageDescription) -import Criterion.Main +import Test.Tasty.Bench import qualified Data.Binary as Binary import Data.Binary.Get (Get) diff --git a/benchmarks/Get.hs b/benchmarks/Get.hs index 85bb55b9..2ee5d210 100644 --- a/benchmarks/Get.hs +++ b/benchmarks/Get.hs @@ -1,20 +1,13 @@ -{-# LANGUAGE CPP, OverloadedStrings, ExistentialQuantification, BangPatterns #-} - -#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__) -#include "MachDeps.h" -#endif - -module Main where +{-# LANGUAGE OverloadedStrings, BangPatterns #-} import Control.DeepSeq import Control.Exception (evaluate) -import Criterion.Main import qualified Data.ByteString as S -import qualified Data.ByteString.Char8 as C8 import qualified Data.ByteString.Lazy as L import Data.Bits import Data.Char (ord) import Data.List (foldl') +import Test.Tasty.Bench import Control.Applicative import Data.Binary @@ -25,12 +18,6 @@ import qualified Data.Serialize.Get as Cereal import qualified Data.Attoparsec.ByteString as A import qualified Data.Attoparsec.ByteString.Lazy as AL -#if !MIN_VERSION_bytestring(0,10,0) -instance NFData S.ByteString -instance NFData L.ByteString where - rnf = rnf . L.toChunks -#endif - main :: IO () main = do evaluate $ rnf [ @@ -45,23 +32,27 @@ main = do defaultMain [ bgroup "brackets" [ bench "Binary 100kb, one chunk" $ - whnf (checkBracket . runTest bracketParser) brackets + whnf (checkBracket . runGet bracketParser) brackets , bench "Binary 100kb, 100 byte chunks" $ - whnf (checkBracket . runTest bracketParser) bracketsInChunks + whnf (checkBracket . runGet bracketParser) bracketsInChunks , bench "Attoparsec lazy-bs 100kb, one chunk" $ whnf (checkBracket . runAttoL bracketParser_atto) brackets , bench "Attoparsec lazy-bs 100kb, 100 byte chunks" $ whnf (checkBracket . runAttoL bracketParser_atto) bracketsInChunks , bench "Attoparsec strict-bs 100kb" $ - whnf (checkBracket . runAtto bracketParser_atto) $ S.concat (L.toChunks brackets) + whnf (checkBracket . runAtto bracketParser_atto) $ L.toStrict brackets + , bench "Cereal lazy-bs 100kb, one chunk" $ + whnf (checkBracket . runCerealL bracketParser_cereal) brackets + , bench "Cereal lazy-bs 100kb, 100 byte chunks" $ + whnf (checkBracket . runCerealL bracketParser_cereal) bracketsInChunks , bench "Cereal strict-bs 100kb" $ - whnf (checkBracket . runCereal bracketParser_cereal) $ S.concat (L.toChunks brackets) + whnf (checkBracket . runCereal bracketParser_cereal) $ L.toStrict brackets ] , bgroup "comparison getStruct4, 1MB of struct of 4 Word8s" [ bench "Attoparsec" $ whnf (runAtto (getStruct4_atto mega)) oneMegabyte , bench "Binary" $ - whnf (runTest (getStruct4 mega)) oneMegabyteLBS + whnf (runGet (getStruct4 mega)) oneMegabyteLBS , bench "Cereal" $ whnf (runCereal (getStruct4_cereal mega)) oneMegabyte ] @@ -69,29 +60,29 @@ main = do [ bench "Attoparsec" $ whnf (runAtto (getWord8N1_atto mega)) oneMegabyte , bench "Binary" $ - whnf (runTest (getWord8N1 mega)) oneMegabyteLBS + whnf (runGet (getWord8N1 mega)) oneMegabyteLBS , bench "Cereal" $ whnf (runCereal (getWord8N1_cereal mega)) oneMegabyte ] , bgroup "getWord8 1MB" [ bench "chunk size 2 bytes" $ - whnf (runTest (getWord8N2 mega)) oneMegabyteLBS + whnf (runGet (getWord8N2 mega)) oneMegabyteLBS , bench "chunk size 4 bytes" $ - whnf (runTest (getWord8N4 mega)) oneMegabyteLBS + whnf (runGet (getWord8N4 mega)) oneMegabyteLBS , bench "chunk size 8 bytes" $ - whnf (runTest (getWord8N8 mega)) oneMegabyteLBS + whnf (runGet (getWord8N8 mega)) oneMegabyteLBS , bench "chunk size 16 bytes" $ - whnf (runTest (getWord8N16 mega)) oneMegabyteLBS + whnf (runGet (getWord8N16 mega)) oneMegabyteLBS ] , bgroup "getWord8 1MB Applicative" [ bench "chunk size 2 bytes" $ - whnf (runTest (getWord8N2A mega)) oneMegabyteLBS + whnf (runGet (getWord8N2A mega)) oneMegabyteLBS , bench "chunk size 4 bytes" $ - whnf (runTest (getWord8N4A mega)) oneMegabyteLBS + whnf (runGet (getWord8N4A mega)) oneMegabyteLBS , bench "chunk size 8 bytes" $ - whnf (runTest (getWord8N8A mega)) oneMegabyteLBS + whnf (runGet (getWord8N8A mega)) oneMegabyteLBS , bench "chunk size 16 bytes" $ - whnf (runTest (getWord8N16A mega)) oneMegabyteLBS + whnf (runGet (getWord8N16A mega)) oneMegabyteLBS ] , bgroup "roll" [ bench "foldr" $ nf (roll_foldr :: [Word8] -> Integer) manyBytes @@ -106,23 +97,25 @@ checkBracket :: Int -> Int checkBracket x | x == bracketCount = x | otherwise = error "argh!" -runTest :: Get a -> L.ByteString -> a -runTest decoder inp = runGet decoder inp - -runCereal :: Cereal.Get a -> C8.ByteString -> a +runCereal :: Cereal.Get a -> S.ByteString -> a runCereal decoder inp = case Cereal.runGet decoder inp of Right a -> a Left err -> error err -runAtto :: AL.Parser a -> C8.ByteString -> a +runCerealL :: Cereal.Get a -> L.ByteString -> a +runCerealL decoder inp = case Cereal.runGetLazy decoder inp of + Right a -> a + Left err -> error err + +runAtto :: AL.Parser a -> S.ByteString -> a runAtto decoder inp = case A.parseOnly decoder inp of Right a -> a Left err -> error err -runAttoL :: Show a => AL.Parser a -> L.ByteString -> a -runAttoL decoder inp = case AL.parse decoder inp of - AL.Done _ r -> r - a -> error (show a) +runAttoL :: AL.Parser a -> L.ByteString -> a +runAttoL decoder inp = case AL.parseOnly decoder inp of + Right a -> a + Left err -> error err -- Defs. @@ -135,15 +128,11 @@ oneMegabyteLBS = L.fromChunks [oneMegabyte] mega :: Int mega = 1024 * 1024 --- 100k of brackets -bracketTest :: L.ByteString -> Int -bracketTest inp = runTest bracketParser inp - bracketCount :: Int bracketCount = fromIntegral $ L.length brackets `div` 2 brackets :: L.ByteString -brackets = L.fromChunks [C8.concat (L.toChunks bracketsInChunks)] +brackets = L.fromChunks [L.toStrict bracketsInChunks] bracketsInChunks :: L.ByteString bracketsInChunks = L.fromChunks (replicate chunksOfBrackets oneChunk) @@ -154,31 +143,36 @@ bracketsInChunks = L.fromChunks (replicate chunksOfBrackets oneChunk) bracketParser :: Get Int bracketParser = cont <|> return 0 where - cont = do v <- some ( do 40 <- getWord8 - n <- many cont - 41 <- getWord8 - return $! sum n + 1) - return $! sum v + cont = do + v <- some $ do + 40 <- getWord8 -- '(' + n <- many cont + 41 <- getWord8 -- ')' + return $! sum n + 1 + return $! sum v bracketParser_cereal :: Cereal.Get Int bracketParser_cereal = cont <|> return 0 where - cont = do v <- some ( do 40 <- Cereal.getWord8 - n <- many cont - 41 <- Cereal.getWord8 - return $! sum n + 1) - return $! sum v + cont = do + v <- some $ do + 40 <- Cereal.getWord8 -- '(' + n <- many cont + 41 <- Cereal.getWord8 -- ')' + return $! sum n + 1 + return $! sum v bracketParser_atto :: A.Parser Int bracketParser_atto = cont <|> return 0 where - cont = do v <- some ( do _ <- A.word8 40 - n <- bracketParser_atto - _ <- A.word8 41 - return $! n + 1) - return $! sum v + cont = do + v <- some $ do + _ <- A.word8 40 -- '(' + n <- A.many' cont + _ <- A.word8 41 -- ')' + return $! sum n + 1 + return $! sum v --- Strict struct of 4 Word8s data S2 = S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 data S4 = S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 data S8 = S8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 diff --git a/benchmarks/Put.hs b/benchmarks/Put.hs index fe233868..4ba33669 100644 --- a/benchmarks/Put.hs +++ b/benchmarks/Put.hs @@ -1,15 +1,12 @@ -{-# LANGUAGE CPP, ExistentialQuantification #-} {-# LANGUAGE DeriveGeneric #-} -module Main (main) where - import Control.DeepSeq import Control.Exception (evaluate) -import Criterion.Main import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Lazy as L import Data.Monoid +import Test.Tasty.Bench import GHC.Generics @@ -32,39 +29,38 @@ main = do , rnf word64s ] defaultMain - [ - bench "small Integers" $ whnf (run . fromIntegers) smallIntegers, - bench "big Integers" $ whnf (run . fromIntegers) bigIntegers, - - bench "[small Integer]" $ whnf (run . put) smallIntegers, - bench "[big Integer]" $ whnf (run . put) bigIntegers, - - bench "small ByteStrings" $ whnf (run . fromByteStrings) smallByteStrings, - bench "[small ByteString]" $ whnf (run . put) smallByteStrings, - - bench "small Strings" $ whnf (run . fromStrings) smallStrings, - bench "[small String]" $ whnf (run . put) smallStrings, - - bench "Double" $ whnf (run . put) doubles, - - bench "Word8s monoid put" $ whnf (run . fromWord8s) word8s, - bench "Word8s builder" $ whnf (L.length . toLazyByteString . fromWord8sBuilder) word8s, - bench "[Word8]" $ whnf (run . put) word8s, - bench "Word16s monoid put" $ whnf (run . fromWord16s) word16s, - bench "Word16s builder" $ whnf (L.length . toLazyByteString . fromWord16sBuilder) word16s, - bench "[Word16]" $ whnf (run . put) word16s, - bench "Word32s monoid put" $ whnf (run . fromWord32s) word32s, - bench "Word32s builder" $ whnf (L.length . toLazyByteString . fromWord32sBuilder) word32s, - bench "[Word32]" $ whnf (run . put) word32s, - bench "Word64s monoid put" $ whnf (run . fromWord64s) word64s, - bench "Word64s builder" $ whnf (L.length . toLazyByteString . fromWord64sBuilder) word64s, - bench "[Word64]" $ whnf (run . put) word64s - - , bgroup "Generics" [ - bench "Struct monoid put" $ whnf (run . fromStructs) structs, - bench "Struct put as list" $ whnf (run . put) structs, - bench "StructList monoid put" $ whnf (run . fromStructLists) structLists, - bench "StructList put as list" $ whnf (run . put) structLists + [ bench "small Integers" $ whnf (run . foldMap put) smallIntegers + , bench "[small Integer]" $ whnf (run . put) smallIntegers + + , bench "big Integers" $ whnf (run . foldMap put) bigIntegers + , bench "[big Integer]" $ whnf (run . put) bigIntegers + + , bench "small ByteStrings" $ whnf (run . foldMap put) smallByteStrings + , bench "[small ByteString]" $ whnf (run . put) smallByteStrings + + , bench "small Strings" $ whnf (run . foldMap put) smallStrings + , bench "[small String]" $ whnf (run . put) smallStrings + + , bench "Double" $ whnf (run . put) doubles + + , bench "Word8s monoid put" $ whnf (run . foldMap put) word8s + , bench "Word8s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word8) word8s + , bench "[Word8]" $ whnf (run . put) word8s + , bench "Word16s monoid put" $ whnf (run . foldMap put) word16s + , bench "Word16s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word16BE) word16s + , bench "[Word16]" $ whnf (run . put) word16s + , bench "Word32s monoid put" $ whnf (run . foldMap put) word32s + , bench "Word32s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word32BE) word32s + , bench "[Word32]" $ whnf (run . put) word32s + , bench "Word64s monoid put" $ whnf (run . foldMap put) word64s + , bench "Word64s builder" $ whnf (L.length . toLazyByteString . foldMap BB.word64BE) word64s + , bench "[Word64]" $ whnf (run . put) word64s + + , bgroup "Generics" + [ bench "Struct monoid put" $ whnf (run . foldMap put) structs + , bench "Struct put as list" $ whnf (run . put) structs + , bench "StructList monoid put" $ whnf (run . foldMap put) structLists + , bench "StructList put as list" $ whnf (run . put) structLists ] ] where @@ -121,58 +117,3 @@ word32s = take 10000 $ cycle [minBound .. maxBound] word64s :: [Word64] word64s = take 10000 $ cycle [minBound .. maxBound] {-# NOINLINE word64s #-} - ------------------------------------------------------------------------- --- Benchmarks - -fromIntegers :: [Integer] -> Put -fromIntegers [] = mempty -fromIntegers (x:xs) = put x `mappend` fromIntegers xs - -fromByteStrings :: [S.ByteString] -> Put -fromByteStrings [] = mempty -fromByteStrings (x:xs) = put x `mappend` fromByteStrings xs - -fromStrings :: [String] -> Put -fromStrings [] = mempty -fromStrings (x:xs) = put x `mappend` fromStrings xs - -fromWord8s :: [Word8] -> Put -fromWord8s [] = mempty -fromWord8s (x:xs) = put x `mappend` fromWord8s xs - -fromWord8sBuilder :: [Word8] -> BB.Builder -fromWord8sBuilder [] = mempty -fromWord8sBuilder (x:xs) = BB.word8 x `mappend` fromWord8sBuilder xs - -fromWord16s :: [Word16] -> Put -fromWord16s [] = mempty -fromWord16s (x:xs) = put x `mappend` fromWord16s xs - -fromWord16sBuilder :: [Word16] -> BB.Builder -fromWord16sBuilder [] = mempty -fromWord16sBuilder (x:xs) = BB.word16BE x `mappend` fromWord16sBuilder xs - -fromWord32s :: [Word32] -> Put -fromWord32s [] = mempty -fromWord32s (x:xs) = put x `mappend` fromWord32s xs - -fromWord32sBuilder :: [Word32] -> BB.Builder -fromWord32sBuilder [] = mempty -fromWord32sBuilder (x:xs) = BB.word32BE x `mappend` fromWord32sBuilder xs - -fromWord64s :: [Word64] -> Put -fromWord64s [] = mempty -fromWord64s (x:xs) = put x `mappend` fromWord64s xs - -fromWord64sBuilder :: [Word64] -> BB.Builder -fromWord64sBuilder [] = mempty -fromWord64sBuilder (x:xs) = BB.word64BE x `mappend` fromWord64sBuilder xs - -fromStructs :: [Struct] -> Put -fromStructs [] = mempty -fromStructs (x:xs) = put x `mappend` fromStructs xs - -fromStructLists :: [StructList] -> Put -fromStructLists [] = mempty -fromStructLists (x:xs) = put x `mappend` fromStructLists xs diff --git a/binary.cabal b/binary.cabal index 5617a442..bbc40bce 100644 --- a/binary.cabal +++ b/binary.cabal @@ -30,7 +30,7 @@ build-type: Simple tested-with: GHC == 8.0.2, GHC ==8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.4, GHC == 8.10.7, GHC == 9.0.2, GHC == 9.2.8, GHC == 9.4.8, GHC == 9.6.7, GHC == 9.8.4, GHC == 9.10.3, GHC == 9.12.2, GHC == 9.14.1 extra-source-files: tools/derive/*.hs --- from the benchmark 'bench' +-- from the benchmark 'throughput' extra-source-files: benchmarks/CBenchmark.h extra-doc-files: @@ -111,7 +111,7 @@ test-suite read-write-file default-language: Haskell2010 -benchmark bench +benchmark throughput type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Benchmark.hs @@ -131,7 +131,6 @@ benchmark bench build-depends: ghc-prim default-language: Haskell2010 - benchmark get type: exitcode-stdio-1.0 hs-source-dirs: benchmarks @@ -142,9 +141,9 @@ benchmark get binary, bytestring >= 0.10.4, cereal, - criterion == 1.*, deepseq, - mtl + mtl, + tasty-bench -- build dependencies from using binary source rather than depending on the library build-depends: array, containers ghc-options: -O2 -Wall @@ -153,7 +152,6 @@ benchmark get build-depends: ghc-prim default-language: Haskell2010 - benchmark put type: exitcode-stdio-1.0 hs-source-dirs: benchmarks @@ -162,8 +160,8 @@ benchmark put base >= 4.5.0.0 && < 5, binary, bytestring >= 0.10.4, - criterion == 1.*, - deepseq + deepseq, + tasty-bench -- build dependencies from using binary source rather than depending on the library build-depends: array, containers ghc-options: -O2 -Wall @@ -186,10 +184,10 @@ benchmark generics-bench generic-deriving >= 0.10, directory, filepath, + tasty-bench, unordered-containers, - zlib, - criterion - + zlib + other-modules: Cabal24 GenericsBenchCache @@ -210,9 +208,9 @@ benchmark builder base >= 4.5.0.0 && < 5, binary, bytestring >= 0.10.4, - criterion == 1.*, deepseq, - mtl + mtl, + tasty-bench -- build dependencies from using binary source rather than depending on the library build-depends: array, containers ghc-options: -O2