diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,15 @@ # Revision history for miniterion +## 0.1.1.0 -- 2023-09 + +* Update version bounds of ``deepseq``. + +* Reorder exported entities. + +* Add "dev" flag for internal development of miniterion. + +* Some documentation updates. + ## 0.1.0.0 -- 2023-09-15 * Initial release. diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -5,6 +5,7 @@ [![Hackage][hackage-badge]][hackage-package] [![Stackage LTS][stackage-lts-badge]][stackage-lts-package] + ## Summary Miniterion is a lightweight Haskell cabal package containing utilities diff --git a/miniterion.cabal b/miniterion.cabal --- a/miniterion.cabal +++ b/miniterion.cabal @@ -8,17 +8,27 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Simple and lightweight benchmark utilities -description: Simple benchmark utilities with API subset from - @criterion@, depends on two packages: @base@ and @deepseq@. +description: + Simple benchmarking utilities with API subset of + (and also a + subset of and + ). + The goal of this package is to provide simple and lightweight + benchmark utilities with less amount of codes and dependency + packages. For robust and feature rich benchmarking utility, use the + other packages mentioned above. + license: MIT license-file: LICENSE author: 8c6794b6 maintainer: 8c6794b6@gmail.com +homepage: https://github.com/8c6794b6/miniterion +bug-reports: https://github.com/8c6794b6/miniterion/issues category: Benchmarking build-type: Simple @@ -33,11 +43,18 @@ default-language: Haskell2010 ghc-options: -Wall +flag dev + description: Flag for internal development + default: False + manual: True + library import: basic exposed-modules: Miniterion - build-depends: deepseq >= 1.4 && < 1.5 + build-depends: deepseq >= 1.4 && < 1.6 hs-source-dirs: src + if flag(dev) + cpp-options: -DDEV test-suite miniterion-test import: basic @@ -45,9 +62,11 @@ hs-source-dirs: test main-is: Main.hs build-depends: miniterion - , directory >= 1.3 && < 1.4 - , tasty >= 1.4 && < 1.6 + , directory >= 1.3 && < 1.4 + , tasty >= 1.4 && < 1.6 , tasty-hunit >= 0.10 && < 0.11 + if flag(dev) + cpp-options: -DDEV benchmark fibo default-language: Haskell2010 diff --git a/src/Miniterion.hs b/src/Miniterion.hs --- a/src/Miniterion.hs +++ b/src/Miniterion.hs @@ -8,11 +8,10 @@ Module: Miniterion License: MIT -Simple benchmark utilities with API subset of -[@criterion@](https://hackage.haskell.org/package/criterion) (which -means also a subset of -[@gauge@](https://hackage.haskell.org/package/gauge) and -[@tasty-bench@](https://hackage.haskell.org/package/tasty-bench)). +Simple benchmarking utilities with API subset of + (and also a +subset of and +). The goal of this package is to provide simple and lightweight benchmark utilities with less amount of codes and dependency @@ -45,16 +44,23 @@ -- * Running a benchmark , nf , whnf - , nfAppIO - , whnfAppIO , nfIO , whnfIO + , nfAppIO + , whnfAppIO -- * Turning a suite of benchmarks into a program , defaultMain -- * For interactive use , benchmark + +#ifdef DEV + -- * For development, exposed for testing + , showPicos5 + , showBytes + , mu +#endif ) where -- base @@ -111,7 +117,7 @@ -- | Benchmarks are simple tree structure with names, and additional -- information to support 'envWithCleanup'. -- --- Drop-in replacement for @Criterion.@'Criterion.Benchmark'. +-- Drop-in replacement for @Criterion.@. data Benchmark = Bench String Benchmarkable | Bgroup String [Benchmark] @@ -120,7 +126,7 @@ -- | Something that can be benchmarked, produced by 'nf', 'whnf', -- 'nfIO', 'whnfIO', 'nfAppIO', and 'whnfAppIO'. -- --- Drop-in replacement for @Criterion.@'Criterion.Benchmarkable'. +-- Drop-in replacement for @Criterion.@. data Benchmarkable = forall a. NFData a => Benchmarkable { allocEnv :: Word64 -> IO a , cleanEnv :: Word64 -> a -> IO () @@ -131,13 +137,13 @@ -- the 'Word64' parameter indicates the number of times to run the -- action. -- --- Drop-in replacement for @Criterion.@'Criterion.toBenchmarkable'. +-- Drop-in replacement for @Criterion.@. toBenchmarkable :: (Word64 -> IO ()) -> Benchmarkable toBenchmarkable f = Benchmarkable noop (const noop) (const f) False {-# INLINE toBenchmarkable #-} -- | Run benchmarks and report results, providing an interface --- compatible with @Criterion.@'Criterion.defaultMain'. +-- compatible with @Criterion.Main.@. defaultMain :: [Benchmark] -> IO () defaultMain bs = do let act = defaultMainWith defaultConfig bs @@ -155,7 +161,7 @@ -- | Attach a name to 'Benchmarkable'. -- -- The type signature is compatible with --- @Criterion.@'Criterion.bench'. +-- @Criterion.@. bench :: String -- ^ Name of this benchmark. -> Benchmarkable -- ^ Benchmark target. @@ -165,7 +171,7 @@ -- | Attach a name to a group of 'Benchmark'. -- -- The type signature is compatible with --- @Criterion.@'Criterion.bgroup'. +-- @Criterion.@. bgroup :: String -- ^ Name of this benchmark group. -> [Benchmark] -- ^ List of benchmarks in the group. @@ -175,7 +181,7 @@ -- | Run a benchmark (or collection of benchmarks) in the given -- environment, usually reading large input data from file. -- --- Drop-in replacement for @Criterion.@'Criterion.env'. +-- Drop-in replacement for @Criterion.@. env :: NFData env => IO env -- ^ Action to create the environment. @@ -186,7 +192,7 @@ -- | Similar to 'env', but includes an additional argument to clean up -- the environment. -- --- Drop-in replacement for @Criterion.@'Criterion.envWithCleanup'. +-- Drop-in replacement for @Criterion.@. envWithCleanup :: NFData env => IO env -- ^ Action to create the environment. @@ -198,7 +204,7 @@ -- | Create a Benchmarkable where a fresh environment is allocated for every -- batch of runs of the benchmarkable. -- --- Drop-in replacement for @Criterion.@'Criterion.perBatchEnv'. +-- Drop-in replacement for @Criterion.@. perBatchEnv :: (NFData env, NFData b) => (Word64 -> IO env) @@ -211,7 +217,7 @@ -- | Same as `perBatchEnv`, but but allows for an additional callback -- to clean up the environment. -- --- Drop-in replacement for @Criterion.@'Criterion.perBatchEnvWithCleanup'. +-- Drop-in replacement for @Criterion.@. perBatchEnvWithCleanup :: (NFData env, NFData b) => (Word64 -> IO env) @@ -228,7 +234,7 @@ -- | Create a Benchmarkable where a fresh environment is allocated for -- every run of the operation to benchmark. -- --- Drop-in replacement for @Criterion.@'Criterion.perRunEnv'. +-- Drop-in replacement for @Criterion.@. -- -- __NOTE__: This function does not work well (or not work at all) if -- the time spent in the initialization work is relatively long @@ -245,7 +251,7 @@ -- | Same as `perBatchEnv`, but allows for an additional callback to -- clean up the environment. -- --- Drop-in replacement for @Criterion.@'Criterion.perRunEnvWithCleanup'. +-- Drop-in replacement for @Criterion.@. -- -- __NOTE__: See the note in 'perRunEnv'. perRunEnvWithCleanup @@ -263,7 +269,7 @@ -- @x@. This does not include time to evaluate @f@ or @x@ themselves. -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- --- Drop-in replacement for @Criterion.@'Criterion.nf'. +-- Drop-in replacement for @Criterion.@. nf :: NFData b => (a -> b) -> a -> Benchmarkable nf = fmap toBenchmarkable . funcToBench rnf {-# INLINE nf #-} @@ -273,7 +279,7 @@ -- evaluate @f@ or @x@ themselves. Ideally @x@ should be a primitive -- data type like 'Data.Int.Int'. -- --- Drop-in replacement for @Criterion.@'Criterion.whnf'. +-- Drop-in replacement for @Criterion.@. whnf :: (a -> b) -> a -> Benchmarkable whnf = fmap toBenchmarkable . funcToBench id {-# INLINE whnf #-} @@ -282,7 +288,7 @@ -- compute its normal form (by means of 'force', not -- 'Control.DeepSeq.rnf'). -- --- Drop-in replacement for @Criterion.@'Criterion.nfIO'. +-- Drop-in replacement for @Criterion.@. nfIO :: NFData a => IO a -> Benchmarkable nfIO = toBenchmarkable . ioToBench rnf {-# INLINE nfIO #-} @@ -290,7 +296,7 @@ -- | 'whnfIO' @x@ measures time to evaluate side-effects of @x@ and -- compute its weak head normal form. -- --- Drop-in replacement for @Criterion.@'Criterion.whnfIO'. +-- Drop-in replacement for @Criterion.@. whnfIO :: IO a -> Benchmarkable whnfIO = toBenchmarkable . ioToBench id {-# INLINE whnfIO #-} @@ -301,7 +307,7 @@ -- evaluate @f@ or @x@ themselves. Ideally @x@ should be a primitive -- data type like 'Data.Int.Int'. -- --- Drop-in replacement for @Criterion.@'Criterion.nfAppIO'. +-- Drop-in replacement for @Criterion.@. nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable nfAppIO = fmap toBenchmarkable . ioFuncToBench rnf {-# INLINE nfAppIO #-} @@ -311,12 +317,13 @@ -- This does not include time to evaluate @f@ or @x@ themselves. -- Ideally @x@ should be a primitive data type like 'Data.Int.Int'. -- --- Drop-in replacement for @Criterion.@'Criterion.whnfAppIO'. +-- Drop-in replacement for @Criterion.@. whnfAppIO :: (a -> IO b) -> a -> Benchmarkable whnfAppIO = fmap toBenchmarkable . ioFuncToBench id {-# INLINE whnfAppIO #-} --- | Run a benchmark interactively. +-- | Run a benchmark interactively, providing an interface compatible with +-- @Criterion.@. benchmark :: Benchmarkable -> IO () benchmark = void . runBenchmark defaultConfig . bench "..." diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} module Main (main) where -- base @@ -12,8 +13,7 @@ import System.Directory (removeFile) -- tasty -import Test.Tasty hiding (defaultMain) -import qualified Test.Tasty as Tasty +import Test.Tasty -- tasty-hunit import Test.Tasty.HUnit @@ -27,7 +27,7 @@ -- ------------------------------------------------------------------------ main :: IO () -main = Tasty.defaultMain $ +main = Test.Tasty.defaultMain $ testGroup "All" [ benchmarkable , options @@ -36,6 +36,10 @@ , glob , csv , timelimit +#ifdef DEV + , formatPicos + , formatBytes +#endif ] @@ -46,7 +50,7 @@ benchmarkable :: TestTree benchmarkable = testGroup "benchmarkable" [ testCase "fib" $ - defaultMain + defaultMain' [ bgroup "fib-nf" [ bench "4" (nf fib 4) , bench "8" (nf fib 8) ] @@ -55,7 +59,7 @@ , bench "8" (whnf fib 8) ]] , testCase "wcIO" $ - defaultMain + defaultMain' [ bgroup "wcIO" [ bench "nfIO" (nfIO (wcIO miniterionDotCabal)) , bench "whnfIO" (whnfIO (wcIO miniterionDotCabal)) @@ -64,141 +68,137 @@ , testGroup "env" [ testCase "wc with env" $ - defaultMain + defaultMain' [ env (readFile miniterionDotCabal) $ \contents -> bench "wc" (nf wc contents) ]] , testGroup "perBatchEnv" [ testCase "wc with perBatchEnv" $ - defaultMain + defaultMain' [ bench "wc" $ perBatchEnv (\_ -> readFile miniterionDotCabal) - (pure . wc) - ] - ] + (pure . wc) ]] , testGroup "perRunEnv" ([ testCase "wc with perRunEnv" $ - withArgs ["--stdev", "90"] $ - defaultMain + defaultMainWith + ["--stdev", "90"] [ bench "wc" $ perRunEnv (readFile miniterionDotCabal) (pure . wc) ] | os == "linux" ] <> [ testCase "perRunEnv with time limit" $ - withArgs ["-L2", "-s1e-9"] $ - defaultMain + defaultMainWith + ["-L4", "-s1e-32"] [ bench "fib" $ perRunEnv (pure 32) - (pure . fib) - ] - ]) + (pure . fib) ]]) + , testGroup "interactive" [ testCase "simple function" $ - benchmark (nf not True) - ] + benchmark (nf not True) ] ] options :: TestTree options = testGroup "options" [ testCase "help with long option" $ - withArgs ["--help"] emptyMain + emptyMain ["--help"] , testCase "help with short option" $ - withArgs ["-h"] emptyMain + emptyMain ["-h"] , testCase "show version info" $ - withArgs ["--version"] emptyMain + emptyMain ["--version"] , testCase "listing names with long option" $ - withArgs ["--list"] benchFib4 + benchFib4 ["--list"] , testCase "listing names with short option" $ - withArgs ["-l"] benchFib4 + benchFib4 ["-l"] , testCase "listing name of benchmark using env" $ - withArgs ["--list"] benchWithEnv + benchFib4 ["--list"] , testCase "listing name of benchmark using env and pat" $ - shouldExitFailure $ withArgs ["--list"] benchWithEnvAndPat + shouldExitFailure $ benchWithEnvAndPat ["--list"] , testCase "listing name of benchmark using env and irrefultable pat" $ - withArgs ["--list"] benchWithEnvAndIrrPat + benchWithEnvAndIrrPat ["--list"] , testCase "stdev option" $ - withArgs ["--stdev", "20"] benchFib4 + benchFib4 ["--stdev", "20"] , testCase "short stdev option" $ - withArgs ["-s", "20"] benchFib4 + benchFib4 ["-s", "20"] , testCase "infinit stdev" $ - withArgs ["--stdev", "Infinity"] benchFib4 + benchFib4 ["--stdev", "Infinity"] , testCase "invalid stdev arg" $ - shouldExitFailure $ withArgs ["--stdev", "foo"] emptyMain + shouldExitFailure $ emptyMain ["--stdev", "foo"] , testCase "missing stdev arg" $ - shouldExitFailure $ withArgs ["--stdev"] emptyMain + shouldExitFailure $ emptyMain ["--stdev"] , testCase "cpu clock for time-mode option" $ - withArgs ["--time-mode", "cpu"] benchFib4 + benchFib4 ["--time-mode", "cpu"] , testCase "wall clock for time-mode option" $ - withArgs ["--time-mode", "wall"] benchFib4 + benchFib4 ["--time-mode", "wall"] , testCase "invalid time-mode option" $ - shouldExitFailure $ withArgs ["--time-mode", "blah"] benchFib4 + shouldExitFailure $ benchFib4 ["--time-mode", "blah"] , testCase "invalid timeout option" $ - shouldExitFailure $ withArgs ["--time-limit", "foo"] benchFib4 + shouldExitFailure $ benchFib4 ["--time-limit", "foo"] , testCase "verbosity 0" $ - withArgs ["--verbosity", "0"] benchFib4 + benchFib4 ["--verbosity", "0"] , testCase "verbosity 1" $ - withArgs ["-v", "1"] benchFib4 + benchFib4 ["-v", "1"] , testCase "verbosity 2" $ - withArgs ["-v2"] benchFib4 + benchFib4 ["-v2"] , testCase "invalid verbosity" $ - shouldExitFailure $ withArgs ["--verbosity", "foo"] benchFib4 + shouldExitFailure $ benchFib4 ["--verbosity", "foo"] , testCase "out of range verbosity" $ - shouldExitFailure $ withArgs ["--verbosity", "100"] benchFib4 + shouldExitFailure $ benchFib4 ["--verbosity", "100"] , testCase "non existing option" $ - shouldExitFailure $ withArgs ["--no-such-option"] emptyMain + shouldExitFailure $ emptyMain ["--no-such-option"] ] skipping :: TestTree skipping = testGroup "skipping" [ testCase "selecting benchmarks" $ - withArgs ["2"] benchNesting + benchNesting ["2"] , testCase "selecting benchmarks, skipping group" $ - withArgs ["c.1.A"] benchNesting + benchNesting ["c.1.A"] , testCase "no matching benchmark" $ - withArgs ["no-matching-benchmark"] benchNesting + benchNesting ["no-matching-benchmark"] , testCase "selecting under env, strict" $ shouldExitFailure $ - withArgs ["fiba"] benchNestingEnvStrict + benchNestingEnvStrict ["fiba"] , testCase "selecting under env, strict, under group" $ shouldExitFailure $ - withArgs ["fiba"] benchNestingEnvStrict_grouped + benchNestingEnvStrictGrouped ["fiba"] , testCase "selecting under env" $ - withArgs ["a"] benchForMatch + benchForMatch ["a"] ] -benchNestingEnvStrict_grouped :: IO () -benchNestingEnvStrict_grouped = - defaultMain +benchNestingEnvStrictGrouped :: [String] -> IO () +benchNestingEnvStrictGrouped args = + defaultMainWith args [ bgroup "a" [ bgroup "1" [s, p] , bgroup "2" [s, p] ] @@ -221,15 +221,14 @@ , testCase "invalid match mode" $ shouldExitFailure $ - withArgs ["-m", "no_such_mode"] $ - defaultMain + defaultMainWith + ["-m", "no_such_mode"] [ bench "foo" (nf fib 8) ] ] where substr_test args str = shouldExitFailure $ - withArgs args $ - defaultMain + defaultMainWith args [ bench "don't match me" (nfIO exit) , bench str (nfIO (exitFailure :: IO ())) , bench "don't match me either" (nfIO exit) @@ -290,57 +289,54 @@ where glob_test pat str = shouldExitFailure $ - withArgs ["--match=glob", pat] $ - defaultMain + defaultMainWith + ["--match=glob", pat] [ bench "skip me" (nfIO (exitSuccess :: IO ())) , bench str (nfIO (exitFailure :: IO ())) ] csv :: TestTree csv = with_csv_cleanup $ testGroup "csv" [ testCase writing_slow_csv $ - withArgs ["--csv", "slow.csv"] benchSlowfib + benchSlowfib ["--csv", "slow.csv"] , after_slow_csv $ - testCase "comparing with baseline" $ do - withArgs ["--baseline", "slow.csv"] benchFastfib + testCase "comparing with baseline" $ + benchFastfib ["--baseline", "slow.csv"] - , testCase "non-existing baseline" $ do - shouldExitFailure $ withArgs ["--baseline", "nosuch.csv"] benchFastfib + , testCase "non-existing baseline" $ + shouldExitFailure $ benchFastfib ["--baseline", "nosuch.csv"] , testCase writing_quoted_csv $ - withArgs ["--csv", "quotes.csv", "-L3"] benchQuotes + benchQuotes ["--csv", "quotes.csv", "-L3"] , after_quoted_csv $ - testCase "reading baseline containing quotes" $ do - withArgs ["--baseline", "quotes.csv", "-L3"] benchQuotes + testCase "reading baseline containing quotes" $ + benchQuotes ["--baseline", "quotes.csv", "-L3"] - , testCase writing_fast_csv $ do - withArgs ["--csv", "fast.csv"] benchFastfib + , testCase writing_fast_csv $ + benchFastfib ["--csv", "fast.csv"] , after_fast_csv $ - testCase "fail if slower" $ do - shouldExitFailure $ - withArgs ["--baseline", "fast.csv", "--fail-if-slower", "10"] - benchSlowfib + testCase "fail if slower" $ + shouldExitFailure $ + benchSlowfib ["--baseline", "fast.csv", "--fail-if-slower", "10"] , after_fast_csv $ - testCase "fail if slower, with match" $ do - shouldExitFailure $ - withArgs ["--baseline", "fast.csv" ,"--fail-if-slower", "10" ,"fib/16"] - benchSlowfib + testCase "fail if slower, with match" $ + shouldExitFailure $ + benchSlowfib ["--baseline", "fast.csv" ,"--fail-if-slower", "10" ,"fib/16"] - , testCase "fail if slower, invalid arg" $ do - shouldExitFailure $ withArgs ["--fail-if-slower", "foo"] benchSlowfib + , testCase "fail if slower, invalid arg" $ + shouldExitFailure $ benchSlowfib ["--fail-if-slower", "foo"] , after_slow_csv $ - testCase "fail if faster" $ do - shouldExitFailure $ - withArgs ["--baseline", "slow.csv", "--fail-if-faster", "10"] - benchFastfib + testCase "fail if faster" $ + shouldExitFailure $ + benchFastfib ["--baseline", "slow.csv", "--fail-if-faster", "10"] - , testCase "fail if faster, invalid arg" $ do - shouldExitFailure $ - withArgs ["--fail-if-faster", "foo"] benchSlowfib + , testCase "fail if faster, invalid arg" $ + shouldExitFailure $ + benchSlowfib ["--fail-if-faster", "foo"] ] where writing_slow_csv = "writing slow.csv" @@ -362,32 +358,106 @@ timelimit = testGroup "timeout" [ testCase "time limit, long name" $ shouldExitFailure $ - withArgs ["--time-limit", "1e-6", "--stdev", "1e-9"] benchFib32 + benchFib32 ["--time-limit", "1e-6", "--stdev", "1e-9"] , testCase "time limit, short name" $ shouldExitFailure $ - withArgs ["-L", "1e-9", "--stdev", "1e-32"] benchFib32 + benchFib32 ["-L", "1e-9", "--stdev", "1e-32"] , testCase "time limit, return before the limit" $ - withArgs ["-L", "1", "--stdev", "1e-32"] benchFib32 + benchFib32 ["-L", "1", "--stdev", "1e-32"] , testCase "invalid time limit arg" $ shouldExitFailure $ - withArgs ["--time-limit", "foo"] benchFib32 + benchFib32 ["--time-limit", "foo"] ] +#ifdef DEV +formatPicos :: TestTree +formatPicos = testGroup "format picos" + [ testCase "pico seconds" $ do + assertPicos 1 "1.000 ps" + assertPicos 12 "12.00 ps" + assertPicos 123 "123.0 ps" + , testCase "nano seconds" $ do + assertPicos 1234 "1.234 ns" + assertPicos 12345 "12.34 ns" + assertPicos 123456 "123.5 ns" + + , testCase "micro seconds" $ do + assertPicos 1234567 ("1.235 " ++ [mu] ++ "s") + assertPicos 12345678 ("12.35 " ++ [mu] ++ "s") + assertPicos 123456789 ("123.5 " ++ [mu] ++ "s") + + , testCase "milli seconds" $ do + assertPicos 1234567890 "1.235 ms" + assertPicos 12345678901 "12.35 ms" + assertPicos 123456789012 "123.5 ms" + + , testCase "seconds" $ do + assertPicos 1234567890123 "1.235 s" + assertPicos 12345678901234 "12.35 s" + assertPicos 123456789012345 "123.5 s" + assertPicos 1234567890123456 "1234.6 s" + ] + where + assertPicos n str = assertEqual (show n) str (showPicos5 n) + +formatBytes :: TestTree +formatBytes = testGroup "format bytes" + [ testCase "bytes" $ do + assertBytes 999 " 999 B" + + , testCase "kilobytes" $ do + assertBytes 10188 "9.9 KB" + assertBytes 1023487 "999 KB" + + , testCase "megabytes" $ do + assertBytes 1043331 "1.0 MB" + assertBytes 1048051711 "999 MB" + + , testCase "gigabytes" $ do + assertBytes 10683731148 "9.9 GB" + assertBytes 1073204953087 "999 GB" + + , testCase "terabytes" $ do + assertBytes 10940140696371 "9.9 TB" + assertBytes 1098961871962111 "999 TB" + + , testCase "petabytes" $ do + assertBytes 11202704073084106 "9.9 PB" + assertBytes 1125336956889202623 "999 PB" + + , testCase "exabytes" $ do + assertBytes 11471568970838124590 "9.9 EB" + assertBytes maxBound " 16 EB" + ] + where + assertBytes n str = assertEqual (show n) str (showBytes n) +#endif + + -- ------------------------------------------------------------------------ -- Auxiliary -- ------------------------------------------------------------------------ +defaultMain' :: [Benchmark] -> IO () +defaultMain' = defaultMainWith [] + +defaultMainWith :: [String] -> [Benchmark] -> IO () +defaultMainWith args = withArgs args . Miniterion.defaultMain + fib :: Int -> Integer fib n = if n < 2 then toInteger n else fib (n-1) + fib (n-2) fastfib :: Int -> Integer fastfib n = fibs !! n where - fibs = 0 : 1 : zipWith (+) (tail fibs) fibs + fibs = 0 : 1 : rest + rest = case fibs of + _:tl -> zipWith (+) tl fibs + [] -> error "impossible happened!" wc :: String -> Int wc = length . words @@ -401,40 +471,29 @@ Just (ExitFailure {}) -> pure () _ -> throwIO e -emptyMain :: IO () -emptyMain = defaultMain [] +emptyMain :: [String] -> IO () +emptyMain args = defaultMainWith args [] miniterionDotCabal :: FilePath miniterionDotCabal = "miniterion.cabal" -benchFib4 :: IO () -benchFib4 = - defaultMain +benchFib4 :: [String] -> IO () +benchFib4 args = + defaultMainWith args [ bgroup "fib" [ bench "4" (nf fib 4) ]] -benchWithEnv :: IO () -benchWithEnv = - defaultMain - [ bgroup "a" - [ bench "fibnf" (nf fib 8) - , bench "fibwhnf" (whnf fib 8) ] - , env (readFile miniterionDotCabal) $ \contents -> - bgroup "b" - [ bench "wcnf" (nf wc contents) - , bench "wcwhnf" (whnf wc contents) ]] - -benchWithEnvAndPat :: IO () -benchWithEnvAndPat = - defaultMain +benchWithEnvAndPat :: [String] -> IO () +benchWithEnvAndPat args = + defaultMainWith args [ env (pure (3, 4)) $ \ (a, b) -> bgroup "fib" [ bench "a" (nf fib a) , bench "b" (nf fib b) ]] -benchWithEnvAndIrrPat :: IO () -benchWithEnvAndIrrPat = - defaultMain +benchWithEnvAndIrrPat :: [String] -> IO () +benchWithEnvAndIrrPat args = + defaultMainWith args [ env (pure (3, 4)) $ \ ~(a, b) -> bgroup "fib" [ bench "a" (nf fib a) @@ -444,9 +503,9 @@ s = bench "succ" (nf (succ :: Int -> Int) 1) p = bench "pred" (nf (pred :: Int -> Int) 1) -benchNesting :: IO () -benchNesting = - defaultMain +benchNesting :: [String] -> IO () +benchNesting args = + defaultMainWith args [ bgroup "a" [s, p] , bgroup "b" [ bgroup "1" [s, p] @@ -457,9 +516,9 @@ , bgroup "2" [ bgroup "B" [s, p] ]]] -benchNestingEnvStrict :: IO () -benchNestingEnvStrict = - defaultMain +benchNestingEnvStrict :: [String] -> IO () +benchNestingEnvStrict args = + defaultMainWith args [ bgroup "a" [ bgroup "1" [s, p] , bgroup "2" [s, p] ] @@ -468,40 +527,40 @@ [ bench "fiba" (nf fib a) , bench "fibb" (nf fib b) ]] -benchForMatch :: IO () -benchForMatch = - defaultMain +benchForMatch :: [String] -> IO () +benchForMatch args = + defaultMainWith args [ bgroup "a" [ bgroup "a1" [s, p] , bgroup "a2" [s, p] ] , env (pure ()) $ \_ -> bgroup "b" [s, p] ] -benchSlowfib :: IO () -benchSlowfib = - defaultMain +benchSlowfib :: [String] -> IO () +benchSlowfib args = + defaultMainWith args [ bgroup "fib" [ bench "4" (nf fib 4) , bench "8" (nf fib 8) , bench "16" (nf fib 16) ]] -benchFib32 :: IO () -benchFib32 = - defaultMain +benchFib32 :: [String] -> IO () +benchFib32 args = + defaultMainWith args [ bgroup "fib" [ bench "32" (nf fib 32) ]] -benchFastfib :: IO () -benchFastfib = - defaultMain +benchFastfib :: [String] -> IO () +benchFastfib args = + defaultMainWith args [ bgroup "fib" [ bench "4" (nf fib 4) , bench "8" (nf fastfib 8) , bench "16" (nf fastfib 16) ]] -benchQuotes :: IO () -benchQuotes = - defaultMain +benchQuotes :: [String] -> IO () +benchQuotes args = + defaultMainWith args [ bgroup "group \"one\"" [ bgroup "a" [s, p] , bgroup "b" [s, p] ]