{- |
Module:      Test.Tasty.Bench
Copyright:   (c) 2021 Andrew Lelechenko
Licence:     MIT

Featherlight benchmark framework (only one file!) for performance measurement with API mimicking [@criterion@](http://hackage.haskell.org/package/criterion) and [@gauge@](http://hackage.haskell.org/package/gauge).

=== How lightweight is it?

There is only one source file "Test.Tasty.Bench" and no external dependencies
except [@tasty@](http://hackage.haskell.org/package/tasty).
So if you already depend on @tasty@ for a test suite, there
is nothing else to install.

Compare this to @criterion@ (10+ modules, 50+ dependencies) and @gauge@ (40+ modules, depends on @basement@ and @vector@).

=== How is it possible?

Our benchmarks are literally regular @tasty@ tests, so we can leverage all existing
machinery for command-line options, resource management, structuring,
listing and filtering benchmarks, running and reporting results. It also means
that @tasty-bench@ can be used in conjunction with other @tasty@ ingredients.

Unlike @criterion@ and @gauge@ we use a very simple statistical model described below.
This is arguably a questionable choice, but it works pretty well in practice.
A rare developer is sufficiently well-versed in probability theory
to make sense and use of all numbers generated by @criterion@.

=== How to switch?

[Cabal mixins](https://cabal.readthedocs.io/en/3.4/cabal-package.html#pkg-field-mixins)
allow to taste @tasty-bench@ instead of @criterion@ or @gauge@
without changing a single line of code:

@
cabal-version: 2.0

benchmark foo
  ...
  build-depends:
    tasty-bench
  mixins:
    tasty-bench (Test.Tasty.Bench as Criterion)
@

This works vice versa as well: if you use @tasty-bench@, but at some point
need a more comprehensive statistical analysis,
it is easy to switch temporarily back to @criterion@.

=== How to write a benchmark?

Benchmarks are declared in a separate section of @cabal@ file:

@
cabal-version:   2.0
name:            bench-fibo
version:         0.0
build-type:      Simple
synopsis:        Example of a benchmark

benchmark bench-fibo
  main-is:       BenchFibo.hs
  type:          exitcode-stdio-1.0
  build-depends: base, tasty-bench
@

And here is @BenchFibo.hs@:

@
import Test.Tasty.Bench

fibo :: Int -> Integer
fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2)

main :: IO ()
main = defaultMain
  [ bgroup "fibonacci numbers"
    [ bench "fifth"     $ nf fibo  5
    , bench "tenth"     $ nf fibo 10
    , bench "twentieth" $ nf fibo 20
    ]
  ]
@

Since @tasty-bench@ provides an API compatible with @criterion@,
one can refer to [its documentation](http://www.serpentine.com/criterion/tutorial.html#how-to-write-a-benchmark-suite) for more examples.

=== How to read results?

Running the example above (@cabal@ @bench@ or @stack@ @bench@)
results in the following output:

@
All
  fibonacci numbers
    fifth:     OK (2.13s)
       63 ns ± 3.4 ns
    tenth:     OK (1.71s)
      809 ns ±  73 ns
    twentieth: OK (3.39s)
      104 μs ± 4.9 μs

All 3 tests passed (7.25s)
@

The output says that, for instance, the first benchmark
was repeatedly executed for 2.13 seconds (wall time),
its mean time was 63 nanoseconds and,
assuming ideal precision of a system clock,
execution time does not often diverge from the mean
further than ±3.4 nanoseconds
(double standard deviation, which for normal distributions
corresponds to [95%](https://en.wikipedia.org/wiki/68%E2%80%9395%E2%80%9399.7_rule)
probability). Take standard deviation numbers
with a grain of salt; there are lies, damned lies, and statistics.

Note that this data is not directly comparable with @criterion@ output:

@
benchmarking fibonacci numbers/fifth
time                 62.78 ns   (61.99 ns .. 63.41 ns)
                     0.999 R²   (0.999 R² .. 1.000 R²)
mean                 62.39 ns   (61.93 ns .. 62.94 ns)
std dev              1.753 ns   (1.427 ns .. 2.258 ns)
@

One might interpret the second line as saying that
95% of measurements fell into 61.99–63.41 ns interval, but this is wrong.
It states that the [OLS regression](https://en.wikipedia.org/wiki/Ordinary_least_squares)
of execution time (which is not exactly the mean time) is most probably
somewhere between 61.99 ns and 63.41 ns,
but does not say a thing about individual measurements.
To understand how far away a typical measurement deviates
you need to add/subtract double standard deviation yourself
(which gives 62.78 ns ± 3.506 ns, similar to @tasty-bench@ above).

To add to the confusion, @gauge@ in @--small@ mode outputs
not the second line of @criterion@ report as one might expect,
but a mean value from the penultimate line and a standard deviation:

@
fibonacci numbers/fifth                  mean 62.39 ns  ( +- 1.753 ns  )
@

The interval ±1.753 ns answers
for [68%](https://en.wikipedia.org/wiki/68%E2%80%9395%E2%80%9399.7_rule)
of samples only, double it to estimate the behavior in 95% of cases.

=== Statistical model

Here is a procedure used by @tasty-bench@ to measure execution time:

1. Set \( n \leftarrow 1 \).
2. Measure execution time \( t_n \)  of \( n \) iterations
   and execution time \( t_{2n} \) of \( 2n \) iterations.
3. Find \( t \) which minimizes deviation of \( (nt, 2nt) \) from \( (t_n, t_{2n}) \).
4. If deviation is small enough (see @--stdev@ below),
   return \( t \) as a mean execution time.
5. Otherwise set \( n \leftarrow 2n \) and jump back to Step 2.

This is roughly similar to the linear regression approach which @criterion@ takes,
but we fit only two last points. This allows us to simplify away all heavy-weight
statistical analysis. More importantly, earlier measurements,
which are presumably shorter and noisier, do not affect overall result.
This is in contrast to @criterion@, which fits all measurements and
is biased to use more data points corresponding to shorter runs
(it employs \( n \leftarrow 1.05n \) progression).

An alert reader could object that we measure standard deviation
for samples with \( n \) and \( 2n \) iterations, but report
it scaled to a single iteration.
Strictly speaking, this is justified only if we assume
that deviating factors are either roughly periodic
(e. g., coarseness of a system clock, garbage collection)
or are likely to affect several successive iterations in the same way
(e. g., slow down by another concurrent process).

Obligatory disclaimer: statistics is a tricky matter, there is no
one-size-fits-all approach.
In the absence of a good theory
simplistic approaches are as (un)sound as obscure ones.
Those who seek statistical soundness should rather collect raw data
and process it themselves in R/Python. Data reported by @tasty-bench@
is only of indicative and comparative significance.

=== Tip

Passing @+RTS@ @-T@ (via @cabal@ @bench@ @--benchmark-options@ @'+RTS@ @-T'@
or @stack@ @bench@ @--ba@ @'+RTS@ @-T'@) enables @tasty-bench@ to estimate and report
memory usage such as allocated and copied bytes.

=== Command-line options

Use @--help@ to list command-line options.

[@-p@, @--pattern@]:
  This is a standard @tasty@ option, which allows filtering benchmarks
  by a pattern or @awk@ expression. Please refer
  to [@tasty@ documentation](https://github.com/feuerbach/tasty#patterns)
  for details.

[@--csv@]:
  File to write results in CSV format. If specified, suppresses console output.

[@-t@, @--timeout@]:
  This is a standard @tasty@ option, setting timeout for individual benchmarks
  in seconds. Use it when benchmarks tend to take too long: @tasty-bench@ will make
  an effort to report results (even if of subpar quality) before timeout. Setting
  timeout too tight (insufficient for at least three iterations of benchmark)
  will result in a benchmark failure. Do not use @--timeout@ without a reason:
  it forks an additional thread and thus affects reliability of measurements.

[@--stdev@]:
  Target relative standard deviation of measurements in percents (5% by default).
  Large values correspond to fast and loose benchmarks, and small ones to long and precise.
  If it takes far too long, consider setting @--timeout@,
  which will interrupt benchmarks, potentially before reaching the target deviation.

-}

{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}

module Test.Tasty.Bench
  (
  -- * Running 'Benchmark'
    defaultMain
  , Benchmark
  , bench
  , bgroup
  -- * Creating 'Benchmarkable'
  , Benchmarkable
  , nf
  , whnf
  , nfIO
  , whnfIO
  , nfAppIO
  , whnfAppIO
  -- * CSV ingredient
  , csvReporter
  ) where

import Control.Applicative
import Control.DeepSeq
import Control.Exception
import Control.Monad
import Data.Data (Typeable)
import Data.Int
import Data.List (intercalate)
import Data.Proxy
#if MIN_VERSION_base(4,6,0)
import GHC.Stats
#endif
import System.CPUTime
import System.Mem
import Test.Tasty hiding (defaultMain)
import qualified Test.Tasty
import Test.Tasty.Options
import Test.Tasty.Providers
import Text.Printf
import Test.Tasty.Runners
import Test.Tasty.Ingredients
import Test.Tasty.Ingredients.ConsoleReporter
import System.IO

newtype RelStDev = RelStDev { RelStDev -> Double
unRelStDev :: Double }
  deriving (RelStDev -> RelStDev -> Bool
(RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> Bool) -> Eq RelStDev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RelStDev -> RelStDev -> Bool
$c/= :: RelStDev -> RelStDev -> Bool
== :: RelStDev -> RelStDev -> Bool
$c== :: RelStDev -> RelStDev -> Bool
Eq, Eq RelStDev
Eq RelStDev
-> (RelStDev -> RelStDev -> Ordering)
-> (RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> RelStDev)
-> (RelStDev -> RelStDev -> RelStDev)
-> Ord RelStDev
RelStDev -> RelStDev -> Bool
RelStDev -> RelStDev -> Ordering
RelStDev -> RelStDev -> RelStDev
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RelStDev -> RelStDev -> RelStDev
$cmin :: RelStDev -> RelStDev -> RelStDev
max :: RelStDev -> RelStDev -> RelStDev
$cmax :: RelStDev -> RelStDev -> RelStDev
>= :: RelStDev -> RelStDev -> Bool
$c>= :: RelStDev -> RelStDev -> Bool
> :: RelStDev -> RelStDev -> Bool
$c> :: RelStDev -> RelStDev -> Bool
<= :: RelStDev -> RelStDev -> Bool
$c<= :: RelStDev -> RelStDev -> Bool
< :: RelStDev -> RelStDev -> Bool
$c< :: RelStDev -> RelStDev -> Bool
compare :: RelStDev -> RelStDev -> Ordering
$ccompare :: RelStDev -> RelStDev -> Ordering
$cp1Ord :: Eq RelStDev
Ord, Int -> RelStDev -> ShowS
[RelStDev] -> ShowS
RelStDev -> String
(Int -> RelStDev -> ShowS)
-> (RelStDev -> String) -> ([RelStDev] -> ShowS) -> Show RelStDev
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RelStDev] -> ShowS
$cshowList :: [RelStDev] -> ShowS
show :: RelStDev -> String
$cshow :: RelStDev -> String
showsPrec :: Int -> RelStDev -> ShowS
$cshowsPrec :: Int -> RelStDev -> ShowS
Show, Typeable)

instance IsOption RelStDev where
  defaultValue :: RelStDev
defaultValue = Double -> RelStDev
RelStDev Double
5
  parseValue :: String -> Maybe RelStDev
parseValue = (Double -> RelStDev) -> Maybe Double -> Maybe RelStDev
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> RelStDev
RelStDev (Maybe Double -> Maybe RelStDev)
-> (String -> Maybe Double) -> String -> Maybe RelStDev
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
forall a. Read a => String -> Maybe a
safeRead
  optionName :: Tagged RelStDev String
optionName = String -> Tagged RelStDev String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"stdev"
  optionHelp :: Tagged RelStDev String
optionHelp = String -> Tagged RelStDev String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Target relative standard deviation of measurements in percents (5 by default). Large values correspond to fast and loose benchmarks, and small ones to long and precise. If it takes far too long, consider setting --timeout, which will interrupt benchmarks, potentially before reaching the target deviation."

-- | Something that can be benchmarked.
--
-- Drop-in replacement for 'Criterion.Benchmarkable' and 'Gauge.Benchmarkable'.
--
newtype Benchmarkable = Benchmarkable { Benchmarkable -> Int64 -> IO ()
_unBenchmarkable :: Int64 -> IO () }
  deriving (Typeable)

showPicos :: Integer -> String
showPicos :: Integer -> String
showPicos Integer
i
  | Double
a Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0    = String
"0"
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995   = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ps" Double
t
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e1 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e3 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ns" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e4 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e6 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f μs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e7 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e9 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f ms" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
  | Bool
otherwise = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f s"   (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12)
  where
    t, a :: Double
    t :: Double
t = Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i
    a :: Double
a = Double -> Double
forall a. Num a => a -> a
abs Double
t

showBytes :: Integer -> String
showBytes :: Integer -> String
showBytes Integer
i
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1000          = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f B " Double
t
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10189         = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f KB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1023488       = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f KB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1024)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10433332      = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f MB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1048576)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1048051712    = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f MB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1048576)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10683731149   = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f GB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1073741824)
  | Double
a Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1073204953088 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f GB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1073741824)
  | Bool
otherwise         = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%.1f TB"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
  where
    t, a :: Double
    t :: Double
t = Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
i
    a :: Double
a = Double -> Double
forall a. Num a => a -> a
abs Double
t

data Measurement = Measurement
  { Measurement -> Integer
measTime   :: !Integer -- ^ time in picoseconds
  , Measurement -> Integer
measAllocs :: !Integer -- ^ allocations in bytes
  , Measurement -> Integer
measCopied :: !Integer -- ^ copied bytes
  }

data Estimate = Estimate
  { Estimate -> Measurement
estMean  :: !Measurement
  , Estimate -> Integer
estSigma :: !Integer  -- ^ stdev in picoseconds
  }

prettyEstimate :: Estimate -> String
prettyEstimate :: Estimate -> String
prettyEstimate (Estimate Measurement
m Integer
sigma) =
  -- Two sigmas correspond to 95% probability,
  Integer -> String
showPicos (Measurement -> Integer
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ± " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
showPicos (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sigma)

prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC (Estimate Measurement
m Integer
sigma) =
  -- Two sigmas correspond to 95% probability,
  Integer -> String
showPicos (Measurement -> Integer
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ± " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
showPicos (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sigma)
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
showBytes (Measurement -> Integer
measAllocs Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" allocated, "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
showBytes (Measurement -> Integer
measCopied Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" copied"

csvEstimate :: Estimate -> String
csvEstimate :: Estimate -> String
csvEstimate (Estimate Measurement
m Integer
sigma) = Integer -> String
forall a. Show a => a -> String
show (Measurement -> Integer
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sigma)

csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC :: Estimate -> String
csvEstimateWithGC (Estimate Measurement
m Integer
sigma) = Integer -> String
forall a. Show a => a -> String
show (Measurement -> Integer
measTime Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
sigma)
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Measurement -> Integer
measAllocs Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"," String -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show (Measurement -> Integer
measCopied Measurement
m)

predict
  :: Measurement -- ^ time for one run
  -> Measurement -- ^ time for two runs
  -> Estimate
predict :: Measurement -> Measurement -> Estimate
predict (Measurement Integer
t1 Integer
a1 Integer
c1) (Measurement Integer
t2 Integer
a2 Integer
c2) = Estimate :: Measurement -> Integer -> Estimate
Estimate
  { estMean :: Measurement
estMean  = Integer -> Integer -> Integer -> Measurement
Measurement Integer
t Integer
a Integer
c
  , estSigma :: Integer
estSigma = Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Floating a => a -> a
sqrt (Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
d) :: Double)
  }
  where
    sqr :: a -> a
sqr a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
    d :: Integer
d = Integer -> Integer
forall a. Num a => a -> a
sqr (Integer
t1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
t) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer -> Integer
forall a. Num a => a -> a
sqr (Integer
t2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
t)
    t :: Integer
t = (Integer
t1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
t2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
5
    a :: Integer
a = (Integer
a1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
a2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
5
    c :: Integer
c = (Integer
c1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
c2) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
5

predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed :: Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2 = Estimate :: Measurement -> Integer -> Estimate
Estimate
  { estMean :: Measurement
estMean = Estimate -> Measurement
estMean (Measurement -> Measurement -> Estimate
predict Measurement
t1 Measurement
t2)
  , estSigma :: Integer
estSigma = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max
    (Estimate -> Integer
estSigma (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
lo Measurement
t1) (Measurement -> Measurement
hi Measurement
t2)))
    (Estimate -> Integer
estSigma (Measurement -> Measurement -> Estimate
predict (Measurement -> Measurement
hi Measurement
t1) (Measurement -> Measurement
lo Measurement
t2)))
  }
  where
    prec :: Integer
prec = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
cpuTimePrecision Integer
1000000000 -- 1 ms
    hi :: Measurement -> Measurement
hi Measurement
meas = Measurement
meas { measTime :: Integer
measTime = Measurement -> Integer
measTime Measurement
meas Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
prec }
    lo :: Measurement -> Measurement
lo Measurement
meas = Measurement
meas { measTime :: Integer
measTime = Measurement -> Integer
measTime Measurement
meas Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
prec }

#if !MIN_VERSION_base(4,10,0)
getRTSStatsEnabled :: IO Bool
#if MIN_VERSION_base(4,6,0)
getRTSStatsEnabled = getGCStatsEnabled
#else
getRTSStatsEnabled = pure False
#endif
#endif

getAllocsAndCopied :: IO (Integer, Integer)
getAllocsAndCopied :: IO (Integer, Integer)
getAllocsAndCopied = do
  Bool
enabled <- IO Bool
getRTSStatsEnabled
  if Bool -> Bool
not Bool
enabled then (Integer, Integer) -> IO (Integer, Integer)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer
0, Integer
0) else
#if MIN_VERSION_base(4,10,0)
    (\RTSStats
s -> (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
allocated_bytes RTSStats
s, Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ RTSStats -> Word64
copied_bytes RTSStats
s)) (RTSStats -> (Integer, Integer))
-> IO RTSStats -> IO (Integer, Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
getRTSStats
#elif MIN_VERSION_base(4,6,0)
    (\s -> (toInteger $ bytesAllocated s, toInteger $ bytesCopied s)) <$> getGCStats
#else
    pure (0, 0)
#endif

measureTime :: Int64 -> Benchmarkable -> IO Measurement
measureTime :: Int64 -> Benchmarkable -> IO Measurement
measureTime Int64
n (Benchmarkable Int64 -> IO ()
act) = do
  IO ()
performGC
  Integer
startTime <- IO Integer
getCPUTime
  (Integer
startAllocs, Integer
startCopied) <- IO (Integer, Integer)
getAllocsAndCopied
  Int64 -> IO ()
act Int64
n
  Integer
endTime <- IO Integer
getCPUTime
  (Integer
endAllocs, Integer
endCopied) <- IO (Integer, Integer)
getAllocsAndCopied
  Measurement -> IO Measurement
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Measurement -> IO Measurement) -> Measurement -> IO Measurement
forall a b. (a -> b) -> a -> b
$ Measurement :: Integer -> Integer -> Integer -> Measurement
Measurement
    { measTime :: Integer
measTime   = Integer
endTime Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
startTime
    , measAllocs :: Integer
measAllocs = Integer
endAllocs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
startAllocs
    , measCopied :: Integer
measCopied = Integer
endCopied Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
startCopied
    }

measureTimeUntil :: Maybe Integer -> Double -> Benchmarkable -> IO Estimate
measureTimeUntil :: Maybe Integer -> Double -> Benchmarkable -> IO Estimate
measureTimeUntil Maybe Integer
timeout Double
targetRelStDev Benchmarkable
b = do
  Measurement
t1 <- Int64 -> Benchmarkable -> IO Measurement
measureTime Int64
1 Benchmarkable
b
  Int64 -> Measurement -> Integer -> IO Estimate
go Int64
1 Measurement
t1 Integer
0
  where
    go :: Int64 -> Measurement -> Integer -> IO Estimate
    go :: Int64 -> Measurement -> Integer -> IO Estimate
go Int64
n Measurement
t1 Integer
sumOfTs = do
      Measurement
t2 <- Int64 -> Benchmarkable -> IO Measurement
measureTime (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
n) Benchmarkable
b

      let Estimate (Measurement Integer
meanN Integer
allocN Integer
copiedN) Integer
sigmaN = Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2
          isTimeoutSoon :: Bool
isTimeoutSoon = case Maybe Integer
timeout of
            Maybe Integer
Nothing -> Bool
False
            -- multiplying by 1.2 helps to avoid accidental timeouts
            Just Integer
tmt  -> (Integer
sumOfTs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Measurement -> Integer
measTime Measurement
t1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
3 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Measurement -> Integer
measTime Measurement
t2) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
12 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
tmt Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10
          isStDevInTargetRange :: Bool
isStDevInTargetRange = Integer
sigmaN Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
targetRelStDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
meanN)
          scale :: Integer -> Integer
scale = (Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger Int64
n)

      if Bool
isStDevInTargetRange Bool -> Bool -> Bool
|| Bool
isTimeoutSoon
        then Estimate -> IO Estimate
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> IO Estimate) -> Estimate -> IO Estimate
forall a b. (a -> b) -> a -> b
$ Measurement -> Integer -> Estimate
Estimate (Integer -> Integer -> Integer -> Measurement
Measurement (Integer -> Integer
scale Integer
meanN) (Integer -> Integer
scale Integer
allocN) (Integer -> Integer
scale Integer
copiedN)) (Integer -> Integer
scale Integer
sigmaN)
        else Int64 -> Measurement -> Integer -> IO Estimate
go (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
n) Measurement
t2 (Integer
sumOfTs Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Measurement -> Integer
measTime Measurement
t1)

instance IsTest Benchmarkable where
  testOptions :: Tagged Benchmarkable [OptionDescription]
testOptions = [OptionDescription] -> Tagged Benchmarkable [OptionDescription]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Proxy RelStDev -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy RelStDev
forall k (t :: k). Proxy t
Proxy :: Proxy RelStDev), Proxy (Maybe CsvPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe CsvPath)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe CsvPath))]
  run :: OptionSet -> Benchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts Benchmarkable
b = IO Result -> (Progress -> IO ()) -> IO Result
forall a b. a -> b -> a
const (IO Result -> (Progress -> IO ()) -> IO Result)
-> IO Result -> (Progress -> IO ()) -> IO Result
forall a b. (a -> b) -> a -> b
$ case NumThreads -> Int
getNumThreads (OptionSet -> NumThreads
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) of
    Int
1 -> do
      let targetRelStDev :: Double
targetRelStDev = RelStDev -> Double
unRelStDev (OptionSet -> RelStDev
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100
          timeout :: Maybe Integer
timeout = case OptionSet -> Timeout
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
            Timeout
NoTimeout -> Maybe Integer
forall a. Maybe a
Nothing
            Timeout Integer
micros String
_ -> Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer) -> Integer -> Maybe Integer
forall a b. (a -> b) -> a -> b
$ Integer
micros Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1000000
      Bool
hasGCStats <- IO Bool
getRTSStatsEnabled

      Estimate
est <- Maybe Integer -> Double -> Benchmarkable -> IO Estimate
measureTimeUntil Maybe Integer
timeout Double
targetRelStDev Benchmarkable
b
      Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> Result
testPassed (String -> Result) -> String -> Result
forall a b. (a -> b) -> a -> b
$ case OptionSet -> Maybe CsvPath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
        Maybe CsvPath
Nothing        -> (if Bool
hasGCStats then Estimate -> String
prettyEstimateWithGC else Estimate -> String
prettyEstimate) Estimate
est
        Just CsvPath{} -> (if Bool
hasGCStats then Estimate -> String
csvEstimateWithGC    else Estimate -> String
csvEstimate)    Estimate
est
    Int
_ -> Result -> IO Result
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ String -> Result
testFailed String
"Benchmarks should be run in a single-threaded mode (--jobs 1)"

-- | Attach a name to 'Benchmarkable'.
--
-- This is actually a synonym of 'Test.Tasty.Providers.singleTest'
-- to provide an interface compatible with 'Criterion.bench' and 'Gauge.bench'.
--
bench :: String -> Benchmarkable -> Benchmark
bench :: String -> Benchmarkable -> Benchmark
bench = String -> Benchmarkable -> Benchmark
forall t. IsTest t => String -> t -> Benchmark
singleTest

-- | Attach a name to a group of 'Benchmark'.
--
-- This is actually a synonym of 'Test.Tasty.testGroup'
-- to provide an interface compatible with 'Criterion.bgroup'
-- and 'Gauge.bgroup'.
--
bgroup :: String -> [Benchmark] -> Benchmark
bgroup :: String -> [Benchmark] -> Benchmark
bgroup = String -> [Benchmark] -> Benchmark
testGroup

-- | Benchmarks are actually just a regular 'Test.Tasty.TestTree' in disguise.
--
-- This is a drop-in replacement for 'Criterion.Benchmark' and 'Gauge.Benchmark'.
--
type Benchmark = TestTree

-- | Run benchmarks and report results.
--
-- Wrapper around 'Test.Tasty.defaultMain' (+ 'csvReporter')
-- to provide an interface compatible with 'Criterion.defaultMain'
-- and 'Gauge.defaultMain'.
--
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain = [Ingredient] -> Benchmark -> IO ()
Test.Tasty.defaultMainWithIngredients [Ingredient]
ingredients (Benchmark -> IO ())
-> ([Benchmark] -> Benchmark) -> [Benchmark] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [Benchmark] -> Benchmark
testGroup String
"All"
  where
    ingredients :: [Ingredient]
ingredients = [Ingredient
listingTests, Ingredient
csvReporter, Ingredient
consoleTestReporter]


funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench :: (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> c
frc = ((Int64 -> IO ()) -> Benchmarkable
Benchmarkable ((Int64 -> IO ()) -> Benchmarkable)
-> (a -> Int64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Int64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> b) -> a -> Int64 -> IO ())
-> (a -> b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> a -> Int64 -> IO ()
forall t t. (Ord t, Num t) => (t -> b) -> t -> t -> IO ()
go
  where
    go :: (t -> b) -> t -> t -> IO ()
go t -> b
f t
x t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc (t -> b
f t
x))
        (t -> b) -> t -> t -> IO ()
go t -> b
f t
x (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE funcToBench #-}

-- | 'nf' @f@ @x@ measures time to compute
-- a normal form (by means of 'rnf') of @f@ @x@.
--
-- Note that forcing a normal form requires an additional
-- traverse of the structure. In certain scenarios (imagine benchmarking 'tail'),
-- especially when 'NFData' instance is badly written,
-- this traversal may take non-negligible time and affect results.
--
-- Drop-in replacement for 'Criterion.nf' and 'Gauge.nf'.
--
nf :: NFData b => (a -> b) -> a -> Benchmarkable
nf :: (a -> b) -> a -> Benchmarkable
nf = (b -> ()) -> (a -> b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> ()
forall a. NFData a => a -> ()
rnf
{-# INLINE nf #-}

-- | 'whnf' @f@ @x@ measures time to compute
-- a weak head normal form of @f@ @x@.
--
-- Computing only a weak head normal form is
-- rarely what intuitively is meant by "evaluation".
-- Unless you understand precisely, what is measured,
-- it is recommended to use 'nf' instead.
--
-- Drop-in replacement for 'Criterion.whnf' and 'Gauge.whnf'.
--
whnf :: (a -> b) -> a -> Benchmarkable
whnf :: (a -> b) -> a -> Benchmarkable
whnf = (b -> b) -> (a -> b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> b
forall a. a -> a
id
{-# INLINE whnf #-}

ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench b -> c
frc IO b
act = (Int64 -> IO ()) -> Benchmarkable
Benchmarkable Int64 -> IO ()
forall t. (Ord t, Num t) => t -> IO ()
go
  where
    go :: t -> IO ()
go t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        b
val <- IO b
act
        c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc b
val)
        t -> IO ()
go (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioToBench #-}

-- | 'nfIO' @x@ measures time to evaluate side-effects of @x@
-- and compute its normal form (by means of 'rnf').
--
-- Pure subexpression of an effectful computation @x@
-- may be evaluated only once and get cached; use 'nfAppIO'
-- to avoid this.
--
-- Note that forcing a normal form requires an additional
-- traverse of the structure. In certain scenarios,
-- especially when 'NFData' instance is badly written,
-- this traversal may take non-negligible time and affect results.
--
-- Drop-in replacement for 'Criterion.nfIO' and 'Gauge.nfIO'.
--
nfIO :: NFData a => IO a -> Benchmarkable
nfIO :: IO a -> Benchmarkable
nfIO = (a -> ()) -> IO a -> Benchmarkable
forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench a -> ()
forall a. NFData a => a -> ()
rnf
{-# INLINE nfIO #-}

-- | 'whnfIO' @x@ measures time to evaluate side-effects of @x@
-- and compute its weak head normal form.
--
-- Pure subexpression of an effectful computation @x@
-- may be evaluated only once and get cached; use 'whnfAppIO'
-- to avoid this.
--
-- Computing only a weak head normal form is
-- rarely what intuitively is meant by "evaluation".
-- Unless you understand precisely, what is measured,
-- it is recommended to use 'nfIO' instead.
--
-- Drop-in replacement for 'Criterion.whnfIO' and 'Gauge.whnfIO'.
--
whnfIO :: NFData a => IO a -> Benchmarkable
whnfIO :: IO a -> Benchmarkable
whnfIO = (a -> a) -> IO a -> Benchmarkable
forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench a -> a
forall a. a -> a
id
{-# INLINE whnfIO #-}

ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench :: (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> c
frc = ((Int64 -> IO ()) -> Benchmarkable
Benchmarkable ((Int64 -> IO ()) -> Benchmarkable)
-> (a -> Int64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Int64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> IO b) -> a -> Int64 -> IO ())
-> (a -> IO b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> IO b) -> a -> Int64 -> IO ()
forall t t. (Ord t, Num t) => (t -> IO b) -> t -> t -> IO ()
go
  where
    go :: (t -> IO b) -> t -> t -> IO ()
go t -> IO b
f t
x t
n
      | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
<= t
0    = () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        b
val <- t -> IO b
f t
x
        c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc b
val)
        (t -> IO b) -> t -> t -> IO ()
go t -> IO b
f t
x (t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1)
{-# INLINE ioFuncToBench #-}

-- | 'nfAppIO' @f@ @x@ measures time to evaluate side-effects of @f@ @x@
-- and compute its normal form (by means of 'rnf').
--
-- Note that forcing a normal form requires an additional
-- traverse of the structure. In certain scenarios,
-- especially when 'NFData' instance is badly written,
-- this traversal may take non-negligible time and affect results.
--
-- Drop-in replacement for 'Criterion.nfAppIO' and 'Gauge.nfAppIO'.
--
nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO :: (a -> IO b) -> a -> Benchmarkable
nfAppIO = (b -> ()) -> (a -> IO b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> ()
forall a. NFData a => a -> ()
rnf
{-# INLINE nfAppIO #-}

-- | 'whnfAppIO' @f@ @x@ measures time to evaluate side-effects of @f@ @x@
-- and compute its weak head normal form.
--
-- Computing only a weak head normal form is
-- rarely what intuitively is meant by "evaluation".
-- Unless you understand precisely, what is measured,
-- it is recommended to use 'nfAppIO' instead.
--
-- Drop-in replacement for 'Criterion.whnfAppIO' and 'Gauge.whnfAppIO'.
--
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO = (b -> b) -> (a -> IO b) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> b
forall a. a -> a
id
{-# INLINE whnfAppIO #-}

newtype CsvPath = CsvPath { CsvPath -> String
_unCsvPath :: FilePath }
  deriving (Typeable)

instance IsOption (Maybe CsvPath) where
  defaultValue :: Maybe CsvPath
defaultValue = Maybe CsvPath
forall a. Maybe a
Nothing
  parseValue :: String -> Maybe (Maybe CsvPath)
parseValue = Maybe CsvPath -> Maybe (Maybe CsvPath)
forall a. a -> Maybe a
Just (Maybe CsvPath -> Maybe (Maybe CsvPath))
-> (String -> Maybe CsvPath) -> String -> Maybe (Maybe CsvPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvPath -> Maybe CsvPath
forall a. a -> Maybe a
Just (CsvPath -> Maybe CsvPath)
-> (String -> CsvPath) -> String -> Maybe CsvPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> CsvPath
CsvPath
  optionName :: Tagged (Maybe CsvPath) String
optionName = String -> Tagged (Maybe CsvPath) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"csv"
  optionHelp :: Tagged (Maybe CsvPath) String
optionHelp = String -> Tagged (Maybe CsvPath) String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File to write results in CSV format. If specified, suppresses console output"

-- | Add this ingredient to run benchmarks and save results in CSV format.
-- It activates when @--csv@ @FILE@ command line option is specified.
--
-- @
-- defaultMainWithIngredients [listingTests, csvReporter, consoleTestReporter] benchmarks
-- @
--
-- Remember that successful activation of an ingredient suppresses all subsequent
-- ingredients. If you wish to produce CSV in addition to other reports,
-- use 'composeReporters':
--
-- @
-- defaultMainWithIngredients [listingTests, composeReporters csvReporter consoleTestReporter] benchmarks
-- @
--
csvReporter :: Ingredient
csvReporter :: Ingredient
csvReporter = [OptionDescription]
-> (OptionSet
    -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [Proxy (Maybe CsvPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe CsvPath)
forall k (t :: k). Proxy t
Proxy :: Proxy (Maybe CsvPath))] ((OptionSet
  -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
 -> Ingredient)
-> (OptionSet
    -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$
  \OptionSet
opts Benchmark
tree -> do
    CsvPath String
path <- OptionSet -> Maybe CsvPath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((StatusMap -> IO (Double -> IO Bool))
 -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
      IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        (do
          Handle
h <- String -> IOMode -> IO Handle
openFile String
path IOMode
WriteMode
          Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
          Bool
hasGCStats <- IO Bool
getRTSStatsEnabled
          Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"Name,Mean (ps),2*Stdev (ps)" String -> ShowS
forall a. [a] -> [a] -> [a]
++
            (if Bool
hasGCStats then String
",Allocated,Copied" else String
"")
          Handle -> IO Handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h
        )
        Handle -> IO ()
hClose
        (\Handle
h -> TestOutput -> StatusMap -> IO ()
csvOutput (Handle -> OptionSet -> Benchmark -> TestOutput
buildCsvOutput Handle
h OptionSet
opts Benchmark
tree) StatusMap
smap)
      (Double -> IO Bool) -> IO (Double -> IO Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((Double -> IO Bool) -> IO (Double -> IO Bool))
-> (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> Double -> IO Bool
forall a b. a -> b -> a
const ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (Int -> Bool) -> (Statistics -> Int) -> Statistics -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statistics -> Int
statFailures (Statistics -> Bool) -> IO Statistics -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StatusMap -> IO Statistics
computeStatistics StatusMap
smap)

buildCsvOutput :: Handle -> OptionSet -> TestTree -> TestOutput
buildCsvOutput :: Handle -> OptionSet -> Benchmark -> TestOutput
buildCsvOutput Handle
h = (((([String] -> TestOutput) -> [String] -> TestOutput
forall a b. (a -> b) -> a -> b
$ []) (([String] -> TestOutput) -> TestOutput)
-> (Ap ((->) [String]) TestOutput -> [String] -> TestOutput)
-> Ap ((->) [String]) TestOutput
-> TestOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ap ((->) [String]) TestOutput -> [String] -> TestOutput
forall (f :: * -> *) a. Ap f a -> f a
getApp) (Ap ((->) [String]) TestOutput -> TestOutput)
-> (Benchmark -> Ap ((->) [String]) TestOutput)
-> Benchmark
-> TestOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Benchmark -> Ap ((->) [String]) TestOutput)
 -> Benchmark -> TestOutput)
-> (OptionSet -> Benchmark -> Ap ((->) [String]) TestOutput)
-> OptionSet
-> Benchmark
-> TestOutput
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeFold (Ap ((->) [String]) TestOutput)
-> OptionSet -> Benchmark -> Ap ((->) [String]) TestOutput
forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree
  TreeFold (Ap ((->) [String]) TestOutput)
forall b. Monoid b => TreeFold b
trivialFold { foldSingle :: forall t.
IsTest t =>
OptionSet -> String -> t -> Ap ((->) [String]) TestOutput
foldSingle = (String -> t -> Ap ((->) [String]) TestOutput)
-> OptionSet -> String -> t -> Ap ((->) [String]) TestOutput
forall a b. a -> b -> a
const String -> t -> Ap ((->) [String]) TestOutput
forall b. String -> b -> Ap ((->) [String]) TestOutput
runSingleTest, foldGroup :: OptionSet
-> String
-> Ap ((->) [String]) TestOutput
-> Ap ((->) [String]) TestOutput
foldGroup =
#if MIN_VERSION_tasty(1,4,0)
    (String
 -> Ap ((->) [String]) TestOutput -> Ap ((->) [String]) TestOutput)
-> OptionSet
-> String
-> Ap ((->) [String]) TestOutput
-> Ap ((->) [String]) TestOutput
forall a b. a -> b -> a
const String
-> Ap ((->) [String]) TestOutput -> Ap ((->) [String]) TestOutput
forall a a. a -> Ap ((->) [a]) a -> Ap ((->) [a]) a
runGroup
#else
    runGroup
#endif
  }
  where
    runSingleTest :: String -> b -> Ap ((->) [String]) TestOutput
runSingleTest String
name = Ap ((->) [String]) TestOutput -> b -> Ap ((->) [String]) TestOutput
forall a b. a -> b -> a
const (Ap ((->) [String]) TestOutput
 -> b -> Ap ((->) [String]) TestOutput)
-> Ap ((->) [String]) TestOutput
-> b
-> Ap ((->) [String]) TestOutput
forall a b. (a -> b) -> a -> b
$ ([String] -> TestOutput) -> Ap ((->) [String]) TestOutput
forall (f :: * -> *) a. f a -> Ap f a
Ap (([String] -> TestOutput) -> Ap ((->) [String]) TestOutput)
-> ([String] -> TestOutput) -> Ap ((->) [String]) TestOutput
forall a b. (a -> b) -> a -> b
$ \[String]
prefix -> String -> IO () -> (Result -> IO ()) -> TestOutput
PrintTest String
name
      (Handle -> String -> IO ()
hPutStr Handle
h (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ ShowS
encodeCsv (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"." ([String] -> [String]
forall a. [a] -> [a]
reverse (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
prefix))) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
",")
      (Handle -> String -> IO ()
hPutStrLn Handle
h (String -> IO ()) -> (Result -> IO String) -> Result -> IO ()
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< String -> IO String
formatMessage (String -> IO String) -> (Result -> String) -> Result -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> String
resultDescription)

    runGroup :: a -> Ap ((->) [a]) a -> Ap ((->) [a]) a
runGroup a
name (Ap [a] -> a
grp) = ([a] -> a) -> Ap ((->) [a]) a
forall (f :: * -> *) a. f a -> Ap f a
Ap (([a] -> a) -> Ap ((->) [a]) a) -> ([a] -> a) -> Ap ((->) [a]) a
forall a b. (a -> b) -> a -> b
$ \[a]
prefix -> [a] -> a
grp (a
name a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
prefix)

csvOutput :: TestOutput -> StatusMap -> IO ()
csvOutput :: TestOutput -> StatusMap -> IO ()
csvOutput = (Traversal IO -> IO ()
forall (f :: * -> *). Traversal f -> f ()
getTraversal (Traversal IO -> IO ())
-> (StatusMap -> Traversal IO) -> StatusMap -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((StatusMap -> Traversal IO) -> StatusMap -> IO ())
-> (TestOutput -> StatusMap -> Traversal IO)
-> TestOutput
-> StatusMap
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> IO () -> IO Result -> (Result -> IO ()) -> Traversal IO)
-> (String -> IO () -> Traversal IO -> Traversal IO)
-> TestOutput
-> StatusMap
-> Traversal IO
forall b.
Monoid b =>
(String -> IO () -> IO Result -> (Result -> IO ()) -> b)
-> (String -> IO () -> b -> b) -> TestOutput -> StatusMap -> b
foldTestOutput ((IO () -> IO Result -> (Result -> IO ()) -> Traversal IO)
-> String
-> IO ()
-> IO Result
-> (Result -> IO ())
-> Traversal IO
forall a b. a -> b -> a
const IO () -> IO Result -> (Result -> IO ()) -> Traversal IO
forall (f :: * -> *) a a.
Monad f =>
f a -> f a -> (a -> f ()) -> Traversal f
foldTest) ((IO () -> Traversal IO -> Traversal IO)
-> String -> IO () -> Traversal IO -> Traversal IO
forall a b. a -> b -> a
const ((Traversal IO -> Traversal IO)
-> IO () -> Traversal IO -> Traversal IO
forall a b. a -> b -> a
const Traversal IO -> Traversal IO
forall a. a -> a
id))
  where
    foldTest :: f a -> f a -> (a -> f ()) -> Traversal f
foldTest f a
printName f a
getResult a -> f ()
printResult =
      f () -> Traversal f
forall (f :: * -> *). f () -> Traversal f
Traversal (f () -> Traversal f) -> f () -> Traversal f
forall a b. (a -> b) -> a -> b
$ f a
printName f a -> f a -> f a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> f a
getResult f a -> (a -> f ()) -> f ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= a -> f ()
printResult

encodeCsv :: String -> String
encodeCsv :: ShowS
encodeCsv String
xs
  | (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
xs) String
",\"\n\r"
  = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: (Char -> String) -> ShowS
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"' then String
"\"\"" else [Char
x]) String
xs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  | Bool
otherwise = String
xs