Skip to content

Commit 5448311

Browse files
konsumlammkonsumlamm
authored
Switch benchmarks to tasty-bench & run benchmarks in CI (#222)
1 parent bad8211 commit 5448311

7 files changed

Lines changed: 112 additions & 173 deletions

File tree

‎.github/workflows/haskell-ci.yaml‎

Lines changed: 11 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -34,10 +34,16 @@ jobs:
3434
run: cabal build --enable-tests
3535
- name: Test
3636
run: cabal test --enable-tests
37-
# benchmarks currently don't compile for GHC 9.14
38-
# - name: Build benchmarks
39-
# run: cabal build --enable-benchmarks
40-
# - name: Bench
41-
# run: cabal bench --enable-benchmarks
37+
- name: Build benchmarks
38+
run: cabal build --enable-benchmarks
39+
- name: Bench
40+
run: |
41+
cabal run bench:throughput
42+
cabal run bench:get
43+
cabal run bench:put
44+
cabal run bench:generics-bench
45+
cabal run bench:builder
46+
env:
47+
TASTY_TIMEOUT: 100
4248
- name: Haddock
4349
run: cabal haddock

‎benchmarks/Benchmark.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -26,11 +26,11 @@ main = do
2626
mb <- case args of
2727
(arg:_) -> readIO arg
2828
_ -> return 100
29-
memBench (mb*10)
29+
memBench (mb*10)
3030
putStrLn ""
3131
putStrLn "Binary (de)serialisation benchmarks:"
3232

33-
-- do bytewise
33+
-- do bytewise
3434
sequence_
3535
[ test wordSize chunkSize Host mb
3636
| wordSize <- [1]

‎benchmarks/Builder.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,12 +12,12 @@ import Data.Monoid (Monoid(mappend, mempty))
1212

1313
import Control.DeepSeq
1414
import Control.Exception (evaluate)
15-
import Criterion.Main
1615
import qualified Data.ByteString as S
1716
import qualified Data.ByteString.Char8 as C
1817
import qualified Data.ByteString.Lazy as L
1918
import Data.Char (ord)
2019
import Data.Word (Word8)
20+
import Test.Tasty.Bench
2121

2222
import Data.Binary.Builder
2323

‎benchmarks/GenericsBench.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@ module Main where
44
import qualified Data.ByteString.Lazy as L
55
import Cabal24 (PackageDescription)
66

7-
import Criterion.Main
7+
import Test.Tasty.Bench
88

99
import qualified Data.Binary as Binary
1010
import Data.Binary.Get (Get)

‎benchmarks/Get.hs‎

Lines changed: 53 additions & 59 deletions
Original file line numberDiff line numberDiff line change
@@ -1,20 +1,13 @@
1-
{-# LANGUAGE CPP, OverloadedStrings, ExistentialQuantification, BangPatterns #-}
2-
3-
#if defined(__GLASGOW_HASKELL__) && !defined(__HADDOCK__)
4-
#include "MachDeps.h"
5-
#endif
6-
7-
module Main where
1+
{-# LANGUAGE OverloadedStrings, BangPatterns #-}
82

93
import Control.DeepSeq
104
import Control.Exception (evaluate)
11-
import Criterion.Main
125
import qualified Data.ByteString as S
13-
import qualified Data.ByteString.Char8 as C8
146
import qualified Data.ByteString.Lazy as L
157
import Data.Bits
168
import Data.Char (ord)
179
import Data.List (foldl')
10+
import Test.Tasty.Bench
1811

1912
import Control.Applicative
2013
import Data.Binary
@@ -25,12 +18,6 @@ import qualified Data.Serialize.Get as Cereal
2518
import qualified Data.Attoparsec.ByteString as A
2619
import qualified Data.Attoparsec.ByteString.Lazy as AL
2720

28-
#if !MIN_VERSION_bytestring(0,10,0)
29-
instance NFData S.ByteString
30-
instance NFData L.ByteString where
31-
rnf = rnf . L.toChunks
32-
#endif
33-
3421
main :: IO ()
3522
main = do
3623
evaluate $ rnf [
@@ -45,53 +32,57 @@ main = do
4532
defaultMain
4633
[ bgroup "brackets"
4734
[ bench "Binary 100kb, one chunk" $
48-
whnf (checkBracket . runTest bracketParser) brackets
35+
whnf (checkBracket . runGet bracketParser) brackets
4936
, bench "Binary 100kb, 100 byte chunks" $
50-
whnf (checkBracket . runTest bracketParser) bracketsInChunks
37+
whnf (checkBracket . runGet bracketParser) bracketsInChunks
5138
, bench "Attoparsec lazy-bs 100kb, one chunk" $
5239
whnf (checkBracket . runAttoL bracketParser_atto) brackets
5340
, bench "Attoparsec lazy-bs 100kb, 100 byte chunks" $
5441
whnf (checkBracket . runAttoL bracketParser_atto) bracketsInChunks
5542
, bench "Attoparsec strict-bs 100kb" $
56-
whnf (checkBracket . runAtto bracketParser_atto) $ S.concat (L.toChunks brackets)
43+
whnf (checkBracket . runAtto bracketParser_atto) $ L.toStrict brackets
44+
, bench "Cereal lazy-bs 100kb, one chunk" $
45+
whnf (checkBracket . runCerealL bracketParser_cereal) brackets
46+
, bench "Cereal lazy-bs 100kb, 100 byte chunks" $
47+
whnf (checkBracket . runCerealL bracketParser_cereal) bracketsInChunks
5748
, bench "Cereal strict-bs 100kb" $
58-
whnf (checkBracket . runCereal bracketParser_cereal) $ S.concat (L.toChunks brackets)
49+
whnf (checkBracket . runCereal bracketParser_cereal) $ L.toStrict brackets
5950
]
6051
, bgroup "comparison getStruct4, 1MB of struct of 4 Word8s"
6152
[ bench "Attoparsec" $
6253
whnf (runAtto (getStruct4_atto mega)) oneMegabyte
6354
, bench "Binary" $
64-
whnf (runTest (getStruct4 mega)) oneMegabyteLBS
55+
whnf (runGet (getStruct4 mega)) oneMegabyteLBS
6556
, bench "Cereal" $
6657
whnf (runCereal (getStruct4_cereal mega)) oneMegabyte
6758
]
6859
, bgroup "comparison getWord8, 1MB"
6960
[ bench "Attoparsec" $
7061
whnf (runAtto (getWord8N1_atto mega)) oneMegabyte
7162
, bench "Binary" $
72-
whnf (runTest (getWord8N1 mega)) oneMegabyteLBS
63+
whnf (runGet (getWord8N1 mega)) oneMegabyteLBS
7364
, bench "Cereal" $
7465
whnf (runCereal (getWord8N1_cereal mega)) oneMegabyte
7566
]
7667
, bgroup "getWord8 1MB"
7768
[ bench "chunk size 2 bytes" $
78-
whnf (runTest (getWord8N2 mega)) oneMegabyteLBS
69+
whnf (runGet (getWord8N2 mega)) oneMegabyteLBS
7970
, bench "chunk size 4 bytes" $
80-
whnf (runTest (getWord8N4 mega)) oneMegabyteLBS
71+
whnf (runGet (getWord8N4 mega)) oneMegabyteLBS
8172
, bench "chunk size 8 bytes" $
82-
whnf (runTest (getWord8N8 mega)) oneMegabyteLBS
73+
whnf (runGet (getWord8N8 mega)) oneMegabyteLBS
8374
, bench "chunk size 16 bytes" $
84-
whnf (runTest (getWord8N16 mega)) oneMegabyteLBS
75+
whnf (runGet (getWord8N16 mega)) oneMegabyteLBS
8576
]
8677
, bgroup "getWord8 1MB Applicative"
8778
[ bench "chunk size 2 bytes" $
88-
whnf (runTest (getWord8N2A mega)) oneMegabyteLBS
79+
whnf (runGet (getWord8N2A mega)) oneMegabyteLBS
8980
, bench "chunk size 4 bytes" $
90-
whnf (runTest (getWord8N4A mega)) oneMegabyteLBS
81+
whnf (runGet (getWord8N4A mega)) oneMegabyteLBS
9182
, bench "chunk size 8 bytes" $
92-
whnf (runTest (getWord8N8A mega)) oneMegabyteLBS
83+
whnf (runGet (getWord8N8A mega)) oneMegabyteLBS
9384
, bench "chunk size 16 bytes" $
94-
whnf (runTest (getWord8N16A mega)) oneMegabyteLBS
85+
whnf (runGet (getWord8N16A mega)) oneMegabyteLBS
9586
]
9687
, bgroup "roll"
9788
[ bench "foldr" $ nf (roll_foldr :: [Word8] -> Integer) manyBytes
@@ -106,23 +97,25 @@ checkBracket :: Int -> Int
10697
checkBracket x | x == bracketCount = x
10798
| otherwise = error "argh!"
10899

109-
runTest :: Get a -> L.ByteString -> a
110-
runTest decoder inp = runGet decoder inp
111-
112-
runCereal :: Cereal.Get a -> C8.ByteString -> a
100+
runCereal :: Cereal.Get a -> S.ByteString -> a
113101
runCereal decoder inp = case Cereal.runGet decoder inp of
114102
Right a -> a
115103
Left err -> error err
116104

117-
runAtto :: AL.Parser a -> C8.ByteString -> a
105+
runCerealL :: Cereal.Get a -> L.ByteString -> a
106+
runCerealL decoder inp = case Cereal.runGetLazy decoder inp of
107+
Right a -> a
108+
Left err -> error err
109+
110+
runAtto :: AL.Parser a -> S.ByteString -> a
118111
runAtto decoder inp = case A.parseOnly decoder inp of
119112
Right a -> a
120113
Left err -> error err
121114

122-
runAttoL :: Show a => AL.Parser a -> L.ByteString -> a
123-
runAttoL decoder inp = case AL.parse decoder inp of
124-
AL.Done _ r -> r
125-
a -> error (show a)
115+
runAttoL :: AL.Parser a -> L.ByteString -> a
116+
runAttoL decoder inp = case AL.parseOnly decoder inp of
117+
Right a -> a
118+
Left err -> error err
126119

127120
-- Defs.
128121

@@ -135,15 +128,11 @@ oneMegabyteLBS = L.fromChunks [oneMegabyte]
135128
mega :: Int
136129
mega = 1024 * 1024
137130

138-
-- 100k of brackets
139-
bracketTest :: L.ByteString -> Int
140-
bracketTest inp = runTest bracketParser inp
141-
142131
bracketCount :: Int
143132
bracketCount = fromIntegral $ L.length brackets `div` 2
144133

145134
brackets :: L.ByteString
146-
brackets = L.fromChunks [C8.concat (L.toChunks bracketsInChunks)]
135+
brackets = L.fromChunks [L.toStrict bracketsInChunks]
147136

148137
bracketsInChunks :: L.ByteString
149138
bracketsInChunks = L.fromChunks (replicate chunksOfBrackets oneChunk)
@@ -154,31 +143,36 @@ bracketsInChunks = L.fromChunks (replicate chunksOfBrackets oneChunk)
154143
bracketParser :: Get Int
155144
bracketParser = cont <|> return 0
156145
where
157-
cont = do v <- some ( do 40 <- getWord8
158-
n <- many cont
159-
41 <- getWord8
160-
return $! sum n + 1)
161-
return $! sum v
146+
cont = do
147+
v <- some $ do
148+
40 <- getWord8 -- '('
149+
n <- many cont
150+
41 <- getWord8 -- ')'
151+
return $! sum n + 1
152+
return $! sum v
162153

163154
bracketParser_cereal :: Cereal.Get Int
164155
bracketParser_cereal = cont <|> return 0
165156
where
166-
cont = do v <- some ( do 40 <- Cereal.getWord8
167-
n <- many cont
168-
41 <- Cereal.getWord8
169-
return $! sum n + 1)
170-
return $! sum v
157+
cont = do
158+
v <- some $ do
159+
40 <- Cereal.getWord8 -- '('
160+
n <- many cont
161+
41 <- Cereal.getWord8 -- ')'
162+
return $! sum n + 1
163+
return $! sum v
171164

172165
bracketParser_atto :: A.Parser Int
173166
bracketParser_atto = cont <|> return 0
174167
where
175-
cont = do v <- some ( do _ <- A.word8 40
176-
n <- bracketParser_atto
177-
_ <- A.word8 41
178-
return $! n + 1)
179-
return $! sum v
168+
cont = do
169+
v <- some $ do
170+
_ <- A.word8 40 -- '('
171+
n <- A.many' cont
172+
_ <- A.word8 41 -- ')'
173+
return $! sum n + 1
174+
return $! sum v
180175

181-
-- Strict struct of 4 Word8s
182176
data S2 = S2 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
183177
data S4 = S4 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
184178
data S8 = S8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8

0 commit comments

Comments
 (0)