{- |
Module:      Test.Tasty.Bench
Copyright:   (c) 2021 Andrew Lelechenko
License:     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). A prominent feature is
built-in comparison against previous runs and between benchmarks.


=== How lightweight is it?

There is only one source file "Test.Tasty.Bench" and no non-boot
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@). A build on a clean
machine is up to 16x faster than @criterion@ and up to 4x faster than
@gauge@. A build without dependencies is up to 6x faster than
@criterion@ and up to 8x faster than @gauge@.

@tasty-bench@ is a native Haskell library and works everywhere, where
GHC does, including WASM. We support a full range of architectures
(@i386@, @amd64@, @armhf@, @arm64@, @ppc64le@, @s390x@) and operating
systems (Linux, Windows, macOS, FreeBSD, OpenBSD, NetBSD), plus any GHC
from 8.0 to 9.10 (and earlier releases stretch back to GHC 7.0).

=== 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?

<https://cabal.readthedocs.io/en/3.4/cabal-package.html#pkg-field-mixins Cabal 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, Test.Tasty.Bench as Criterion.Main, Test.Tasty.Bench as Gauge, Test.Tasty.Bench as Gauge.Main)

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
>   ghc-options:   "-with-rtsopts=-A32m"
>   if impl(ghc >= 8.6)
>     ghc-options: -fproc-alignment=64

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
<http://www.serpentine.com/criterion/tutorial.html#how-to-write-a-benchmark-suite its documentation>
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-clock time), its predicted mean CPU time
was 63 nanoseconds and means of individual samples do not often diverge
from it further than ±3.4 nanoseconds (double standard deviation). Take
standard deviation numbers with a grain of salt; there are lies, damned
lies, and statistics.

=== Wall-clock time vs. CPU time

What time are we talking about? Both @criterion@ and @gauge@ by default
report wall-clock time, which is affected by any other application which
runs concurrently. Ideally benchmarks are executed on a dedicated server
without any other load, but — let’s face the truth — most of developers
run benchmarks on a laptop with a hundred other services and a window
manager, and watch videos while waiting for benchmarks to finish. That’s
the cause of a notorious “variance introduced by outliers: 88% (severely
inflated)” warning.

To alleviate this issue @tasty-bench@ measures CPU time by 'getCPUTime'
instead of wall-clock time by default. It does not provide a perfect
isolation from other processes (e. g., if CPU cache is spoiled by others,
populating data back from RAM is your burden), but is a bit more stable.

Caveat: this means that for multithreaded algorithms @tasty-bench@
reports total elapsed CPU time across all cores, while @criterion@ and
@gauge@ print maximum of core’s wall-clock time. It also means that by
default @tasty-bench@ does not measure time spent out of process, e. g.,
calls to other executables. To work around this limitation use
@--time-mode@ command-line option or set it locally via 'TimeMode'
option.

=== 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})\), namely \(t \leftarrow (t_n + 2t_{2n}) / 5n\).
4.  If deviation is small enough (see @--stdev@ below) or time is
    running out soon (see @--timeout@ 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).

Mean time and its deviation does not say much about the distribution of
individual timings. E. g., imagine a computation which (according to a
coarse system timer) takes either 0 ms or 1 ms with equal probability.
While one would be able to establish that its mean time is 0.5 ms with a
very small deviation, this does not imply that individual measurements
are anywhere near 0.5 ms. Even assuming an infinite precision of a
system timer, the distribution of individual times is not known to be
<https://en.wikipedia.org/wiki/Normal_distribution normal>.

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 using
a proper statistical toolbox. Data reported by @tasty-bench@ is only of
indicative and comparative significance.

=== Memory usage

Configuring RTS to collect GC statistics (e. g., via
@cabal@ @bench@ @--benchmark-options@ @\'+RTS@ @-T\'@ or
@stack@ @bench@ @--ba@ @\'+RTS@ @-T\'@) enables @tasty-bench@ to estimate and
report memory usage:

> All
>   Fibonacci numbers
>     fifth:     OK (2.13s)
>        63 ns ± 3.4 ns, 223 B  allocated,   0 B  copied, 2.0 MB peak memory
>     tenth:     OK (1.71s)
>       809 ns ±  73 ns, 2.3 KB allocated,   0 B  copied, 4.0 MB peak memory
>     twentieth: OK (3.39s)
>       104 μs ± 4.9 μs, 277 KB allocated,  59 B  copied, 5.0 MB peak memory
>
> All 3 tests passed (7.25s)

This data is reported as per
<https://hackage.haskell.org/package/base/docs/GHC-Stats.html#t:RTSStats GHC.Stats.RTSStats>
fields:

-   'allocated_bytes'

    Total size of data ever allocated since the start of the benchmark
    iteration. Even if data was immediately garbage collected and freed,
    it still counts.

-   'copied_bytes'

    Total size of data ever copied by GC (because it was alive and
    kicking) since the start of the benchmark iteration. Note that zero
    bytes often mean that the benchmark was too short to trigger GC at
    all.

-   'max_mem_in_use_bytes'

    Peak size of live data since the very start of the process. This is
    a global metric, it cumulatively grows and does not say much about
    individual benchmarks, but rather characterizes heap environment in
    which they are executed.

=== Combining tests and benchmarks

When optimizing an existing function, it is important to check that its
observable behavior remains unchanged. One can rebuild both tests and
benchmarks after each change, but it would be more convenient to run
sanity checks within benchmark itself. Since our benchmarks are
compatible with @tasty@ tests, we can easily do so.

Imagine you come up with a faster function @myFibo@ to generate
Fibonacci numbers:

> import Test.Tasty.Bench
> import Test.Tasty.QuickCheck -- from tasty-quickcheck package
>
> fibo :: Int -> Integer
> fibo n = if n < 2 then toInteger n else fibo (n - 1) + fibo (n - 2)
>
> myFibo :: Int -> Integer
> myFibo n = if n < 3 then toInteger n else myFibo (n - 1) + myFibo (n - 2)
>
> main :: IO ()
> main = Test.Tasty.Bench.defaultMain -- not Test.Tasty.defaultMain
>   [ bench "fibo   20" $ nf fibo   20
>   , bench "myFibo 20" $ nf myFibo 20
>   , testProperty "myFibo = fibo" $ \n -> fibo n === myFibo n
>   ]

This outputs:

> All
>   fibo   20:     OK (3.02s)
>     104 μs ± 4.9 μs
>   myFibo 20:     OK (1.99s)
>      71 μs ± 5.3 μs
>   myFibo = fibo: FAIL
>     *** Failed! Falsified (after 5 tests and 1 shrink):
>     2
>     1 /= 2
>     Use --quickcheck-replay=927711 to reproduce.
>
> 1 out of 3 tests failed (5.03s)

We see that @myFibo@ is indeed significantly faster than @fibo@, but
unfortunately does not do the same thing. One should probably look for
another way to speed up generation of Fibonacci numbers.

=== Troubleshooting

-   If benchmarks take too long, set @--timeout@ to limit execution time
    of individual benchmarks, and @tasty-bench@ will do its best to fit
    into a given time frame. Without @--timeout@ we rerun benchmarks
    until achieving a target precision set by @--stdev@, which in a
    noisy environment of a modern laptop with GUI may take a lot of
    time.

    While @criterion@ runs each benchmark at least for 5 seconds,
    @tasty-bench@ is happy to conclude earlier, if it does not
    compromise the quality of results. In our experiments @tasty-bench@
    suites tend to finish earlier, even if some individual benchmarks
    take longer than with @criterion@.

    A common source of noisiness is garbage collection. Setting a larger
    allocation area (/nursery/) is often a good idea, either via
    @cabal@ @bench@ @--benchmark-options@ @\'+RTS@ @-A32m\'@ or
    @stack@ @bench@ @--ba@ @\'+RTS@ @-A32m\'@. Alternatively bake it into
    @cabal@ file as @ghc-options:@ @\"-with-rtsopts=-A32m\"@.

-   Never compile benchmarks with @-fstatic-argument-transformation@,
    because it breaks a trick we use to force GHC into reevaluation of
    the same function application over and over again.

-   If benchmark results look malformed like below, make sure that you
    are invoking @Test.Tasty.Bench.@'Test.Tasty.Bench.defaultMain' and not
    @Test.Tasty.@'Test.Tasty.defaultMain' (the difference is 'consoleBenchReporter'
    vs. 'consoleTestReporter'):

    > All
    >   fibo 20:       OK (1.46s)
    >     WithLoHi (Estimate {estMean = Measurement {measTime = 41529118775, measAllocs = 0, measCopied = 0, measMaxMem = 0}, estStdev = 1595055320}) (-Infinity) Infinity

-   If benchmarks fail with an error message

    > Unhandled resource. Probably a bug in the runner you're using.

    or

    > Unexpected state of the resource (NotCreated) in getResource. Report as a tasty bug.

    this is likely caused by 'env' or 'envWithCleanup' affecting
    benchmarks structure. You can use 'env' to read test data from 'IO',
    but not to read benchmark names or affect their hierarchy in other
    way. This is a fundamental restriction of @tasty@ to list and filter
    benchmarks without launching missiles.

    Strict pattern-matching on resource is also prohibited. For
    instance, if it is a tuple, the second argument of 'env' should use
    a lazy pattern match @\\~(a, b) -> ...@

-   If benchmarks fail with @Test dependencies form a loop@ or
    @Test dependencies have cycles@, this is likely because of
    'bcompare', which compares a benchmark with itself. Locating a
    benchmark in a global environment may be tricky, please refer to
    [@tasty@ documentation](https://github.com/UnkindPartition/tasty#patterns)
    for details and consider using 'locateBenchmark'.

-   When seeing

    > This benchmark takes more than 100 seconds. Consider setting --timeout, if this is unexpected (or to silence this warning).

    do follow the advice: abort benchmarks and pass @-t100@ or similar.
    Unless you are benchmarking a very computationally expensive
    function, a single benchmark should stabilize after a couple of
    seconds. This warning is a sign that your environment is too noisy,
    in which case @tasty-bench@ will continue trying with exponentially
    longer intervals, often unproductively.

-   The following error can be thrown when benchmarks are built with
    @ghc-options: -threaded@:

    > Benchmarks must not be run concurrently. Please pass -j1 and/or avoid +RTS -N.

    The underlying cause is that @tasty@ runs tests concurrently, which
    is harmful for reliable performance measurements. Make sure to use
    @tasty-bench >= 0.3.4@ and invoke @Test.Tasty.Bench.@'Test.Tasty.Bench.defaultMain' and
    not @Test.Tasty.@'Test.Tasty.defaultMain'. Note that 'localOption' ('NumThreads' 1)
    quashes the warning, but does not eliminate the cause.

-   If benchmarks using GHC 9.4.4+ segfault on Windows, check that you
    are not using non-moving garbage collector @--nonmoving-gc@. This is
    likely caused by
    <https://gitlab.haskell.org/ghc/ghc/-/issues/23003 GHC issue>.
    Previous releases of @tasty-bench@ recommended enabling
    @--nonmoving-gc@ to stabilise benchmarks, but it’s discouraged now.

-   If you see

    > <stdout>: commitBuffer: invalid argument (cannot encode character '\177')

    or

    > Uncaught exception ghc-internal:GHC.Internal.IO.Exception.IOException:
    > <stdout>: commitBuffer: invalid argument (cannot encode character '\956')

    it means that your locale does not support UTF-8. @tasty-bench@
    makes an effort to force locale to UTF-8, but sometimes, when
    benchmarks are a part of a larger application, it’s
    <https://gitlab.haskell.org/ghc/ghc/-/issues/23606 impossible> to do
    so. In such case run @locale@ @-a@ to list available locales and set a
    UTF-8-capable one (e. g., @export@ @LANG=C.UTF-8@) before starting
    benchmarks.

=== Isolating interfering benchmarks

One difficulty of benchmarking in Haskell is that it is hard to isolate
benchmarks so that they do not interfere. Changing the order of
benchmarks or skipping some of them has an effect on heap’s layout and
thus affects garbage collection. This issue is well attested in
<https://github.com/haskell/criterion/issues/166 both>
[@criterion@](https://github.com/haskell/criterion/issues/60) and
[@gauge@](https://github.com/vincenthz/hs-gauge/issues/2).

Usually (but not always) skipping some benchmarks speeds up remaining
ones. That’s because once a benchmark allocated heap which for some
reason was not promptly released afterwards (e. g., it forced a top-level
thunk in an underlying library), all further benchmarks are slowed down
by garbage collector processing this additional amount of live data over
and over again.

There are several mitigation strategies. First of all, giving garbage
collector more breathing space by @+RTS@ @-A32m@ (or more) is often good
enough.

Further, avoid using top-level bindings to store large test data. Once
such thunks are forced, they remain allocated forever, which affects
detrimentally subsequent unrelated benchmarks. Treat them as external
data, supplied via 'env': instead of

> largeData :: String
> largeData = replicate 1000000 'a'
>
> main :: IO ()
> main = defaultMain
>   [ bench "large" $ nf length largeData, ... ]

use

> import Control.DeepSeq (force)
> import Control.Exception (evaluate)
>
> main :: IO ()
> main = defaultMain
>   [ env (evaluate (force (replicate 1000000 'a'))) $ \largeData ->
>     bench "large" $ nf length largeData, ... ]

Finally, as an ultimate measure to reduce interference between
benchmarks, one can run each of them in a separate process. We do not
quite recommend this approach, but if you are desperate, here is how:

> cabal run -v0 all:benches -- -l | sed -e 's/[\"]/\\\\\\&/g' | while read -r name; do cabal run -v0 all:benches -- -p '$0 == "'"$name"'"'; done

This assumes that there is a single benchmark suite in the project and
that benchmark names do not contain newlines.

=== Comparison against baseline

One can compare benchmark results against an earlier run in an automatic
way.

When using this feature, it’s especially important to compile benchmarks
with
@ghc-options:@ [@-fproc-alignment@](https://downloads.haskell.org/ghc/latest/docs/users_guide/debugging.html#ghc-flag--fproc-alignment)@=64@,
otherwise results could be skewed by intermittent changes in cache-line
alignment.

Firstly, run @tasty-bench@ with @--csv@ @FILE@ key to dump results to
@FILE@ in CSV format (it could be a good idea to set smaller @--stdev@,
if possible):

> Name,Mean (ps),2*Stdev (ps)
> All.Fibonacci numbers.fifth,48453,4060
> All.Fibonacci numbers.tenth,637152,46744
> All.Fibonacci numbers.twentieth,81369531,3342646

Now modify implementation and rerun benchmarks with @--baseline@ @FILE@
key. This produces a report as follows:

> All
>   Fibonacci numbers
>     fifth:     OK (0.44s)
>        53 ns ± 2.7 ns,  8% more than baseline
>     tenth:     OK (0.33s)
>       641 ns ±  59 ns,       same as baseline
>     twentieth: OK (0.36s)
>        77 μs ± 6.4 μs,  5% less than baseline
>
> All 3 tests passed (1.50s)

You can also fail benchmarks, which deviate too far from baseline, using
@--fail-if-slower@ and @--fail-if-faster@ options. For example, setting
both of them to 6 will fail the first benchmark above (because it is
more than 6% slower), but the last one still succeeds (even while it is
measurably faster than baseline, deviation is less than 6%). Consider
also using @--hide-successes@ to show only problematic benchmarks, or
even [@tasty-rerun@](http://hackage.haskell.org/package/tasty-rerun)
package to focus on rerunning failing items only.

If you wish to compare two CSV reports non-interactively, here is a
handy @awk@ incantation:

> awk 'BEGIN{FS=",";OFS=",";print "Name,Old,New,Ratio"}FNR==1{trueNF=NF;next}NF<trueNF{print "Benchmark names should not contain newlines";exit 1}FNR==NR{oldTime=$(NF-trueNF+2);NF-=trueNF-1;a[$0]=oldTime;next}{newTime=$(NF-trueNF+2);NF-=trueNF-1;if(a[$0]){print $0,a[$0],newTime,newTime/a[$0];gs+=log(newTime/a[$0]);gc++}}END{if(gc>0)print "Geometric mean,,",exp(gs/gc)}' old.csv new.csv

A larger shell snippet to compare two @git@ commits can be found in
@compare_benches.sh@.

Note that columns in CSV report are different from what @criterion@ or
@gauge@ would produce. If names do not contain commas, missing columns
can be faked this way:

> awk 'BEGIN{FS=",";OFS=",";print "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB"}NR==1{trueNF=NF;next}NF<trueNF{print $0;next}{mean=$(NF-trueNF+2);stddev=$(NF-trueNF+3);NF-=trueNF-1;print $0,mean/1e12,mean/1e12,mean/1e12,stddev/2e12,stddev/2e12,stddev/2e12}'

To fake @gauge@ in @--csvraw@ mode use

> awk 'BEGIN{FS=",";OFS=",";print "name,iters,time,cycles,cpuTime,utime,stime,maxrss,minflt,majflt,nvcsw,nivcsw,allocated,numGcs,bytesCopied,mutatorWallSeconds,mutatorCpuSeconds,gcWallSeconds,gcCpuSeconds"}NR==1{trueNF=NF;next}NF<trueNF{print $0;next}{mean=$(NF-trueNF+2);fourth=$(NF-trueNF+4);fifth=$(NF-trueNF+5);sixth=$(NF-trueNF+6);NF-=trueNF-1;print $0,1,mean/1e12,0,mean/1e12,mean/1e12,0,sixth+0,0,0,0,0,fourth+0,0,fifth+0,0,0,0,0}'

=== Comparison between benchmarks

You can also compare benchmarks to each other without any external
tools, all in the comfort of your terminal.

> 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"
>     [ bcompare "tenth"  $ bench "fifth"     $ nf fibo  5
>     ,                     bench "tenth"     $ nf fibo 10
>     , bcompare "tenth"  $ bench "twentieth" $ nf fibo 20
>     ]
>   ]

This produces a report, comparing mean times of @fifth@ and @twentieth@
to @tenth@:

> All
>   Fibonacci numbers
>     fifth:     OK (16.56s)
>       121 ns ± 2.6 ns, 0.08x
>     tenth:     OK (6.84s)
>       1.6 μs ±  31 ns
>     twentieth: OK (6.96s)
>       203 μs ± 4.1 μs, 128.36x

To locate a baseline benchmark in a larger suite use 'locateBenchmark'.

One can leverage comparisons between benchmarks to implement portable
performance tests, expressing properties like “this algorithm must be at
least twice faster than that one” or “this operation should not be more
than thrice slower than that”. This can be achieved with
'bcompareWithin', which takes an acceptable interval of performance as
an argument.

=== Plotting results

Users can dump results into CSV with @--csv@ @FILE@ and plot them using
@gnuplot@ or other software. But for convenience there is also a
built-in quick-and-dirty SVG plotting feature, which can be invoked by
passing @--svg@ @FILE@. Here is a sample of its output:

![Plotting](example.svg)


=== Build flags

Build flags are a brittle subject and users do not normally need to
touch them.

-   If you find yourself in an environment, where @tasty@ is not
    available and you have access to boot packages only, you can still
    use @tasty-bench@! Just copy @Test\/Tasty\/Bench.hs@ to your project
    (imagine it like a header-only C library). It will provide you with
    functions to build 'Benchmarkable' and run them manually via
    'measureCpuTime'. This mode of operation can be also configured by
    disabling Cabal flag @tasty@.

=== Command-line options

Use @--help@ to list all 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/UnkindPartition/tasty#patterns)
    for details.

[@-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) will result in a
    benchmark failure. One can adjust it locally for a group of
    benchmarks, e. g., 'localOption' ('mkTimeout' 100000000) for 100
    seconds.

[@--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. It can also be adjusted locally
    for a group of benchmarks, e. g., 'localOption' ('RelStDev' 0.02). If
    benchmarking takes far too long, consider setting @--timeout@, which
    will interrupt benchmarks, potentially before reaching the target
    deviation.

[@--csv@]:

    File to write results in CSV format.

[@--baseline@]:

    File to read baseline results in CSV format (as produced by
    @--csv@).

[@--fail-if-slower@, @--fail-if-faster@]:

    Upper bounds of acceptable slow down \/ speed up in percents. If a
    benchmark is unacceptably slower \/ faster than baseline (see
    @--baseline@), it will be reported as failed. Can be used in
    conjunction with a standard @tasty@ option @--hide-successes@ to
    show only problematic benchmarks. Both options can be adjusted
    locally for a group of benchmarks, e. g.,
    'localOption' ('FailIfSlower' 0.10).

[@--svg@]:

    File to plot results in SVG format.

[@--time-mode@]:

    Whether to measure CPU time (@cpu@, default) or wall-clock time
    (@wall@).

[@+RTS@ @-T@]:

    Estimate and report memory usage.

=== Custom command-line options

As usual with @tasty@, it is easy to extend benchmarks with custom
command-line options. Here is an example:

> import Data.Proxy
> import Test.Tasty.Bench
> import Test.Tasty.Ingredients.Basic
> import Test.Tasty.Options
> import Test.Tasty.Runners
>
> newtype RandomSeed = RandomSeed Int
>
> instance IsOption RandomSeed where
>   defaultValue = RandomSeed 42
>   parseValue = fmap RandomSeed . safeRead
>   optionName = pure "seed"
>   optionHelp = pure "Random seed used in benchmarks"
>
> main :: IO ()
> main = do
>   let customOpts  = [Option (Proxy :: Proxy RandomSeed)]
>       ingredients = includingOptions customOpts : benchIngredients
>   opts <- parseOptions ingredients benchmarks
>   let RandomSeed seed = lookupOption opts
>   defaultMainWithIngredients ingredients benchmarks
>
> benchmarks :: Benchmark
> benchmarks = bgroup "All" []

-}

{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Test.Tasty.Bench
  (
#ifdef MIN_VERSION_tasty
  -- * Running 'Benchmark'
    defaultMain
  , Benchmark
  , bench
  , bgroup
  , bcompare
  , bcompareWithin
  , env
  , envWithCleanup
  ,
#endif
  -- * Creating 'Benchmarkable'
    Benchmarkable(..)
  , nf
  , whnf
  , nfIO
  , whnfIO
  , nfAppIO
  , whnfAppIO
  , measureCpuTime
  , measureCpuTimeAndStDev
#ifdef MIN_VERSION_tasty
  -- * Ingredients
  , benchIngredients
  , consoleBenchReporter
  , csvReporter
  , svgReporter
  , RelStDev(..)
  , FailIfSlower(..)
  , FailIfFaster(..)
  , CsvPath(..)
  , BaselinePath(..)
  , SvgPath(..)
  , TimeMode(..)
  -- * Utilities
  , locateBenchmark
  , mapLeafBenchmarks
#else
  , Timeout(..)
  , RelStDev(..)
#endif
  ) where

import Prelude hiding (Int, Integer)
import qualified Prelude
import Control.Applicative
import Control.Arrow (first, second)
import Control.DeepSeq (NFData, force, rnf)
import Control.Exception (bracket, bracket_, evaluate)
import Control.Monad (void, unless, guard, (>=>), when)
import Data.Foldable (foldMap, traverse_)
import Data.Int (Int64)
import Data.IORef
import Data.List (intercalate, stripPrefix, isPrefixOf, genericLength, genericDrop, foldl1')
import Data.Maybe (fromMaybe)
import Data.Monoid (All(..), Any(..))
import Data.Proxy
import Data.Traversable (forM)
import Data.Word (Word64)
import GHC.Conc
import GHC.IO.Encoding
import GHC.Stats
import GHC.Types (SPEC(..))
import System.CPUTime
import System.Exit
import System.IO
import System.IO.Unsafe
import System.Mem
import Text.Printf

#ifdef MIN_VERSION_tasty
import Data.Semigroup (Semigroup(..))
import qualified Data.IntMap.Strict as IM
import Data.IntMap (IntMap)
import Data.Sequence (Seq, (<|))
import qualified Data.Sequence as Seq
import qualified Data.Set as S
import Test.Tasty hiding (defaultMain)
import qualified Test.Tasty
import Test.Tasty.Ingredients
import Test.Tasty.Ingredients.ConsoleReporter
import Test.Tasty.Options
import Test.Tasty.Patterns.Eval (eval, asB, withFields)
import Test.Tasty.Patterns.Types (Expr (And, Field, IntLit, NF, StringLit, Sub))
import qualified Test.Tasty.Patterns.Types as Patterns
import Test.Tasty.Providers
import Test.Tasty.Runners
#endif

#if MIN_VERSION_base(4,11,0)
import GHC.Clock (getMonotonicTime)
#else
import Data.Time.Clock.POSIX (getPOSIXTime)
#endif

#if defined(mingw32_HOST_OS)
import Data.Word (Word32)
#endif

#ifndef MIN_VERSION_tasty
data Timeout
  = Timeout
    Prelude.Integer -- ^ number of microseconds (e. g., 200000)
    String          -- ^ textual representation (e. g., @"0.2s"@)
  | NoTimeout
  deriving (Show)

type Progress = ()
#endif


-- | In addition to @--stdev@ command-line option,
-- one can adjust target relative standard deviation
-- for individual benchmarks and groups of benchmarks
-- using 'adjustOption' and 'localOption'.
--
-- E. g., set target relative standard deviation to 2% as follows:
--
-- > import Test.Tasty (localOption)
-- > localOption (RelStDev 0.02) (bgroup [...])
--
-- If you set 'RelStDev' to infinity,
-- a benchmark will be executed
-- only once and its standard deviation will be recorded as zero.
-- This is rather a blunt approach, but it might be a necessary evil
-- for extremely long benchmarks. If you wish to run all benchmarks
-- only once, use command-line option @--stdev@ @Infinity@.
--
-- @since 0.2
newtype RelStDev = RelStDev Double
  deriving
  ( RelStDev -> RelStDev -> Bool
(RelStDev -> RelStDev -> Bool)
-> (RelStDev -> RelStDev -> Bool) -> Eq RelStDev
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelStDev -> RelStDev -> Bool
== :: RelStDev -> RelStDev -> Bool
$c/= :: RelStDev -> RelStDev -> Bool
/= :: RelStDev -> RelStDev -> Bool
Eq
  -- ^ @since 0.4
  , 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
$ccompare :: RelStDev -> RelStDev -> Ordering
compare :: RelStDev -> RelStDev -> Ordering
$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
>= :: RelStDev -> RelStDev -> Bool
$cmax :: RelStDev -> RelStDev -> RelStDev
max :: RelStDev -> RelStDev -> RelStDev
$cmin :: RelStDev -> RelStDev -> RelStDev
min :: RelStDev -> RelStDev -> RelStDev
Ord
  -- ^ @since 0.4
  , Key -> RelStDev -> ShowS
[RelStDev] -> ShowS
RelStDev -> String
(Key -> RelStDev -> ShowS)
-> (RelStDev -> String) -> ([RelStDev] -> ShowS) -> Show RelStDev
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> RelStDev -> ShowS
showsPrec :: Key -> RelStDev -> ShowS
$cshow :: RelStDev -> String
show :: RelStDev -> String
$cshowList :: [RelStDev] -> ShowS
showList :: [RelStDev] -> ShowS
Show
  , ReadPrec [RelStDev]
ReadPrec RelStDev
Key -> ReadS RelStDev
ReadS [RelStDev]
(Key -> ReadS RelStDev)
-> ReadS [RelStDev]
-> ReadPrec RelStDev
-> ReadPrec [RelStDev]
-> Read RelStDev
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS RelStDev
readsPrec :: Key -> ReadS RelStDev
$creadList :: ReadS [RelStDev]
readList :: ReadS [RelStDev]
$creadPrec :: ReadPrec RelStDev
readPrec :: ReadPrec RelStDev
$creadListPrec :: ReadPrec [RelStDev]
readListPrec :: ReadPrec [RelStDev]
Read
  , Integer -> RelStDev
RelStDev -> RelStDev
RelStDev -> RelStDev -> RelStDev
(RelStDev -> RelStDev -> RelStDev)
-> (RelStDev -> RelStDev -> RelStDev)
-> (RelStDev -> RelStDev -> RelStDev)
-> (RelStDev -> RelStDev)
-> (RelStDev -> RelStDev)
-> (RelStDev -> RelStDev)
-> (Integer -> RelStDev)
-> Num RelStDev
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: RelStDev -> RelStDev -> RelStDev
+ :: RelStDev -> RelStDev -> RelStDev
$c- :: RelStDev -> RelStDev -> RelStDev
- :: RelStDev -> RelStDev -> RelStDev
$c* :: RelStDev -> RelStDev -> RelStDev
* :: RelStDev -> RelStDev -> RelStDev
$cnegate :: RelStDev -> RelStDev
negate :: RelStDev -> RelStDev
$cabs :: RelStDev -> RelStDev
abs :: RelStDev -> RelStDev
$csignum :: RelStDev -> RelStDev
signum :: RelStDev -> RelStDev
$cfromInteger :: Integer -> RelStDev
fromInteger :: Integer -> RelStDev
Num
  -- ^ @since 0.4
  , Num RelStDev
Num RelStDev =>
(RelStDev -> RelStDev -> RelStDev)
-> (RelStDev -> RelStDev)
-> (Rational -> RelStDev)
-> Fractional RelStDev
Rational -> RelStDev
RelStDev -> RelStDev
RelStDev -> RelStDev -> RelStDev
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: RelStDev -> RelStDev -> RelStDev
/ :: RelStDev -> RelStDev -> RelStDev
$crecip :: RelStDev -> RelStDev
recip :: RelStDev -> RelStDev
$cfromRational :: Rational -> RelStDev
fromRational :: Rational -> RelStDev
Fractional
  -- ^ @since 0.4
  )

-- | Whether to measure CPU time or wall-clock time.
-- Normally 'CpuTime' is a better option (and default),
-- but consider switching to 'WallTime'
-- to measure multithreaded algorithms or time spent in external processes.
--
-- One can switch the default measurement mode globally
-- using @--time-mode@ command-line option,
-- but it is usually better to adjust the mode locally:
--
-- > import Test.Tasty (localOption)
-- > localOption WallTime (bgroup [...])
--
-- You can measure both times and report their ratio with the following gadget:
--
-- @
-- bgroup \"Foo\"
--   [ localOption WallTime $ bench \"WallTime\" foo
--   , bcompare \"Foo.WallTime\"
--   $ localOption CpuTime  $ bench \"CPUTime\"  foo
--   ]
-- @
--
-- @since 0.3.2
data TimeMode = CpuTime
  -- ^ Measure CPU time.
  | WallTime
  -- ^ Measure wall-clock time.

#ifdef MIN_VERSION_tasty
instance IsOption RelStDev where
  defaultValue :: RelStDev
defaultValue = Double -> RelStDev
RelStDev Double
0.05
  parseValue :: String -> Maybe RelStDev
parseValue = (Double -> RelStDev) -> Maybe Double -> Maybe RelStDev
forall a b. (a -> b) -> Maybe a -> Maybe b
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
parsePositivePercents
  optionName :: Tagged RelStDev String
optionName = String -> Tagged RelStDev String
forall a. a -> Tagged RelStDev a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"stdev"
  optionHelp :: Tagged RelStDev String
optionHelp = String -> Tagged RelStDev String
forall a. a -> Tagged RelStDev a
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."

-- | In addition to @--fail-if-slower@ command-line option,
-- one can adjust an upper bound of acceptable slow down
-- in comparison to baseline for
-- individual benchmarks and groups of benchmarks
-- using 'adjustOption' and 'localOption'.
--
-- E. g., set upper bound of acceptable slow down to 10% as follows:
--
-- > import Test.Tasty (localOption)
-- > localOption (FailIfSlower 0.10) (bgroup [...])
--
-- @since 0.2
newtype FailIfSlower = FailIfSlower Double
  deriving
  ( FailIfSlower -> FailIfSlower -> Bool
(FailIfSlower -> FailIfSlower -> Bool)
-> (FailIfSlower -> FailIfSlower -> Bool) -> Eq FailIfSlower
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfSlower -> FailIfSlower -> Bool
== :: FailIfSlower -> FailIfSlower -> Bool
$c/= :: FailIfSlower -> FailIfSlower -> Bool
/= :: FailIfSlower -> FailIfSlower -> Bool
Eq
  -- ^ @since 0.4
  , Eq FailIfSlower
Eq FailIfSlower =>
(FailIfSlower -> FailIfSlower -> Ordering)
-> (FailIfSlower -> FailIfSlower -> Bool)
-> (FailIfSlower -> FailIfSlower -> Bool)
-> (FailIfSlower -> FailIfSlower -> Bool)
-> (FailIfSlower -> FailIfSlower -> Bool)
-> (FailIfSlower -> FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower -> FailIfSlower)
-> Ord FailIfSlower
FailIfSlower -> FailIfSlower -> Bool
FailIfSlower -> FailIfSlower -> Ordering
FailIfSlower -> FailIfSlower -> FailIfSlower
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
$ccompare :: FailIfSlower -> FailIfSlower -> Ordering
compare :: FailIfSlower -> FailIfSlower -> Ordering
$c< :: FailIfSlower -> FailIfSlower -> Bool
< :: FailIfSlower -> FailIfSlower -> Bool
$c<= :: FailIfSlower -> FailIfSlower -> Bool
<= :: FailIfSlower -> FailIfSlower -> Bool
$c> :: FailIfSlower -> FailIfSlower -> Bool
> :: FailIfSlower -> FailIfSlower -> Bool
$c>= :: FailIfSlower -> FailIfSlower -> Bool
>= :: FailIfSlower -> FailIfSlower -> Bool
$cmax :: FailIfSlower -> FailIfSlower -> FailIfSlower
max :: FailIfSlower -> FailIfSlower -> FailIfSlower
$cmin :: FailIfSlower -> FailIfSlower -> FailIfSlower
min :: FailIfSlower -> FailIfSlower -> FailIfSlower
Ord
  -- ^ @since 0.4
  , Key -> FailIfSlower -> ShowS
[FailIfSlower] -> ShowS
FailIfSlower -> String
(Key -> FailIfSlower -> ShowS)
-> (FailIfSlower -> String)
-> ([FailIfSlower] -> ShowS)
-> Show FailIfSlower
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FailIfSlower -> ShowS
showsPrec :: Key -> FailIfSlower -> ShowS
$cshow :: FailIfSlower -> String
show :: FailIfSlower -> String
$cshowList :: [FailIfSlower] -> ShowS
showList :: [FailIfSlower] -> ShowS
Show
  , ReadPrec [FailIfSlower]
ReadPrec FailIfSlower
Key -> ReadS FailIfSlower
ReadS [FailIfSlower]
(Key -> ReadS FailIfSlower)
-> ReadS [FailIfSlower]
-> ReadPrec FailIfSlower
-> ReadPrec [FailIfSlower]
-> Read FailIfSlower
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfSlower
readsPrec :: Key -> ReadS FailIfSlower
$creadList :: ReadS [FailIfSlower]
readList :: ReadS [FailIfSlower]
$creadPrec :: ReadPrec FailIfSlower
readPrec :: ReadPrec FailIfSlower
$creadListPrec :: ReadPrec [FailIfSlower]
readListPrec :: ReadPrec [FailIfSlower]
Read
  , Integer -> FailIfSlower
FailIfSlower -> FailIfSlower
FailIfSlower -> FailIfSlower -> FailIfSlower
(FailIfSlower -> FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower)
-> (Integer -> FailIfSlower)
-> Num FailIfSlower
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfSlower -> FailIfSlower -> FailIfSlower
+ :: FailIfSlower -> FailIfSlower -> FailIfSlower
$c- :: FailIfSlower -> FailIfSlower -> FailIfSlower
- :: FailIfSlower -> FailIfSlower -> FailIfSlower
$c* :: FailIfSlower -> FailIfSlower -> FailIfSlower
* :: FailIfSlower -> FailIfSlower -> FailIfSlower
$cnegate :: FailIfSlower -> FailIfSlower
negate :: FailIfSlower -> FailIfSlower
$cabs :: FailIfSlower -> FailIfSlower
abs :: FailIfSlower -> FailIfSlower
$csignum :: FailIfSlower -> FailIfSlower
signum :: FailIfSlower -> FailIfSlower
$cfromInteger :: Integer -> FailIfSlower
fromInteger :: Integer -> FailIfSlower
Num
  -- ^ @since 0.4
  , Num FailIfSlower
Num FailIfSlower =>
(FailIfSlower -> FailIfSlower -> FailIfSlower)
-> (FailIfSlower -> FailIfSlower)
-> (Rational -> FailIfSlower)
-> Fractional FailIfSlower
Rational -> FailIfSlower
FailIfSlower -> FailIfSlower
FailIfSlower -> FailIfSlower -> FailIfSlower
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfSlower -> FailIfSlower -> FailIfSlower
/ :: FailIfSlower -> FailIfSlower -> FailIfSlower
$crecip :: FailIfSlower -> FailIfSlower
recip :: FailIfSlower -> FailIfSlower
$cfromRational :: Rational -> FailIfSlower
fromRational :: Rational -> FailIfSlower
Fractional
  -- ^ @since 0.4
  )

instance IsOption FailIfSlower where
  defaultValue :: FailIfSlower
defaultValue = Double -> FailIfSlower
FailIfSlower (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: String -> Maybe FailIfSlower
parseValue = (Double -> FailIfSlower) -> Maybe Double -> Maybe FailIfSlower
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfSlower
FailIfSlower (Maybe Double -> Maybe FailIfSlower)
-> (String -> Maybe Double) -> String -> Maybe FailIfSlower
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
  optionName :: Tagged FailIfSlower String
optionName = String -> Tagged FailIfSlower String
forall a. a -> Tagged FailIfSlower a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-slower"
  optionHelp :: Tagged FailIfSlower String
optionHelp = String -> Tagged FailIfSlower String
forall a. a -> Tagged FailIfSlower a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Upper bound of acceptable slow down in percents. If a benchmark is unacceptably slower than baseline (see --baseline), it will be reported as failed."

-- | In addition to @--fail-if-faster@ command-line option,
-- one can adjust an upper bound of acceptable speed up
-- in comparison to baseline for
-- individual benchmarks and groups of benchmarks
-- using 'adjustOption' and 'localOption'.
--
-- E. g., set upper bound of acceptable speed up to 10% as follows:
--
-- > import Test.Tasty (localOption)
-- > localOption (FailIfFaster 0.10) (bgroup [...])
--
-- @since 0.2
newtype FailIfFaster = FailIfFaster Double
  deriving
  ( FailIfFaster -> FailIfFaster -> Bool
(FailIfFaster -> FailIfFaster -> Bool)
-> (FailIfFaster -> FailIfFaster -> Bool) -> Eq FailIfFaster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfFaster -> FailIfFaster -> Bool
== :: FailIfFaster -> FailIfFaster -> Bool
$c/= :: FailIfFaster -> FailIfFaster -> Bool
/= :: FailIfFaster -> FailIfFaster -> Bool
Eq
  -- ^ @since 0.4
  , Eq FailIfFaster
Eq FailIfFaster =>
(FailIfFaster -> FailIfFaster -> Ordering)
-> (FailIfFaster -> FailIfFaster -> Bool)
-> (FailIfFaster -> FailIfFaster -> Bool)
-> (FailIfFaster -> FailIfFaster -> Bool)
-> (FailIfFaster -> FailIfFaster -> Bool)
-> (FailIfFaster -> FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster -> FailIfFaster)
-> Ord FailIfFaster
FailIfFaster -> FailIfFaster -> Bool
FailIfFaster -> FailIfFaster -> Ordering
FailIfFaster -> FailIfFaster -> FailIfFaster
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
$ccompare :: FailIfFaster -> FailIfFaster -> Ordering
compare :: FailIfFaster -> FailIfFaster -> Ordering
$c< :: FailIfFaster -> FailIfFaster -> Bool
< :: FailIfFaster -> FailIfFaster -> Bool
$c<= :: FailIfFaster -> FailIfFaster -> Bool
<= :: FailIfFaster -> FailIfFaster -> Bool
$c> :: FailIfFaster -> FailIfFaster -> Bool
> :: FailIfFaster -> FailIfFaster -> Bool
$c>= :: FailIfFaster -> FailIfFaster -> Bool
>= :: FailIfFaster -> FailIfFaster -> Bool
$cmax :: FailIfFaster -> FailIfFaster -> FailIfFaster
max :: FailIfFaster -> FailIfFaster -> FailIfFaster
$cmin :: FailIfFaster -> FailIfFaster -> FailIfFaster
min :: FailIfFaster -> FailIfFaster -> FailIfFaster
Ord
  -- ^ @since 0.4
  , Key -> FailIfFaster -> ShowS
[FailIfFaster] -> ShowS
FailIfFaster -> String
(Key -> FailIfFaster -> ShowS)
-> (FailIfFaster -> String)
-> ([FailIfFaster] -> ShowS)
-> Show FailIfFaster
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> FailIfFaster -> ShowS
showsPrec :: Key -> FailIfFaster -> ShowS
$cshow :: FailIfFaster -> String
show :: FailIfFaster -> String
$cshowList :: [FailIfFaster] -> ShowS
showList :: [FailIfFaster] -> ShowS
Show
  , ReadPrec [FailIfFaster]
ReadPrec FailIfFaster
Key -> ReadS FailIfFaster
ReadS [FailIfFaster]
(Key -> ReadS FailIfFaster)
-> ReadS [FailIfFaster]
-> ReadPrec FailIfFaster
-> ReadPrec [FailIfFaster]
-> Read FailIfFaster
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfFaster
readsPrec :: Key -> ReadS FailIfFaster
$creadList :: ReadS [FailIfFaster]
readList :: ReadS [FailIfFaster]
$creadPrec :: ReadPrec FailIfFaster
readPrec :: ReadPrec FailIfFaster
$creadListPrec :: ReadPrec [FailIfFaster]
readListPrec :: ReadPrec [FailIfFaster]
Read
  , Integer -> FailIfFaster
FailIfFaster -> FailIfFaster
FailIfFaster -> FailIfFaster -> FailIfFaster
(FailIfFaster -> FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster)
-> (Integer -> FailIfFaster)
-> Num FailIfFaster
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfFaster -> FailIfFaster -> FailIfFaster
+ :: FailIfFaster -> FailIfFaster -> FailIfFaster
$c- :: FailIfFaster -> FailIfFaster -> FailIfFaster
- :: FailIfFaster -> FailIfFaster -> FailIfFaster
$c* :: FailIfFaster -> FailIfFaster -> FailIfFaster
* :: FailIfFaster -> FailIfFaster -> FailIfFaster
$cnegate :: FailIfFaster -> FailIfFaster
negate :: FailIfFaster -> FailIfFaster
$cabs :: FailIfFaster -> FailIfFaster
abs :: FailIfFaster -> FailIfFaster
$csignum :: FailIfFaster -> FailIfFaster
signum :: FailIfFaster -> FailIfFaster
$cfromInteger :: Integer -> FailIfFaster
fromInteger :: Integer -> FailIfFaster
Num
  -- ^ @since 0.4
  , Num FailIfFaster
Num FailIfFaster =>
(FailIfFaster -> FailIfFaster -> FailIfFaster)
-> (FailIfFaster -> FailIfFaster)
-> (Rational -> FailIfFaster)
-> Fractional FailIfFaster
Rational -> FailIfFaster
FailIfFaster -> FailIfFaster
FailIfFaster -> FailIfFaster -> FailIfFaster
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfFaster -> FailIfFaster -> FailIfFaster
/ :: FailIfFaster -> FailIfFaster -> FailIfFaster
$crecip :: FailIfFaster -> FailIfFaster
recip :: FailIfFaster -> FailIfFaster
$cfromRational :: Rational -> FailIfFaster
fromRational :: Rational -> FailIfFaster
Fractional
  -- ^ @since 0.4
  )

instance IsOption FailIfFaster where
  defaultValue :: FailIfFaster
defaultValue = Double -> FailIfFaster
FailIfFaster (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: String -> Maybe FailIfFaster
parseValue = (Double -> FailIfFaster) -> Maybe Double -> Maybe FailIfFaster
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfFaster
FailIfFaster (Maybe Double -> Maybe FailIfFaster)
-> (String -> Maybe Double) -> String -> Maybe FailIfFaster
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Double
parsePositivePercents
  optionName :: Tagged FailIfFaster String
optionName = String -> Tagged FailIfFaster String
forall a. a -> Tagged FailIfFaster a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"fail-if-faster"
  optionHelp :: Tagged FailIfFaster String
optionHelp = String -> Tagged FailIfFaster String
forall a. a -> Tagged FailIfFaster a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Upper bound of acceptable speed up in percents. If a benchmark is unacceptably faster than baseline (see --baseline), it will be reported as failed."

parsePositivePercents :: String -> Maybe Double
parsePositivePercents :: String -> Maybe Double
parsePositivePercents String
xs = do
  Double
x <- String -> Maybe Double
forall a. Read a => String -> Maybe a
safeRead String
xs
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
  Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)

instance IsOption TimeMode where
  defaultValue :: TimeMode
defaultValue = TimeMode
CpuTime
  parseValue :: String -> Maybe TimeMode
parseValue String
v = case String
v of
    String
"cpu" -> TimeMode -> Maybe TimeMode
forall a. a -> Maybe a
Just TimeMode
CpuTime
    String
"wall" -> TimeMode -> Maybe TimeMode
forall a. a -> Maybe a
Just TimeMode
WallTime
    String
_ -> Maybe TimeMode
forall a. Maybe a
Nothing
  optionName :: Tagged TimeMode String
optionName = String -> Tagged TimeMode String
forall a. a -> Tagged TimeMode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"time-mode"
  optionHelp :: Tagged TimeMode String
optionHelp = String -> Tagged TimeMode String
forall a. a -> Tagged TimeMode a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"Whether to measure CPU time (\"cpu\") or wall-clock time (\"wall\")"
  showDefaultValue :: TimeMode -> Maybe String
showDefaultValue TimeMode
m = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ case TimeMode
m of
    TimeMode
CpuTime -> String
"cpu"
    TimeMode
WallTime -> String
"wall"
#endif

-- | Something that can be benchmarked, produced by 'nf', 'whnf', 'nfIO', 'whnfIO',
-- 'nfAppIO', 'whnfAppIO' below.
--
-- Drop-in replacement for @Criterion.@'Criterion.Benchmarkable' and
-- @Gauge.@'Gauge.Benchmarkable'.
--
-- @since 0.1
newtype Benchmarkable =
    -- | @since 0.3
    Benchmarkable
  { Benchmarkable -> Word64 -> IO ()
unBenchmarkable :: Word64 -> IO () -- ^ Run benchmark given number of times.
  }

#ifdef MIN_VERSION_tasty

-- | 'defaultMain' forces 'setLocaleEncoding' to 'utf8', but users might
-- be running benchmarks outside of it (e. g., via 'defaultMainWithIngredients').
supportsUnicode :: Bool
supportsUnicode :: Bool
supportsUnicode = Key -> ShowS
forall a. Key -> [a] -> [a]
take Key
3 (TextEncoding -> String
textEncodingName TextEncoding
enc) String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"UTF"
#if defined(mingw32_HOST_OS)
  && unsafePerformIO getConsoleOutputCP == 65001
#endif
  where
    enc :: TextEncoding
enc = IO TextEncoding -> TextEncoding
forall a. IO a -> a
unsafePerformIO IO TextEncoding
getLocaleEncoding
{-# NOINLINE supportsUnicode #-}

mu :: Char
mu :: Char
mu = if Bool
supportsUnicode then Char
'μ' else Char
'u'

pm :: String
pm :: String
pm = if Bool
supportsUnicode then String
" ± " else String
" +-"

-- | Show picoseconds, fitting number in 3 characters.
showPicos3 :: Word64 -> String
showPicos3 :: Word64 -> String
showPicos3 Word64
i
  | Double
t 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
t 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
t 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
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e4 = String -> Double -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f %cs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e6 = String -> Double -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f %cs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
  | Double
t 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
t 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
"%4.2f s"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12)
  where
    t :: Double
t = Word64 -> Double
word64ToDouble Word64
i

-- | Show picoseconds, fitting number in 4 characters.
showPicos4 :: Word64 -> String
showPicos4 :: Word64 -> String
showPicos4 Word64
i
  | Double
t 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
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e1 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f ns"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e2 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f ns"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e3)
  | Double
t 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
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e4 = String -> Double -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f %cs"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e5 = String -> Double -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f %cs"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e6 = String -> Double -> Char -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f  %cs" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e6) Char
mu
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e7 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.2f ms"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
995e8 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%4.1f ms"  (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e9)
  | Double
t 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
"%4.3f s"   (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12)
  where
    t :: Double
t = Word64 -> Double
word64ToDouble Word64
i

showBytes :: Word64 -> String
showBytes :: Word64 -> String
showBytes Word64
i
  | Double
t 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
t 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
t 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
t 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
t 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
t 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
t 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)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
10940140696372       = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f TB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1098961871962112     = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f TB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1099511627776)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
11202704073084108    = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f PB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
1125336956889202624  = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f PB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1125899906842624)
  | Double
t Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
11471568970838126592 = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.1f EB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
  | Bool
otherwise                = String -> Double -> String
forall r. PrintfType r => String -> r
printf String
"%3.0f EB" (Double
t Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1152921504606846976)
  where
    t :: Double
t = Word64 -> Double
word64ToDouble Word64
i
#endif

data Measurement = Measurement
  { Measurement -> Word64
measTime   :: !Word64 -- ^ time in picoseconds
  , Measurement -> Word64
measAllocs :: !Word64 -- ^ allocations in bytes
  , Measurement -> Word64
measCopied :: !Word64 -- ^ copied bytes
  , Measurement -> Word64
measMaxMem :: !Word64 -- ^ max memory in use
  } deriving (Key -> Measurement -> ShowS
[Measurement] -> ShowS
Measurement -> String
(Key -> Measurement -> ShowS)
-> (Measurement -> String)
-> ([Measurement] -> ShowS)
-> Show Measurement
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> Measurement -> ShowS
showsPrec :: Key -> Measurement -> ShowS
$cshow :: Measurement -> String
show :: Measurement -> String
$cshowList :: [Measurement] -> ShowS
showList :: [Measurement] -> ShowS
Show, ReadPrec [Measurement]
ReadPrec Measurement
Key -> ReadS Measurement
ReadS [Measurement]
(Key -> ReadS Measurement)
-> ReadS [Measurement]
-> ReadPrec Measurement
-> ReadPrec [Measurement]
-> Read Measurement
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS Measurement
readsPrec :: Key -> ReadS Measurement
$creadList :: ReadS [Measurement]
readList :: ReadS [Measurement]
$creadPrec :: ReadPrec Measurement
readPrec :: ReadPrec Measurement
$creadListPrec :: ReadPrec [Measurement]
readListPrec :: ReadPrec [Measurement]
Read)

data Estimate = Estimate
  { Estimate -> Measurement
estMean  :: !Measurement
  , Estimate -> Word64
estStdev :: !Word64  -- ^ standard deviation in picoseconds
  } deriving (Key -> Estimate -> ShowS
[Estimate] -> ShowS
Estimate -> String
(Key -> Estimate -> ShowS)
-> (Estimate -> String) -> ([Estimate] -> ShowS) -> Show Estimate
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Key -> Estimate -> ShowS
showsPrec :: Key -> Estimate -> ShowS
$cshow :: Estimate -> String
show :: Estimate -> String
$cshowList :: [Estimate] -> ShowS
showList :: [Estimate] -> ShowS
Show, ReadPrec [Estimate]
ReadPrec Estimate
Key -> ReadS Estimate
ReadS [Estimate]
(Key -> ReadS Estimate)
-> ReadS [Estimate]
-> ReadPrec Estimate
-> ReadPrec [Estimate]
-> Read Estimate
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS Estimate
readsPrec :: Key -> ReadS Estimate
$creadList :: ReadS [Estimate]
readList :: ReadS [Estimate]
$creadPrec :: ReadPrec Estimate
readPrec :: ReadPrec Estimate
$creadListPrec :: ReadPrec [Estimate]
readListPrec :: ReadPrec [Estimate]
Read)

#ifdef MIN_VERSION_tasty

data WithLoHi a = WithLoHi
  !a      -- payload
  !Double -- lower bound (e. g., 0.9 for -10% speedup)
  !Double -- upper bound (e. g., 1.2 for +20% slowdown)
  deriving (Key -> WithLoHi a -> ShowS
[WithLoHi a] -> ShowS
WithLoHi a -> String
(Key -> WithLoHi a -> ShowS)
-> (WithLoHi a -> String)
-> ([WithLoHi a] -> ShowS)
-> Show (WithLoHi a)
forall a. Show a => Key -> WithLoHi a -> ShowS
forall a. Show a => [WithLoHi a] -> ShowS
forall a. Show a => WithLoHi a -> String
forall a.
(Key -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Key -> WithLoHi a -> ShowS
showsPrec :: Key -> WithLoHi a -> ShowS
$cshow :: forall a. Show a => WithLoHi a -> String
show :: WithLoHi a -> String
$cshowList :: forall a. Show a => [WithLoHi a] -> ShowS
showList :: [WithLoHi a] -> ShowS
Show, ReadPrec [WithLoHi a]
ReadPrec (WithLoHi a)
Key -> ReadS (WithLoHi a)
ReadS [WithLoHi a]
(Key -> ReadS (WithLoHi a))
-> ReadS [WithLoHi a]
-> ReadPrec (WithLoHi a)
-> ReadPrec [WithLoHi a]
-> Read (WithLoHi a)
forall a. Read a => ReadPrec [WithLoHi a]
forall a. Read a => ReadPrec (WithLoHi a)
forall a. Read a => Key -> ReadS (WithLoHi a)
forall a. Read a => ReadS [WithLoHi a]
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Key -> ReadS (WithLoHi a)
readsPrec :: Key -> ReadS (WithLoHi a)
$creadList :: forall a. Read a => ReadS [WithLoHi a]
readList :: ReadS [WithLoHi a]
$creadPrec :: forall a. Read a => ReadPrec (WithLoHi a)
readPrec :: ReadPrec (WithLoHi a)
$creadListPrec :: forall a. Read a => ReadPrec [WithLoHi a]
readListPrec :: ReadPrec [WithLoHi a]
Read)

prettyEstimate :: Estimate -> String
prettyEstimate :: Estimate -> String
prettyEstimate (Estimate Measurement
m Word64
stdev) =
  Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then String
"         " else String
pm String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev))

prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC :: Estimate -> String
prettyEstimateWithGC (Estimate Measurement
m Word64
stdev) =
  Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ (if Word64
stdev Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0 then String
",          " else String
pm String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos3 (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", ")
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measAllocs Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" allocated, "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measCopied Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" copied, "
  String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showBytes (Measurement -> Word64
measMaxMem Measurement
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" peak memory"

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

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

predict
  :: Measurement -- ^ time for one run
  -> Measurement -- ^ time for two runs
  -> Estimate
predict :: Measurement -> Measurement -> Estimate
predict (Measurement Word64
t1 Word64
a1 Word64
c1 Word64
m1) (Measurement Word64
t2 Word64
a2 Word64
c2 Word64
m2) = Estimate
  { estMean :: Measurement
estMean  = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement Word64
t (Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
fit Word64
a1 Word64
a2) (Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
fit Word64
c1 Word64
c2) (Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
m1 Word64
m2)
  , estStdev :: Word64
estStdev = Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double
forall a. Floating a => a -> a
sqrt Double
d :: Double)
  }
  where
    fit :: a -> a -> a
fit a
x1 a
x2 = a
x1 a -> a -> a
forall {a}. Integral a => a -> a -> a
`quot` a
5 a -> a -> a
forall a. Num a => a -> a -> a
+ a
2 a -> a -> a
forall a. Num a => a -> a -> a
* (a
x2 a -> a -> a
forall {a}. Integral a => a -> a -> a
`quot` a
5)
    t :: Word64
t = Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
fit Word64
t1 Word64
t2
    sqr :: a -> a
sqr a
x = a
x a -> a -> a
forall a. Num a => a -> a -> a
* a
x
    d :: Double
d = Double -> Double
forall {a}. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t1 Double -> Double -> Double
forall a. Num a => a -> a -> a
-     Word64 -> Double
word64ToDouble Word64
t)
      Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double -> Double
forall {a}. Num a => a -> a
sqr (Word64 -> Double
word64ToDouble Word64
t2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
t)

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

hasGCStats :: Bool
#if MIN_VERSION_base(4,10,0)
hasGCStats :: Bool
hasGCStats = IO Bool -> Bool
forall a. IO a -> a
unsafePerformIO IO Bool
getRTSStatsEnabled
#else
hasGCStats = unsafePerformIO getGCStatsEnabled
#endif

getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied :: IO (Word64, Word64, Word64)
getAllocsAndCopied = do
  if Bool -> Bool
not Bool
hasGCStats then (Word64, Word64, Word64) -> IO (Word64, Word64, Word64)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64
0, Word64
0, Word64
0) else
#if MIN_VERSION_base(4,10,0)
    (\RTSStats
s -> (RTSStats -> Word64
allocated_bytes RTSStats
s, RTSStats -> Word64
copied_bytes RTSStats
s, RTSStats -> Word64
max_mem_in_use_bytes RTSStats
s)) (RTSStats -> (Word64, Word64, Word64))
-> IO RTSStats -> IO (Word64, Word64, Word64)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO RTSStats
getRTSStats
#else
    (\s -> (int64ToWord64 $ bytesAllocated s, int64ToWord64 $ bytesCopied s, int64ToWord64 $ peakMegabytesAllocated s * 1024 * 1024)) <$> getGCStats
#endif

getWallTimeSecs :: IO Double
#if MIN_VERSION_base(4,11,0)
getWallTimeSecs :: IO Double
getWallTimeSecs = IO Double
getMonotonicTime
#else
getWallTimeSecs = realToFrac <$> getPOSIXTime
#endif

getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs :: TimeMode -> IO Word64
getTimePicoSecs TimeMode
timeMode = case TimeMode
timeMode of
  TimeMode
CpuTime -> Integer -> Word64
forall a. Num a => Integer -> a
fromInteger (Integer -> Word64) -> IO Integer -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Integer
getCPUTime
  TimeMode
WallTime -> Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Word64) -> (Double -> Double) -> Double -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double
1e12 Double -> Double -> Double
forall a. Num a => a -> a -> a
*) (Double -> Word64) -> IO Double -> IO Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Double
getWallTimeSecs

measure :: TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure :: TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode Word64
n (Benchmarkable Word64 -> IO ()
act) = do
  let getTimePicoSecs' :: IO Word64
getTimePicoSecs' = TimeMode -> IO Word64
getTimePicoSecs TimeMode
timeMode
  IO ()
performGC
  Word64
startTime <- IO Word64
getTimePicoSecs'
  (Word64
startAllocs, Word64
startCopied, Word64
startMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
  Word64 -> IO ()
act Word64
n
  Word64
endTime <- IO Word64
getTimePicoSecs'
  IO ()
performMinorGC -- perform GC to update RTSStats
  (Word64
endAllocs, Word64
endCopied, Word64
endMaxMemInUse) <- IO (Word64, Word64, Word64)
getAllocsAndCopied
  let meas :: Measurement
meas = Measurement
        { measTime :: Word64
measTime   = Word64
endTime Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startTime
        , measAllocs :: Word64
measAllocs = Word64
endAllocs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startAllocs
        , measCopied :: Word64
measCopied = Word64
endCopied Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
startCopied
        , measMaxMem :: Word64
measMaxMem = Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
endMaxMemInUse Word64
startMaxMemInUse
        }
  Measurement -> IO Measurement
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Measurement
meas

measureUntil
    :: (Progress -> IO ())
    -> TimeMode
    -> Timeout
    -> RelStDev
    -> Benchmarkable
    -> IO Estimate
measureUntil :: (Progress -> IO ())
-> TimeMode -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil Progress -> IO ()
_ TimeMode
timeMode Timeout
_ (RelStDev Double
targetRelStDev) Benchmarkable
b
  | Double -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Double
targetRelStDev, Double
targetRelStDev Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0 = do
  Measurement
t1 <- TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode Word64
1 Benchmarkable
b
  Estimate -> IO Estimate
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Estimate -> IO Estimate) -> Estimate -> IO Estimate
forall a b. (a -> b) -> a -> b
$ Estimate { estMean :: Measurement
estMean = Measurement
t1, estStdev :: Word64
estStdev = Word64
0 }
measureUntil Progress -> IO ()
yieldProgress TimeMode
timeMode Timeout
timeout (RelStDev Double
targetRelStDev) Benchmarkable
b = do
  Measurement
t1 <- Word64 -> Benchmarkable -> IO Measurement
measure' Word64
1 Benchmarkable
b
  Word64 -> Measurement -> Word64 -> IO Estimate
go Word64
1 Measurement
t1 Word64
0
  where
    measure' :: Word64 -> Benchmarkable -> IO Measurement
measure' = TimeMode -> Word64 -> Benchmarkable -> IO Measurement
measure TimeMode
timeMode

    go :: Word64 -> Measurement -> Word64 -> IO Estimate
    go :: Word64 -> Measurement -> Word64 -> IO Estimate
go Word64
n Measurement
t1 Word64
sumOfTs = do
      Measurement
t2 <- Word64 -> Benchmarkable -> IO Measurement
measure' (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n) Benchmarkable
b

      let Estimate (Measurement Word64
meanN Word64
allocN Word64
copiedN Word64
maxMemN) Word64
stdevN = Measurement -> Measurement -> Estimate
predictPerturbed Measurement
t1 Measurement
t2
          isTimeoutSoon :: Bool
isTimeoutSoon = case Timeout
timeout of
            Timeout
NoTimeout -> Bool
False
            -- multiplying by 12/10 helps to avoid accidental timeouts
            Timeout Integer
micros String
_ -> (Word64
sumOfTs' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
3 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Measurement -> Word64
measTime Measurement
t2) Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` (Word64
1000000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10 Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` Word64
12) Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
micros
          isStDevInTargetRange :: Bool
isStDevInTargetRange = Word64
stdevN Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Double -> Word64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
0 Double
targetRelStDev Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word64 -> Double
word64ToDouble Word64
meanN)
          scale :: Word64 -> Word64
scale = (Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` Word64
n)
          sumOfTs' :: Word64
sumOfTs' = Word64
sumOfTs Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Measurement -> Word64
measTime Measurement
t1

      let scaledEstimate :: Estimate
scaledEstimate = Estimate
            { estMean :: Measurement
estMean  = Word64 -> Word64 -> Word64 -> Word64 -> Measurement
Measurement (Word64 -> Word64
scale Word64
meanN) (Word64 -> Word64
scale Word64
allocN) (Word64 -> Word64
scale Word64
copiedN) Word64
maxMemN
            , estStdev :: Word64
estStdev = Word64 -> Word64
scale Word64
stdevN }

#ifdef MIN_VERSION_tasty
      Progress -> IO ()
yieldProgress (Progress -> IO ()) -> Progress -> IO ()
forall a b. (a -> b) -> a -> b
$ Progress
        { progressText :: String
progressText = Estimate -> String
prettyEstimate Estimate
scaledEstimate
        , progressPercent :: Float
progressPercent = Float
0.0
        }
#else
      yieldProgress ()
#endif

      if Bool
isStDevInTargetRange Bool -> Bool -> Bool
|| Bool
isTimeoutSoon
        then Estimate -> IO Estimate
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Estimate
scaledEstimate
        else Word64 -> Measurement -> Word64 -> IO Estimate
go (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
n) Measurement
t2 Word64
sumOfTs'

-- | An internal routine to measure CPU execution time in seconds
-- for a given timeout (put 'NoTimeout', or 'mkTimeout' 100000000 for 100 seconds)
-- and a target relative standard deviation
-- (put 'RelStDev' 0.05 for 5% or 'RelStDev' (1/0) to run only one iteration).
--
-- 'Timeout' takes soft priority over 'RelStDev': this function prefers
-- to finish in time even if at cost of precision. However, timeout is guidance
-- not guarantee: 'measureCpuTime' can take longer, if there is not enough time
-- to run at least thrice or an iteration takes unusually long.
--
-- @since 0.3
measureCpuTime :: Timeout -> RelStDev -> Benchmarkable -> IO Double
measureCpuTime :: Timeout -> RelStDev -> Benchmarkable -> IO Double
measureCpuTime = ((((Double, Double) -> Double) -> IO (Double, Double) -> IO Double
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, Double) -> Double
forall a b. (a, b) -> a
fst (IO (Double, Double) -> IO Double)
-> (Benchmarkable -> IO (Double, Double))
-> Benchmarkable
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Benchmarkable -> IO (Double, Double))
 -> Benchmarkable -> IO Double)
-> (RelStDev -> Benchmarkable -> IO (Double, Double))
-> RelStDev
-> Benchmarkable
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((RelStDev -> Benchmarkable -> IO (Double, Double))
 -> RelStDev -> Benchmarkable -> IO Double)
-> (Timeout -> RelStDev -> Benchmarkable -> IO (Double, Double))
-> Timeout
-> RelStDev
-> Benchmarkable
-> IO Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timeout -> RelStDev -> Benchmarkable -> IO (Double, Double)
measureCpuTimeAndStDev

-- | Same as 'measureCpuTime', but returns both CPU execution time
-- and its standard deviation.
--
-- @since 0.3.4
measureCpuTimeAndStDev :: Timeout -> RelStDev -> Benchmarkable -> IO (Double, Double)
measureCpuTimeAndStDev :: Timeout -> RelStDev -> Benchmarkable -> IO (Double, Double)
measureCpuTimeAndStDev
    = (((Estimate -> (Double, Double))
-> IO Estimate -> IO (Double, Double)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Estimate
x ->
        ( Word64 -> Double
word64ToDouble (Measurement -> Word64
measTime (Estimate -> Measurement
estMean Estimate
x)) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12
        , Word64 -> Double
word64ToDouble (Estimate -> Word64
estStdev Estimate
x) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1e12
        )) (IO Estimate -> IO (Double, Double))
-> (Benchmarkable -> IO Estimate)
-> Benchmarkable
-> IO (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Benchmarkable -> IO Estimate)
 -> Benchmarkable -> IO (Double, Double))
-> (RelStDev -> Benchmarkable -> IO Estimate)
-> RelStDev
-> Benchmarkable
-> IO (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.)
    ((RelStDev -> Benchmarkable -> IO Estimate)
 -> RelStDev -> Benchmarkable -> IO (Double, Double))
-> (Timeout -> RelStDev -> Benchmarkable -> IO Estimate)
-> Timeout
-> RelStDev
-> Benchmarkable
-> IO (Double, Double)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Progress -> IO ())
-> TimeMode -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil (IO () -> Progress -> IO ()
forall a b. a -> b -> a
const (IO () -> Progress -> IO ()) -> IO () -> Progress -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) TimeMode
CpuTime

#ifdef MIN_VERSION_tasty

instance IsTest Benchmarkable where
  testOptions :: Tagged Benchmarkable [OptionDescription]
testOptions = [OptionDescription] -> Tagged Benchmarkable [OptionDescription]
forall a. a -> Tagged Benchmarkable a
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)
    -- FailIfSlower and FailIfFaster must be options of a test provider rather
    -- than options of an ingredient to allow setting them on per-test level.
    , Proxy FailIfSlower -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailIfSlower
forall {k} (t :: k). Proxy t
Proxy :: Proxy FailIfSlower)
    , Proxy FailIfFaster -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy FailIfFaster
forall {k} (t :: k). Proxy t
Proxy :: Proxy FailIfFaster)
    , Proxy TimeMode -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy TimeMode
forall {k} (t :: k). Proxy t
Proxy :: Proxy TimeMode)
    ]
  run :: OptionSet -> Benchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts Benchmarkable
b Progress -> IO ()
yieldProgress = case NumThreads -> Key
getNumThreads (OptionSet -> NumThreads
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) of
    Key
1 -> do
      let timeMode :: TimeMode
timeMode = OptionSet -> TimeMode
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      Estimate
est <- (Progress -> IO ())
-> TimeMode -> Timeout -> RelStDev -> Benchmarkable -> IO Estimate
measureUntil Progress -> IO ()
yieldProgress TimeMode
timeMode (OptionSet -> Timeout
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) (OptionSet -> RelStDev
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts) Benchmarkable
b
      let FailIfSlower Double
ifSlower = OptionSet -> FailIfSlower
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
          FailIfFaster Double
ifFaster = OptionSet -> FailIfFaster
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      Result -> IO Result
forall a. a -> IO a
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
$ WithLoHi Estimate -> String
forall a. Show a => a -> String
show (Estimate -> Double -> Double -> WithLoHi Estimate
forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Estimate
est (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ifFaster) (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ifSlower))
    Key
_ -> Result -> IO Result
forall a. a -> IO a
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 must not be run concurrently. Please pass -j1 and/or avoid +RTS -N."

-- | Attach a name to 'Benchmarkable'.
--
-- This is actually a synonym of 'Test.Tasty.Providers.singleTest' to
-- provide an interface compatible with @Criterion.@'Criterion.bench'
-- and @Gauge.@'Gauge.bench'.
--
-- @since 0.1
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.@'Criterion.bgroup' and
-- @Gauge@.'Gauge.bgroup'.
--
-- @since 0.1
bgroup :: String -> [Benchmark] -> Benchmark
bgroup :: String -> [Benchmark] -> Benchmark
bgroup = String -> [Benchmark] -> Benchmark
testGroup

-- | Compare benchmarks, reporting relative speed up or slow down.
--
-- This function is a vague reminiscence of @bcompare@, which existed in pre-1.0
-- versions of @criterion@, but their types are incompatible. Under the hood
-- 'bcompare' is a thin wrapper over 'after'.
--
-- Here is a basic example:
--
-- > 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"
-- >     [ bcompare "tenth"  $ bench "fifth"     $ nf fibo  5
-- >     ,                     bench "tenth"     $ nf fibo 10
-- >     , bcompare "tenth"  $ bench "twentieth" $ nf fibo 20
-- >     ]
-- >   ]
--
-- More complex examples:
--
-- * https://hackage.haskell.org/package/chimera-0.3.3.0/src/bench/Bench.hs
-- * https://hackage.haskell.org/package/fast-digits-0.3.1.0/src/bench/Bench.hs
-- * https://hackage.haskell.org/package/unicode-data-0.4.0.1/src/bench/Main.hs
--
-- @since 0.2.4
bcompare
  :: String
  -- ^ @tasty@ pattern, which must unambiguously
  -- match a unique baseline benchmark. Consider using 'locateBenchmark' to construct it.
  -> Benchmark
  -- ^ Benchmark (or a group of benchmarks)
  -- to be compared against the baseline benchmark by dividing measured mean times.
  -- The result is reported by 'consoleBenchReporter', e. g., 0.50x or 1.25x.
  -> Benchmark
bcompare :: String -> Benchmark -> Benchmark
bcompare = Double -> Double -> String -> Benchmark -> Benchmark
bcompareWithin (-Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0) (Double
1Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
0)

-- | Same as 'bcompare', but takes expected lower and upper bounds of
-- comparison. If the result is not within provided bounds, benchmark fails.
-- This allows to create portable performance tests: instead of comparing
-- to an absolute timeout or to previous runs, you can state that one implementation
-- of an algorithm must be faster than another.
--
-- E. g., 'bcompareWithin' 2.0 3.0 passes only if a benchmark is at least 2x
-- and at most 3x slower than a baseline.
--
-- @since 0.3.1
bcompareWithin
  :: Double    -- ^ Lower bound of relative speed up.
  -> Double    -- ^ Upper bound of relative speed up.
  -> String    -- ^ @tasty@ pattern to locate a baseline benchmark.
  -> Benchmark -- ^ Benchmark to compare against baseline.
  -> Benchmark
bcompareWithin :: Double -> Double -> String -> Benchmark -> Benchmark
bcompareWithin Double
lo Double
hi String
s = case String -> Maybe Expr
parseExpr String
s of
  Maybe Expr
Nothing -> String -> Benchmark -> Benchmark
forall a. HasCallStack => String -> a
error (String -> Benchmark -> Benchmark)
-> String -> Benchmark -> Benchmark
forall a b. (a -> b) -> a -> b
$ String
"Could not parse bcompare pattern " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s
  Just Expr
e  -> DependencyType -> Expr -> Benchmark -> Benchmark
after_ DependencyType
AllSucceed (Expr -> Expr -> Expr
And (String -> Expr
StringLit (String
bcomparePrefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Double, Double) -> String
forall a. Show a => a -> String
show (Double
lo, Double
hi))) Expr
e)

bcomparePrefix :: String
bcomparePrefix :: String
bcomparePrefix = String
"tasty-bench"

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

-- | Run benchmarks and report results, providing an interface
-- compatible with @Criterion.@'Criterion.defaultMain' and
-- @Gauge.@'Gauge.defaultMain'.
--
-- @since 0.1
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain [Benchmark]
bs = do
  let act :: IO ()
act = [Benchmark] -> IO ()
defaultMain' [Benchmark]
bs
  IO () -> IO ()
forall a. IO a -> IO a
bracketUtf8 IO ()
act

bracketUtf8 :: IO a -> IO a
bracketUtf8 :: forall a. IO a -> IO a
bracketUtf8 IO a
act = do
  TextEncoding
prevLocaleEnc <- IO TextEncoding
getLocaleEncoding
#if defined(mingw32_HOST_OS)
  codePage <- getConsoleOutputCP
  bracket_
    (setLocaleEncoding utf8 >> setConsoleOutputCP 65001)
    (setLocaleEncoding prevLocaleEnc >> setConsoleOutputCP codePage)
    act
#else
  IO () -> IO () -> IO a -> IO a
forall a b c. IO a -> IO b -> IO c -> IO c
bracket_
    (TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8)
    (TextEncoding -> IO ()
setLocaleEncoding TextEncoding
prevLocaleEnc)
    IO a
act
#endif

defaultMain' :: [Benchmark] -> IO ()
defaultMain' :: [Benchmark] -> IO ()
defaultMain' [Benchmark]
bs  = do
  IO ()
installSignalHandlers
  let b :: Benchmark
b = String -> [Benchmark] -> Benchmark
testGroup String
"All" [Benchmark]
bs
  OptionSet
opts <- [Ingredient] -> Benchmark -> IO OptionSet
parseOptions [Ingredient]
benchIngredients Benchmark
b
  let opts' :: OptionSet
opts' = NumThreads -> OptionSet -> OptionSet
forall v. IsOption v => v -> OptionSet -> OptionSet
setOption (Key -> NumThreads
NumThreads Key
1) OptionSet
opts
#if MIN_VERSION_tasty(1,5,0)
      opts'' :: OptionSet
opts'' = MinDurationToReport -> OptionSet -> OptionSet
forall v. IsOption v => v -> OptionSet -> OptionSet
setOption (Integer -> MinDurationToReport
MinDurationToReport Integer
1000000000000) OptionSet
opts'
#else
      opts'' = opts'
#endif
  case [Ingredient] -> OptionSet -> Benchmark -> Maybe (IO Bool)
tryIngredients [Ingredient]
benchIngredients OptionSet
opts'' Benchmark
b of
    Maybe (IO Bool)
Nothing -> IO ()
forall a. IO a
exitFailure
    Just IO Bool
act -> IO Bool
act IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> if Bool
x then IO ()
forall a. IO a
exitSuccess else IO ()
forall a. IO a
exitFailure

-- | List of default benchmark ingredients. This is what 'defaultMain' runs.
--
-- @since 0.2
benchIngredients :: [Ingredient]
benchIngredients :: [Ingredient]
benchIngredients = [Ingredient
listingTests, Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
consoleBenchReporter (Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
csvReporter Ingredient
svgReporter)]

#endif

funcToBench :: forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench :: forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable ((Word64 -> IO ()) -> Benchmarkable)
-> (a -> Word64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Word64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> b) -> a -> Word64 -> IO ())
-> (a -> b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPEC -> (a -> b) -> a -> Word64 -> IO ()
funcToBenchLoop SPEC
SPEC
  where
    -- Here we rely on the fact that GHC (unless spurred by
    -- -fstatic-argument-transformation) is not smart enough:
    -- it does not notice that `f` and `x` arguments are loop invariant
    -- and could be floated, and the whole `f x` expression shared.
    -- If we create a closure with `f` and `x` bound in the environment,
    -- then GHC is smart enough to share computation of `f x`.
    --
    -- For perspective, gauge and criterion < 1.4 mark similar functions as INLINE,
    -- while criterion >= 1.4 switches to NOINLINE.
    -- If we mark `funcToBenchLoop` NOINLINE then benchmark results are slightly larger
    -- (noticeable in bench-fibo), because the loop body is slightly bigger,
    -- since GHC does not unbox numbers or inline `Eq @Word64` dictionary.
    --
    -- This function is called `funcToBenchLoop` instead of, say, `go`,
    -- so it is easier to spot in Core dumps.
    --
    -- Forcing SpecConst optimization with SPEC makes the behaviour of benchmarks
    -- independent of -fspec-constr-count.
    funcToBenchLoop :: SPEC -> (a -> b) -> a -> Word64 -> IO ()
    funcToBenchLoop :: SPEC -> (a -> b) -> a -> Word64 -> IO ()
funcToBenchLoop !SPEC
_ a -> b
f a
x Word64
n
      | Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0    = () -> IO ()
forall a. a -> IO a
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 (a -> b
f a
x))
        SPEC -> (a -> b) -> a -> Word64 -> IO ()
funcToBenchLoop SPEC
SPEC a -> b
f a
x (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
{-# INLINE funcToBench #-}

-- | 'nf' @f@ @x@ measures time to compute
-- a normal form (by means of 'Control.DeepSeq.rnf', not 'Control.DeepSeq.force')
-- of an application of @f@ to @x@.
-- This does not include time to evaluate @f@ or @x@ themselves.
-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'.
--
-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate
-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may
-- be an infinite structure. Thus @x@ will be evaluated in course of the first
-- application of @f@. This noisy measurement is to be discarded soon,
-- but if @x@ is not a primitive data type, consider forcing its evaluation
-- separately, e. g., via 'env' or 'withResource'.
--
-- Here is a textbook anti-pattern: 'nf' 'sum' @[1..1000000]@.
-- Since an input list is shared by multiple invocations of 'sum',
-- it will be allocated in memory in full, putting immense pressure
-- on garbage collector. Also no list fusion will happen.
-- A better approach is 'nf' (@\\n@ @->@ 'sum' @[1..n]@) @1000000@.
--
-- It is preferable that the return type of the function under measurement
-- is inhabited enough to depend genuinely on all computations and is not simply @b ~ ()@.
-- Otherwise GHC might get aggressive and optimise the payload away.
--
-- If you are measuring an inlinable function,
-- it is prudent to ensure that its invocation is fully saturated,
-- otherwise inlining will not happen. That's why one can often
-- see 'nf' (@\\n@ @->@ @f@ @n@) @x@ instead of 'nf' @f@ @x@.
-- Same applies to rewrite rules.
--
-- While @tasty-bench@ is capable to perform micro- and even nanobenchmarks,
-- such measurements are noisy and involve an overhead. Results are more reliable
-- when @f@ @x@ takes at least several milliseconds.
--
-- Remember 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.
--
-- 'nf' @f@ is equivalent to 'whnf' ('Control.DeepSeq.rnf' '.' @f@), but not to
-- 'whnf' ('Control.DeepSeq.force' '.' @f@). The latter retains the result
-- in memory until it is fully evaluated, while the former allows
-- evaluated parts of the result to be garbage-collected immediately.
--
-- For users of @{-# LANGUAGE LinearTypes #-}@: if @f@ is a linear function,
-- then 'nf' @f@ @x@ is ill-typed, but you can use 'nf' @(\\y -> f y)@ @x@
-- instead.
--
-- Drop-in replacement for @Criterion.@'Criterion.nf' and
-- @Gauge.@'Gauge.nf'.
--
-- @since 0.1
nf :: NFData b => (a -> b) -> a -> Benchmarkable
nf :: forall b a. NFData b => (a -> b) -> a -> Benchmarkable
nf = (b -> ()) -> (a -> b) -> a -> Benchmarkable
forall a b c. (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 an application of @f@ to @x@.
-- This does not include time to evaluate @f@ or @x@ themselves.
-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'.
--
-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate
-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may
-- be an infinite structure. Thus @x@ will be evaluated in course of the first
-- application of @f@. This noisy measurement is to be discarded soon,
-- but if @x@ is not a primitive data type, consider forcing its evaluation
-- separately, e. g., via 'env' or 'withResource'.
--
-- Computing only a weak head normal form is
-- rarely what intuitively is meant by "evaluation".
-- Beware that many educational materials contain examples with 'whnf':
-- this is a wrong default.
-- Unless you understand precisely, what is measured,
-- it is recommended to use 'nf' instead.
--
-- Here is a textbook anti-pattern: 'whnf' ('Data.List.replicate' @1000000@) @1@.
-- This will succeed in a matter of nanoseconds, because weak head
-- normal form forces only the first element of the list.
--
-- Drop-in replacement for @Criterion.@'Criterion.whnf' and @Gauge.@'Gauge.whnf'.
--
-- @since 0.1
whnf :: (a -> b) -> a -> Benchmarkable
whnf :: forall a b. (a -> b) -> a -> Benchmarkable
whnf = (b -> b) -> (a -> b) -> a -> Benchmarkable
forall a b c. (b -> c) -> (a -> b) -> a -> Benchmarkable
funcToBench b -> b
forall a. a -> a
id
{-# INLINE whnf #-}

ioToBench :: (b -> c) -> IO b -> Benchmarkable
ioToBench :: forall b c. (b -> c) -> IO b -> Benchmarkable
ioToBench b -> c
frc IO b
act = (Word64 -> IO ()) -> Benchmarkable
Benchmarkable (SPEC -> Word64 -> IO ()
ioToBenchLoop SPEC
SPEC)
  where
    ioToBenchLoop :: SPEC -> Word64 -> IO ()
    ioToBenchLoop :: SPEC -> Word64 -> IO ()
ioToBenchLoop !SPEC
_ Word64
n
      | Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0    = () -> IO ()
forall a. a -> IO a
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)
        SPEC -> Word64 -> IO ()
ioToBenchLoop SPEC
SPEC (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
{-# INLINE ioToBench #-}

-- | 'nfIO' @x@ measures time to evaluate side-effects of @x@
-- and compute its normal form
-- (by means of 'Control.DeepSeq.rnf', not 'Control.DeepSeq.force').
--
-- Pure subexpression of an effectful computation @x@
-- may be evaluated only once and get cached. For example,
-- GHC is likely to float @x@ out of 'nfIO' ('pure' @x@) and
-- evaluate in only once, which leaves 'nfIO' to measure 'pure' only
-- with results in nanosecond range.
--
-- To avoid surprising results it is usually preferable
-- to use 'nfAppIO' instead.
--
-- Remember 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.
--
-- A typical use case is 'nfIO' ('readFile' @"foo.txt"@).
-- However, if your goal is not to benchmark I\/O per se,
-- but just read input data from a file, it is cleaner to
-- use 'env' or 'withResource'.
--
-- Drop-in replacement for @Criterion.@'Criterion.nfIO' and @Gauge.@'Gauge.nfIO'.
--
-- @since 0.1
nfIO :: NFData a => IO a -> Benchmarkable
nfIO :: forall a. NFData a => 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. For example,
-- GHC is likely to float @x@ out of 'whnfIO' ('pure' @x@) and
-- evaluate in only once, which leaves 'whnfIO' to measure 'pure' only
-- with results in nanosecond range.
--
-- To avoid surprising results it is usually preferable
-- to use 'whnfAppIO' instead.
--
-- 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.
--
-- Lazy I\/O is treacherous.
-- If your goal is not to benchmark I\/O per se,
-- but just read input data from a file, it is cleaner to
-- use 'env' or 'withResource'.
--
-- Drop-in replacement for @Criterion.@'Criterion.whnfIO' and @Gauge.@'Gauge.whnfIO'.
--
-- @since 0.1
whnfIO :: IO a -> Benchmarkable
whnfIO :: forall a. 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 :: forall a b c. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench :: forall a b c. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> c
frc = ((Word64 -> IO ()) -> Benchmarkable
Benchmarkable ((Word64 -> IO ()) -> Benchmarkable)
-> (a -> Word64 -> IO ()) -> a -> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> Word64 -> IO ()) -> a -> Benchmarkable)
-> ((a -> IO b) -> a -> Word64 -> IO ())
-> (a -> IO b)
-> a
-> Benchmarkable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPEC -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBenchLoop SPEC
SPEC
  where
    ioFuncToBenchLoop :: SPEC -> (a -> IO b) -> a -> Word64 -> IO ()
    ioFuncToBenchLoop :: SPEC -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBenchLoop !SPEC
_ a -> IO b
f a
x Word64
n
      | Word64
n Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
0    = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      | Bool
otherwise = do
        b
val <- a -> IO b
f a
x
        c
_ <- c -> IO c
forall a. a -> IO a
evaluate (b -> c
frc b
val)
        SPEC -> (a -> IO b) -> a -> Word64 -> IO ()
ioFuncToBenchLoop SPEC
SPEC a -> IO b
f a
x (Word64
n Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
1)
{-# INLINE ioFuncToBench #-}

-- | 'nfAppIO' @f@ @x@ measures time to evaluate side-effects of
-- an application of @f@ to @x@
-- and compute its normal form
-- (by means of 'Control.DeepSeq.rnf', not 'Control.DeepSeq.force').
-- This does not include time to evaluate @f@ or @x@ themselves.
-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'.
--
-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate
-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may
-- be an infinite structure. Thus @x@ will be evaluated in course of the first
-- application of @f@. This noisy measurement is to be discarded soon,
-- but if @x@ is not a primitive data type, consider forcing its evaluation
-- separately, e. g., via 'env' or 'withResource'.
--
-- Remember 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.
--
-- A typical use case is 'nfAppIO' 'readFile' @"foo.txt"@.
-- However, if your goal is not to benchmark I\/O per se,
-- but just read input data from a file, it is cleaner to
-- use 'env' or 'withResource'.
--
-- Drop-in replacement for @Criterion.@'Criterion.nfAppIO' and @Gauge.@'Gauge.nfAppIO'.
--
-- @since 0.1
nfAppIO :: NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO :: forall b a. NFData b => (a -> IO b) -> a -> Benchmarkable
nfAppIO = (b -> ()) -> (a -> IO b) -> a -> Benchmarkable
forall a b c. (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
-- an application of @f@ to @x@
-- and compute its weak head normal form.
-- This does not include time to evaluate @f@ or @x@ themselves.
-- Ideally @x@ should be a primitive data type like 'Data.Int.Int'.
--
-- The same thunk of @x@ is shared by multiple calls of @f@. We cannot evaluate
-- @x@ beforehand: there is no 'NFData' @a@ constraint, and potentially @x@ may
-- be an infinite structure. Thus @x@ will be evaluated in course of the first
-- application of @f@. This noisy measurement is to be discarded soon,
-- but if @x@ is not a primitive data type, consider forcing its evaluation
-- separately, e. g., via 'env' or 'withResource'.
--
-- 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.
--
-- Lazy I\/O is treacherous.
-- If your goal is not to benchmark I\/O per se,
-- but just read input data from a file, it is cleaner to
-- use 'env' or 'withResource'.
--
-- Drop-in replacement for @Criterion.@'Criterion.whnfAppIO' and @Gauge.@'Gauge.whnfAppIO'.
--
-- @since 0.1
whnfAppIO :: (a -> IO b) -> a -> Benchmarkable
whnfAppIO :: forall a b. (a -> IO b) -> a -> Benchmarkable
whnfAppIO = (b -> b) -> (a -> IO b) -> a -> Benchmarkable
forall a b c. (b -> c) -> (a -> IO b) -> a -> Benchmarkable
ioFuncToBench b -> b
forall a. a -> a
id
{-# INLINE whnfAppIO #-}

#ifdef MIN_VERSION_tasty

-- | Run benchmarks in the given environment, usually reading large input data from file.
--
-- One might wonder why 'env' is needed,
-- when we can simply read all input data
-- before calling 'defaultMain'. The reason is that large data
-- dangling in the heap causes longer garbage collection
-- and slows down all benchmarks, even those which do not use it at all.
--
-- It is instrumental not only for proper 'IO' actions,
-- but also for a large statically-known data as well. Instead of a top-level
-- definition, which once evaluated will slow down garbage collection
-- during all subsequent benchmarks,
--
-- > largeData :: String
-- > largeData = replicate 1000000 'a'
-- >
-- > main :: IO ()
-- > main = defaultMain
-- >   [ bench "large" $ nf length largeData, ... ]
--
-- use
--
-- > main :: IO ()
-- > main = defaultMain
-- >   [ env (pure (replicate 1000000 'a')) $ \largeData ->
-- >     bench "large" $ nf length largeData, ... ]
--
-- Even with 'env', it's advisable to store input data in as few heap objects
-- as possible. 'Data.Array.ByteArray.ByteArray' (ideally pinned)
-- or unboxed @Vector@ are good, boxed arrays are worse, lists and trees are bad.
--
-- @Test.Tasty.Bench.@'env' is provided only for the sake of
-- compatibility with @Criterion.@'Criterion.env' and
-- @Gauge.@'Gauge.env', and involves 'unsafePerformIO'. Consider using
-- 'withResource' instead.
--
-- When working with a mutable environment, bear in mind that it is threaded
-- through all iterations of a benchmark. @tasty-bench@ does not roll it back
-- or reset, it's user's resposibility. You might have better luck
-- with @Criterion.@'Criterion.perBatchEnv' or @Criterion.@'Criterion.perRunEnv'.
--
-- 'defaultMain' requires that the hierarchy of benchmarks and their names is
-- independent of underlying 'IO' actions. While executing 'IO' inside 'bench'
-- via 'nfIO' is fine, and reading test data from files via 'env' is also fine,
-- using 'env' to choose benchmarks or their names depending on 'IO' side effects
-- will throw a rather cryptic error message:
--
-- > Unhandled resource. Probably a bug in the runner you're using.
--
-- Strict pattern-matching on resource is also prohibited. For
-- instance, if it is a tuple, the second argument of 'env' should use
-- a lazy pattern match @\\~(a, b) -> ...@
--
-- @since 0.2
env :: NFData env => IO env -> (env -> Benchmark) -> Benchmark
env :: forall env. NFData env => IO env -> (env -> Benchmark) -> Benchmark
env IO env
res = IO env -> (env -> IO ()) -> (env -> Benchmark) -> Benchmark
forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res (IO () -> env -> IO ()
forall a b. a -> b -> a
const (IO () -> env -> IO ()) -> IO () -> env -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Similar to 'env', but includes an additional argument
-- to clean up created environment.
--
-- Provided only for the sake of compatibility with
-- @Criterion.@'Criterion.envWithCleanup' and
-- @Gauge.@'Gauge.envWithCleanup', and involves
-- 'unsafePerformIO'. Consider using 'withResource' instead.
--
-- @since 0.2
envWithCleanup :: NFData env => IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup :: forall env a.
NFData env =>
IO env -> (env -> IO a) -> (env -> Benchmark) -> Benchmark
envWithCleanup IO env
res env -> IO a
fin env -> Benchmark
f = IO env -> (env -> IO ()) -> (IO env -> Benchmark) -> Benchmark
forall a. IO a -> (a -> IO ()) -> (IO a -> Benchmark) -> Benchmark
withResource
  (IO env
res IO env -> (env -> IO env) -> IO env
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= env -> IO env
forall a. a -> IO a
evaluate (env -> IO env) -> (env -> env) -> env -> IO env
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> env
forall a. NFData a => a -> a
force)
  (IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> (env -> IO a) -> env -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. env -> IO a
fin)
  (env -> Benchmark
f (env -> Benchmark) -> (IO env -> env) -> IO env -> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO env -> env
forall a. IO a -> a
unsafePerformIO)

-- | A path to write results in CSV format, populated by @--csv@.
--
-- This is an option of 'csvReporter' and can be set only globally.
-- Modifying it via 'adjustOption' or 'localOption' does not have any effect.
-- One can however pass it to 'tryIngredients' 'benchIngredients'. For example,
-- here is how to set a default CSV location:
--
-- @
-- import Data.Maybe
-- import System.Exit
-- import Test.Tasty.Bench
-- import Test.Tasty.Ingredients
-- import Test.Tasty.Options
-- import Test.Tasty.Runners
--
-- main :: IO ()
-- main = do
--   let benchmarks = bgroup \"All\" ...
--   opts <- parseOptions benchIngredients benchmarks
--   let opts' = changeOption (Just . fromMaybe (CsvPath "foo.csv")) opts
--   case tryIngredients benchIngredients opts' benchmarks of
--     Nothing -> exitFailure
--     Just mb -> mb >>= \\b -> if b then exitSuccess else exitFailure
-- @
--
-- @since 0.3
newtype CsvPath = CsvPath FilePath
  deriving
  ( CsvPath -> CsvPath -> Bool
(CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool) -> Eq CsvPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CsvPath -> CsvPath -> Bool
== :: CsvPath -> CsvPath -> Bool
$c/= :: CsvPath -> CsvPath -> Bool
/= :: CsvPath -> CsvPath -> Bool
Eq
  -- ^ @since 0.4
  , Eq CsvPath
Eq CsvPath =>
(CsvPath -> CsvPath -> Ordering)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> CsvPath)
-> (CsvPath -> CsvPath -> CsvPath)
-> Ord CsvPath
CsvPath -> CsvPath -> Bool
CsvPath -> CsvPath -> Ordering
CsvPath -> CsvPath -> CsvPath
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
$ccompare :: CsvPath -> CsvPath -> Ordering
compare :: CsvPath -> CsvPath -> Ordering
$c< :: CsvPath -> CsvPath -> Bool
< :: CsvPath -> CsvPath -> Bool
$c<= :: CsvPath -> CsvPath -> Bool
<= :: CsvPath -> CsvPath -> Bool
$c> :: CsvPath -> CsvPath -> Bool
> :: CsvPath -> CsvPath -> Bool
$c>= :: CsvPath -> CsvPath -> Bool
>= :: CsvPath -> CsvPath -> Bool
$cmax :: CsvPath -> CsvPath -> CsvPath
max :: CsvPath -> CsvPath -> CsvPath
$cmin :: CsvPath -> CsvPath -> CsvPath
min :: CsvPath -> CsvPath -> CsvPath
Ord
  -- ^ @since 0.4
  )

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 a. a -> Tagged (Maybe CsvPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"csv"
  optionHelp :: Tagged (Maybe CsvPath) String
optionHelp = String -> Tagged (Maybe CsvPath) String
forall a. a -> Tagged (Maybe CsvPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File to write results in CSV format"

-- | Run benchmarks and save results in CSV format.
-- It activates when @--csv@ @FILE@ command line option is specified.
--
-- @since 0.1
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
    let names :: [String]
names = OptionSet -> Benchmark -> [String]
testsNames OptionSet
opts Benchmark
tree
        namesMap :: IntMap String
namesMap = [(Key, String)] -> IntMap String
forall a. [(Key, a)] -> IntMap a
IM.fromDistinctAscList ([(Key, String)] -> IntMap String)
-> [(Key, String)] -> IntMap String
forall a b. (a -> b) -> a -> b
$ [Key] -> [String] -> [(Key, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0..] [String]
names
    (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a. a -> Maybe a
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
      case [String] -> Maybe String
forall a. Ord a => [a] -> Maybe a
findNonUniqueElement [String]
names of
        Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just String
name -> do -- 'die' is not available before base-4.8
          Handle -> String -> IO ()
hPutStrLn Handle
stderr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"CSV report cannot proceed, because name '" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"' corresponds to two or more benchmarks. Please disambiguate them."
          IO ()
forall a. IO a
exitFailure
      let augmented :: IntMap (String, TVar Status)
augmented = (String -> TVar Status -> (String, TVar Status))
-> IntMap String -> StatusMap -> IntMap (String, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap
      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
          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,Peak Memory" else String
"")
          Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h
        )
        Handle -> IO ()
hClose
        (Handle -> IntMap (String, TVar Status) -> IO ()
`csvOutput` IntMap (String, TVar Status)
augmented)
      (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a. a -> IO a
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 (IO Bool -> Double -> IO Bool) -> IO Bool -> Double -> IO Bool
forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap

findNonUniqueElement :: Ord a => [a] -> Maybe a
findNonUniqueElement :: forall a. Ord a => [a] -> Maybe a
findNonUniqueElement = Set a -> [a] -> Maybe a
forall {a}. Ord a => Set a -> [a] -> Maybe a
go Set a
forall a. Set a
S.empty
  where
    go :: Set a -> [a] -> Maybe a
go Set a
_ [] = Maybe a
forall a. Maybe a
Nothing
    go Set a
acc (a
x : [a]
xs)
      | a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set a
acc = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      | Bool
otherwise = Set a -> [a] -> Maybe a
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.insert a
x Set a
acc) [a]
xs

csvOutput :: Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput :: Handle -> IntMap (String, TVar Status) -> IO ()
csvOutput Handle
h = ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((String, TVar Status) -> IO ())
 -> IntMap (String, TVar Status) -> IO ())
-> ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name, TVar Status
tv) -> do
  let csv :: Estimate -> String
csv = if Bool
hasGCStats then Estimate -> String
csvEstimateWithGC else Estimate -> String
csvEstimate
  Result
r <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Result -> STM Result
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> STM Result
forall a. STM a
retry
  case String -> Maybe (WithLoHi Estimate)
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
    Maybe (WithLoHi Estimate)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (WithLoHi Estimate
est Double
_ Double
_) -> do
      String
msg <- String -> IO String
formatMessage (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Estimate -> String
csv Estimate
est
      Handle -> String -> IO ()
hPutStrLn Handle
h (ShowS
encodeCsv String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> ShowS
forall a. a -> [a] -> [a]
: String
msg)

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 a. Eq a => a -> [a] -> 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]
: ShowS
go String
xs -- opening quote
  | Bool
otherwise = String
xs
  where
    go :: ShowS
go [] = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: [] -- closing quote
    go (Char
'"' : String
ys) = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
ys
    go (Char
y : String
ys) = Char
y Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
go String
ys

-- | A path to plot results in SVG format, populated by @--svg@.
--
-- This is an option of 'svgReporter' and can be set only globally.
-- Modifying it via 'adjustOption' or 'localOption' does not have any effect.
-- One can however pass it to 'tryIngredients' 'benchIngredients'.
--
-- @since 0.3
newtype SvgPath = SvgPath FilePath
  deriving
  ( SvgPath -> SvgPath -> Bool
(SvgPath -> SvgPath -> Bool)
-> (SvgPath -> SvgPath -> Bool) -> Eq SvgPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SvgPath -> SvgPath -> Bool
== :: SvgPath -> SvgPath -> Bool
$c/= :: SvgPath -> SvgPath -> Bool
/= :: SvgPath -> SvgPath -> Bool
Eq
  -- ^ @since 0.4
  , Eq SvgPath
Eq SvgPath =>
(SvgPath -> SvgPath -> Ordering)
-> (SvgPath -> SvgPath -> Bool)
-> (SvgPath -> SvgPath -> Bool)
-> (SvgPath -> SvgPath -> Bool)
-> (SvgPath -> SvgPath -> Bool)
-> (SvgPath -> SvgPath -> SvgPath)
-> (SvgPath -> SvgPath -> SvgPath)
-> Ord SvgPath
SvgPath -> SvgPath -> Bool
SvgPath -> SvgPath -> Ordering
SvgPath -> SvgPath -> SvgPath
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
$ccompare :: SvgPath -> SvgPath -> Ordering
compare :: SvgPath -> SvgPath -> Ordering
$c< :: SvgPath -> SvgPath -> Bool
< :: SvgPath -> SvgPath -> Bool
$c<= :: SvgPath -> SvgPath -> Bool
<= :: SvgPath -> SvgPath -> Bool
$c> :: SvgPath -> SvgPath -> Bool
> :: SvgPath -> SvgPath -> Bool
$c>= :: SvgPath -> SvgPath -> Bool
>= :: SvgPath -> SvgPath -> Bool
$cmax :: SvgPath -> SvgPath -> SvgPath
max :: SvgPath -> SvgPath -> SvgPath
$cmin :: SvgPath -> SvgPath -> SvgPath
min :: SvgPath -> SvgPath -> SvgPath
Ord
  -- ^ @since 0.4
  )

instance IsOption (Maybe SvgPath) where
  defaultValue :: Maybe SvgPath
defaultValue = Maybe SvgPath
forall a. Maybe a
Nothing
  parseValue :: String -> Maybe (Maybe SvgPath)
parseValue = Maybe SvgPath -> Maybe (Maybe SvgPath)
forall a. a -> Maybe a
Just (Maybe SvgPath -> Maybe (Maybe SvgPath))
-> (String -> Maybe SvgPath) -> String -> Maybe (Maybe SvgPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SvgPath -> Maybe SvgPath
forall a. a -> Maybe a
Just (SvgPath -> Maybe SvgPath)
-> (String -> SvgPath) -> String -> Maybe SvgPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SvgPath
SvgPath
  optionName :: Tagged (Maybe SvgPath) String
optionName = String -> Tagged (Maybe SvgPath) String
forall a. a -> Tagged (Maybe SvgPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"svg"
  optionHelp :: Tagged (Maybe SvgPath) String
optionHelp = String -> Tagged (Maybe SvgPath) String
forall a. a -> Tagged (Maybe SvgPath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File to plot results in SVG format"

-- | Run benchmarks and plot results in SVG format.
-- It activates when @--svg@ @FILE@ command line option is specified.
--
-- @since 0.2.4
svgReporter :: Ingredient
svgReporter :: Ingredient
svgReporter = [OptionDescription]
-> (OptionSet
    -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [Proxy (Maybe SvgPath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe SvgPath)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe SvgPath))] ((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
    SvgPath String
path <- OptionSet -> Maybe SvgPath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    let names :: [String]
names = OptionSet -> Benchmark -> [String]
testsNames OptionSet
opts Benchmark
tree
        namesMap :: IntMap String
namesMap = [(Key, String)] -> IntMap String
forall a. [(Key, a)] -> IntMap a
IM.fromDistinctAscList ([(Key, String)] -> IntMap String)
-> [(Key, String)] -> IntMap String
forall a b. (a -> b) -> a -> b
$ [Key] -> [String] -> [(Key, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0..] [String]
names
    (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a. a -> Maybe a
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
      IORef [(String, Estimate)]
ref <- [(String, Estimate)] -> IO (IORef [(String, Estimate)])
forall a. a -> IO (IORef a)
newIORef []
      IORef [(String, Estimate)] -> IntMap (String, TVar Status) -> IO ()
svgCollect IORef [(String, Estimate)]
ref ((String -> TVar Status -> (String, TVar Status))
-> IntMap String -> StatusMap -> IntMap (String, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,) IntMap String
namesMap StatusMap
smap)
      [(String, Estimate)]
res <- IORef [(String, Estimate)] -> IO [(String, Estimate)]
forall a. IORef a -> IO a
readIORef IORef [(String, Estimate)]
ref
      String -> String -> IO ()
writeFile String
path ([(String, Estimate)] -> String
svgRender ([(String, Estimate)] -> [(String, Estimate)]
forall a. [a] -> [a]
reverse [(String, Estimate)]
res))
      (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a. a -> IO a
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 (IO Bool -> Double -> IO Bool) -> IO Bool -> Double -> IO Bool
forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap

isSuccessful :: StatusMap -> IO Bool
isSuccessful :: StatusMap -> IO Bool
isSuccessful = [TVar Status] -> IO Bool
go ([TVar Status] -> IO Bool)
-> (StatusMap -> [TVar Status]) -> StatusMap -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusMap -> [TVar Status]
forall a. IntMap a -> [a]
IM.elems
  where
    go :: [TVar Status] -> IO Bool
go [] = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    go (TVar Status
tv : [TVar Status]
tvs) = do
      Bool
b <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Bool) -> STM Bool
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> Bool
resultSuccessful Result
r); Status
_ -> STM Bool
forall a. STM a
retry
      if Bool
b then [TVar Status] -> IO Bool
go [TVar Status]
tvs else Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

svgCollect :: IORef [(TestName, Estimate)] -> IntMap (TestName, TVar Status) -> IO ()
svgCollect :: IORef [(String, Estimate)] -> IntMap (String, TVar Status) -> IO ()
svgCollect IORef [(String, Estimate)]
ref = ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((String, TVar Status) -> IO ())
 -> IntMap (String, TVar Status) -> IO ())
-> ((String, TVar Status) -> IO ())
-> IntMap (String, TVar Status)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
name, TVar Status
tv) -> do
  Result
r <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Status
s -> case Status
s of Done Result
r -> Result -> STM Result
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
r; Status
_ -> STM Result
forall a. STM a
retry
  case String -> Maybe (WithLoHi Estimate)
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
    Maybe (WithLoHi Estimate)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just (WithLoHi Estimate
est Double
_ Double
_) -> IORef [(String, Estimate)]
-> ([(String, Estimate)] -> [(String, Estimate)]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef [(String, Estimate)]
ref ((String
name, Estimate
est) (String, Estimate) -> [(String, Estimate)] -> [(String, Estimate)]
forall a. a -> [a] -> [a]
:)

svgRender :: [(TestName, Estimate)] -> String
svgRender :: [(String, Estimate)] -> String
svgRender [] = String
""
svgRender [(String, Estimate)]
pairs = String
header String -> ShowS
forall a. [a] -> [a] -> [a]
++ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Word64 -> (String, Estimate) -> String)
-> [Word64] -> [(String, Estimate)] -> [String]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
  (\Word64
i (String
name, Estimate
est) -> Word64 -> Word64 -> Double -> String -> Estimate -> String
svgRenderItem Word64
i Word64
l Double
xMax (ShowS
forall a. [a] -> [a]
dropAllPrefix String
name) Estimate
est)
  [Word64
0..]
  [(String, Estimate)]
pairs) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
footer
  where
    dropAllPrefix :: [a] -> [a]
dropAllPrefix
      | ((String, Estimate) -> Bool) -> [(String, Estimate)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((String
"All." String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) (String -> Bool)
-> ((String, Estimate) -> String) -> (String, Estimate) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Estimate) -> String
forall a b. (a, b) -> a
fst) [(String, Estimate)]
pairs = Key -> [a] -> [a]
forall a. Key -> [a] -> [a]
drop Key
4
      | Bool
otherwise = [a] -> [a]
forall a. a -> a
id

    l :: Word64
l = [(String, Estimate)] -> Word64
forall i a. Num i => [a] -> i
genericLength [(String, Estimate)]
pairs
    findMaxX :: Estimate -> Word64
findMaxX (Estimate Measurement
m Word64
stdev) = Measurement -> Word64
measTime Measurement
m Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev
    xMax :: Double
xMax = Word64 -> Double
word64ToDouble (Word64 -> Double) -> Word64 -> Double
forall a b. (a -> b) -> a -> b
$ [Word64] -> Word64
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word64] -> Word64) -> [Word64] -> Word64
forall a b. (a -> b) -> a -> b
$ Word64
forall a. Bounded a => a
minBound Word64 -> [Word64] -> [Word64]
forall a. a -> [a] -> [a]
: ((String, Estimate) -> Word64) -> [(String, Estimate)] -> [Word64]
forall a b. (a -> b) -> [a] -> [b]
map (Estimate -> Word64
findMaxX (Estimate -> Word64)
-> ((String, Estimate) -> Estimate) -> (String, Estimate) -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Estimate) -> Estimate
forall a b. (a, b) -> b
snd) [(String, Estimate)]
pairs
    header :: String
header = String -> Word64 -> Double -> Word64 -> Double -> String
forall r. PrintfType r => String -> r
printf String
"<svg xmlns=\"http://www.w3.org/2000/svg\" height=\"%i\" width=\"%f\" font-size=\"%i\" font-family=\"sans-serif\" stroke-width=\"2\">\n<g transform=\"translate(%f 0)\">\n" (Word64 -> Word64
svgItemOffset Word64
l Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
15) Double
svgCanvasWidth Word64
svgFontSize Double
svgCanvasMargin
    footer :: String
footer = String
"</g>\n</svg>\n"

svgCanvasWidth :: Double
svgCanvasWidth :: Double
svgCanvasWidth = Double
960

svgCanvasMargin :: Double
svgCanvasMargin :: Double
svgCanvasMargin = Double
10

svgItemOffset :: Word64 -> Word64
svgItemOffset :: Word64 -> Word64
svgItemOffset Word64
i = Word64
22 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
55 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
i

svgFontSize :: Word64
svgFontSize :: Word64
svgFontSize = Word64
16

svgRenderItem :: Word64 -> Word64 -> Double -> TestName -> Estimate -> String
svgRenderItem :: Word64 -> Word64 -> Double -> String -> Estimate -> String
svgRenderItem Word64
i Word64
iMax Double
xMax String
name est :: Estimate
est@(Estimate Measurement
m Word64
stdev) =
  (if String -> Double
forall i a. Num i => [a] -> i
genericLength String
shortTextContent Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
glyphWidth Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< Double
boxWidth then String
longText else String
shortText) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
box
  where
    y :: Word64
y  = Word64 -> Word64
svgItemOffset Word64
i
    y' :: Word64
y' = Word64
y  Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ (Word64
svgFontSize Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
3) Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` Word64
8
    y1 :: Word64
y1 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
whiskerMargin
    y2 :: Word64
y2 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
boxHeight Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` Word64
2
    y3 :: Word64
y3 = Word64
y' Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
boxHeight Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
- Word64
whiskerMargin
    x1 :: Double
x1 = Double
boxWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
whiskerWidth
    x2 :: Double
x2 = Double
boxWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
whiskerWidth
    deg :: Word64
deg = (Word64
i Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
360) Word64 -> Word64 -> Word64
forall {a}. Integral a => a -> a -> a
`quot` Word64
iMax
    glyphWidth :: Double
glyphWidth = Word64 -> Double
word64ToDouble Word64
svgFontSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2

    scale :: Word64 -> Double
scale Word64
w       = Word64 -> Double
word64ToDouble Word64
w Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
svgCanvasWidth Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
2 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
svgCanvasMargin) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
xMax
    boxWidth :: Double
boxWidth      = Word64 -> Double
scale (Measurement -> Word64
measTime Measurement
m)
    whiskerWidth :: Double
whiskerWidth  = Word64 -> Double
scale (Word64
2 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
stdev)
    boxHeight :: Word64
boxHeight     = Word64
22
    whiskerMargin :: Word64
whiskerMargin = Word64
5

    box :: String
box = String
-> String
-> Word64
-> Word64
-> Double
-> Word64
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> Double
-> Double
-> Word64
-> Word64
-> String
forall r. PrintfType r => String -> r
printf String
boxTemplate
      (Estimate -> String
prettyEstimate Estimate
est)
      Word64
y' Word64
boxHeight Double
boxWidth Word64
deg Word64
deg
      Word64
deg
      Double
x1 Double
x2 Word64
y2 Word64
y2
      Double
x1 Double
x1 Word64
y1 Word64
y3
      Double
x2 Double
x2 Word64
y1 Word64
y3
    boxTemplate :: String
boxTemplate
      =  String
"<g>\n<title>%s</title>\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<rect y=\"%i\" rx=\"5\" height=\"%i\" width=\"%f\" fill=\"hsl(%i, 100%%, 80%%)\" stroke=\"hsl(%i, 100%%, 55%%)\" />\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<g stroke=\"hsl(%i, 100%%, 40%%)\">"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<line x1=\"%f\" x2=\"%f\" y1=\"%i\" y2=\"%i\" />\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</g>\n</g>\n"

    longText :: String
longText = String -> Word64 -> Word64 -> String -> Word64 -> Double -> ShowS
forall r. PrintfType r => String -> r
printf String
longTextTemplate
      Word64
deg
      Word64
y (ShowS
encodeSvg String
name)
      Word64
y Double
boxWidth (Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m))
    longTextTemplate :: String
longTextTemplate
      =  String
"<g fill=\"hsl(%i, 100%%, 40%%)\">\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\">%s</text>\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"<text y=\"%i\" x=\"%f\" text-anchor=\"end\">%s</text>\n"
      String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</g>\n"

    shortTextContent :: String
shortTextContent  = ShowS
encodeSvg String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
showPicos4 (Measurement -> Word64
measTime Measurement
m)
    shortText :: String
shortText         = String -> Word64 -> Word64 -> ShowS
forall r. PrintfType r => String -> r
printf String
shortTextTemplate Word64
deg Word64
y String
shortTextContent
    shortTextTemplate :: String
shortTextTemplate = String
"<text fill=\"hsl(%i, 100%%, 40%%)\" y=\"%i\">%s</text>\n"

encodeSvg :: String -> String
encodeSvg :: ShowS
encodeSvg [] = []
encodeSvg (Char
'<' : String
xs) = Char
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'l' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
't' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
';' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
'&' : String
xs) = Char
'&' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'a' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'm' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'p' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
';' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs
encodeSvg (Char
x : String
xs) = Char
x Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
encodeSvg String
xs

-- | A path to read baseline results in CSV format, populated by @--baseline@.
--
-- This is an option of 'csvReporter' and can be set only globally.
-- Modifying it via 'adjustOption' or 'localOption' does not have any effect.
-- One can however pass it to 'tryIngredients' 'benchIngredients'.
--
-- @since 0.3
newtype BaselinePath = BaselinePath FilePath
  deriving
  ( BaselinePath -> BaselinePath -> Bool
(BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool) -> Eq BaselinePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaselinePath -> BaselinePath -> Bool
== :: BaselinePath -> BaselinePath -> Bool
$c/= :: BaselinePath -> BaselinePath -> Bool
/= :: BaselinePath -> BaselinePath -> Bool
Eq
  -- ^ @since 0.4
  , Eq BaselinePath
Eq BaselinePath =>
(BaselinePath -> BaselinePath -> Ordering)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> BaselinePath)
-> (BaselinePath -> BaselinePath -> BaselinePath)
-> Ord BaselinePath
BaselinePath -> BaselinePath -> Bool
BaselinePath -> BaselinePath -> Ordering
BaselinePath -> BaselinePath -> BaselinePath
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
$ccompare :: BaselinePath -> BaselinePath -> Ordering
compare :: BaselinePath -> BaselinePath -> Ordering
$c< :: BaselinePath -> BaselinePath -> Bool
< :: BaselinePath -> BaselinePath -> Bool
$c<= :: BaselinePath -> BaselinePath -> Bool
<= :: BaselinePath -> BaselinePath -> Bool
$c> :: BaselinePath -> BaselinePath -> Bool
> :: BaselinePath -> BaselinePath -> Bool
$c>= :: BaselinePath -> BaselinePath -> Bool
>= :: BaselinePath -> BaselinePath -> Bool
$cmax :: BaselinePath -> BaselinePath -> BaselinePath
max :: BaselinePath -> BaselinePath -> BaselinePath
$cmin :: BaselinePath -> BaselinePath -> BaselinePath
min :: BaselinePath -> BaselinePath -> BaselinePath
Ord
  -- ^ @since 0.4
  )

instance IsOption (Maybe BaselinePath) where
  defaultValue :: Maybe BaselinePath
defaultValue = Maybe BaselinePath
forall a. Maybe a
Nothing
  parseValue :: String -> Maybe (Maybe BaselinePath)
parseValue = Maybe BaselinePath -> Maybe (Maybe BaselinePath)
forall a. a -> Maybe a
Just (Maybe BaselinePath -> Maybe (Maybe BaselinePath))
-> (String -> Maybe BaselinePath)
-> String
-> Maybe (Maybe BaselinePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaselinePath -> Maybe BaselinePath
forall a. a -> Maybe a
Just (BaselinePath -> Maybe BaselinePath)
-> (String -> BaselinePath) -> String -> Maybe BaselinePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> BaselinePath
BaselinePath
  optionName :: Tagged (Maybe BaselinePath) String
optionName = String -> Tagged (Maybe BaselinePath) String
forall a. a -> Tagged (Maybe BaselinePath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"baseline"
  optionHelp :: Tagged (Maybe BaselinePath) String
optionHelp = String -> Tagged (Maybe BaselinePath) String
forall a. a -> Tagged (Maybe BaselinePath) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"File with baseline results in CSV format to compare against"

-- | Run benchmarks and report results
-- in a manner similar to 'consoleTestReporter'.
--
-- If @--baseline@ @FILE@ command line option is specified,
-- compare results against an earlier run and mark
-- too slow / too fast benchmarks as failed in accordance to
-- bounds specified by @--fail-if-slower@ @PERCENT@ and @--fail-if-faster@ @PERCENT@.
--
-- @since 0.2
consoleBenchReporter :: Ingredient
consoleBenchReporter :: Ingredient
consoleBenchReporter = [OptionDescription]
-> (OptionSet
    -> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [Proxy (Maybe BaselinePath) -> OptionDescription
forall v. IsOption v => Proxy v -> OptionDescription
Option (Proxy (Maybe BaselinePath)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Maybe BaselinePath))] ((OptionSet
  -> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
 -> Ingredient)
-> (OptionSet
    -> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
opts -> do
  Set String
baseline <- case OptionSet -> Maybe BaselinePath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
    Maybe BaselinePath
Nothing -> Set String -> IO (Set String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set String
forall a. Set a
S.empty
    Just (BaselinePath String
path) -> [String] -> Set String
forall a. Ord a => [a] -> Set a
S.fromList ([String] -> Set String)
-> (String -> [String]) -> String -> Set String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
joinQuotedFields ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> Set String) -> IO String -> IO (Set String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO String
readFile String
path IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO String
forall a. a -> IO a
evaluate (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. NFData a => a -> a
force)
  let pretty :: Estimate -> String
pretty = if Bool
hasGCStats then Estimate -> String
prettyEstimateWithGC else Estimate -> String
prettyEstimate
  (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((String -> Maybe (WithLoHi Result) -> Result -> Result)
 -> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
forall a b. (a -> b) -> a -> b
$ \String
name Maybe (WithLoHi Result)
mDepR Result
r -> case String -> Maybe (WithLoHi Estimate)
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
r) of
    Maybe (WithLoHi Estimate)
Nothing  -> Result
r
    Just (WithLoHi Estimate
est Double
lowerBound Double
upperBound) ->
      (if Bool
isAcceptable then Result -> Result
forall a. a -> a
id else Result -> Result
forceFail)
      Result
r { resultDescription = pretty est ++ bcompareMsg ++ formatSlowDown mSlowDown }
      where
        isAcceptable :: Bool
isAcceptable = Bool
isAcceptableVsBaseline Bool -> Bool -> Bool
&& Bool
isAcceptableVsBcompare
        mSlowDown :: Maybe Double
mSlowDown = Set String -> String -> Estimate -> Maybe Double
compareVsBaseline Set String
baseline String
name Estimate
est
        slowDown :: Double
slowDown = Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
1 Maybe Double
mSlowDown
        isAcceptableVsBaseline :: Bool
isAcceptableVsBaseline = Double
slowDown Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lowerBound Bool -> Bool -> Bool
&& Double
slowDown Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
upperBound
        (Bool
isAcceptableVsBcompare, String
bcompareMsg) = case Maybe (WithLoHi Result)
mDepR of
          Maybe (WithLoHi Result)
Nothing -> (Bool
True, String
"")
          Just (WithLoHi Result
depR Double
depLowerBound Double
depUpperBound) -> case String -> Maybe (WithLoHi Estimate)
forall a. Read a => String -> Maybe a
safeRead (Result -> String
resultDescription Result
depR) of
            Maybe (WithLoHi Estimate)
Nothing -> (Bool
True, String
"")
            Just (WithLoHi Estimate
depEst Double
_ Double
_) -> let ratio :: Double
ratio = Estimate -> Double
estTime Estimate
est Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Estimate -> Double
estTime Estimate
depEst in
              ( Double
ratio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
depLowerBound Bool -> Bool -> Bool
&& Double
ratio Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
depUpperBound
              , String -> Double -> String
forall r. PrintfType r => String -> r
printf String
", %.2fx" Double
ratio
              )

-- | A well-formed CSV entry contains an even number of quotes: 0, 2 or more.
joinQuotedFields :: [String] -> [String]
joinQuotedFields :: [String] -> [String]
joinQuotedFields [] = []
joinQuotedFields (String
x : [String]
xs)
  | String -> Bool
areQuotesBalanced String
x = String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
xs
  | Bool
otherwise = case (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span String -> Bool
areQuotesBalanced [String]
xs of
    ([String]
_, [])      -> [] -- malformed CSV
    ([String]
ys, String
z : [String]
zs) -> [String] -> String
unlines (String
x String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
ys [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
z]) String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
joinQuotedFields [String]
zs
  where
    areQuotesBalanced :: String -> Bool
areQuotesBalanced = Key -> Bool
forall a. Integral a => a -> Bool
even (Key -> Bool) -> (String -> Key) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Key
forall a. [a] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length (String -> Key) -> ShowS -> String -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')

estTime :: Estimate -> Double
estTime :: Estimate -> Double
estTime = Word64 -> Double
word64ToDouble (Word64 -> Double) -> (Estimate -> Word64) -> Estimate -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Measurement -> Word64
measTime (Measurement -> Word64)
-> (Estimate -> Measurement) -> Estimate -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Estimate -> Measurement
estMean

compareVsBaseline :: S.Set String -> TestName -> Estimate -> Maybe Double
compareVsBaseline :: Set String -> String -> Estimate -> Maybe Double
compareVsBaseline Set String
baseline String
name (Estimate Measurement
m Word64
stdev) = case Maybe (Int64, Int64)
mOld of
  Maybe (Int64, Int64)
Nothing -> Maybe Double
forall a. Maybe a
Nothing
  Just (Int64
oldTime, Int64
oldDoubleSigma)
    -- time and oldTime must be signed integers to use 'abs'
    | Int64 -> Int64
forall {a}. Num a => a -> a
abs (Int64
time Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
oldTime) Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64 -> Int64 -> Int64
forall a. Ord a => a -> a -> a
max (Int64
2 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Word64 -> Int64
word64ToInt64 Word64
stdev) Int64
oldDoubleSigma -> Double -> Maybe Double
forall a. a -> Maybe a
Just Double
1
    | Bool
otherwise -> Double -> Maybe Double
forall a. a -> Maybe a
Just (Double -> Maybe Double) -> Double -> Maybe Double
forall a b. (a -> b) -> a -> b
$ Int64 -> Double
int64ToDouble Int64
time Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int64 -> Double
int64ToDouble Int64
oldTime
  where
    time :: Int64
time = Word64 -> Int64
word64ToInt64 (Word64 -> Int64) -> Word64 -> Int64
forall a b. (a -> b) -> a -> b
$ Measurement -> Word64
measTime Measurement
m

    mOld :: Maybe (Int64, Int64)
    mOld :: Maybe (Int64, Int64)
mOld = do
      let prefix :: String
prefix = ShowS
encodeCsv String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
","
      (String
line, Set String
furtherLines) <- Set String -> Maybe (String, Set String)
forall a. Set a -> Maybe (a, Set a)
S.minView (Set String -> Maybe (String, Set String))
-> Set String -> Maybe (String, Set String)
forall a b. (a -> b) -> a -> b
$ (Set String, Set String) -> Set String
forall a b. (a, b) -> b
snd ((Set String, Set String) -> Set String)
-> (Set String, Set String) -> Set String
forall a b. (a -> b) -> a -> b
$ String -> Set String -> (Set String, Set String)
forall a. Ord a => a -> Set a -> (Set a, Set a)
S.split String
prefix Set String
baseline

      case Set String -> Maybe (String, Set String)
forall a. Set a -> Maybe (a, Set a)
S.minView Set String
furtherLines of
        Maybe (String, Set String)
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (String
nextLine, Set String
_) -> case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
nextLine of
          Maybe String
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          -- If there are several lines matching prefix, skip them all.
          -- Should not normally happen, 'csvReporter' prohibits repeating test names.
          Just{}  -> Maybe ()
forall a. Maybe a
Nothing

      (String
timeCell, Char
',' : String
rest) <- (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') (String -> (String, String))
-> Maybe String -> Maybe (String, String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
prefix String
line
      let doubleSigmaCell :: String
doubleSigmaCell = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') String
rest
      (,) (Int64 -> Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64 -> (Int64, Int64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Maybe Int64
forall a. Read a => String -> Maybe a
safeRead String
timeCell Maybe (Int64 -> (Int64, Int64))
-> Maybe Int64 -> Maybe (Int64, Int64)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Maybe Int64
forall a. Read a => String -> Maybe a
safeRead String
doubleSigmaCell

formatSlowDown :: Maybe Double -> String
formatSlowDown :: Maybe Double -> String
formatSlowDown Maybe Double
Nothing = String
""
formatSlowDown (Just Double
ratio) = case Int64
percents Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int64
0 of
  Ordering
LT -> String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
", %2i%% less than baseline" (-Int64
percents)
  Ordering
EQ -> String
",       same as baseline"
  Ordering
GT -> String -> Int64 -> String
forall r. PrintfType r => String -> r
printf String
", %2i%% more than baseline" Int64
percents
  where
    percents :: Int64
    percents :: Int64
percents = Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate ((Double
ratio Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)

forceFail :: Result -> Result
forceFail :: Result -> Result
forceFail Result
r = Result
r { resultOutcome = Failure TestFailed, resultShortDescription = "FAIL" }

data Unique a = None | Unique !a | NotUnique
  deriving ((forall a b. (a -> b) -> Unique a -> Unique b)
-> (forall a b. a -> Unique b -> Unique a) -> Functor Unique
forall a b. a -> Unique b -> Unique a
forall a b. (a -> b) -> Unique a -> Unique b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Unique a -> Unique b
fmap :: forall a b. (a -> b) -> Unique a -> Unique b
$c<$ :: forall a b. a -> Unique b -> Unique a
<$ :: forall a b. a -> Unique b -> Unique a
Functor)

instance Semigroup (Unique a) where
  Unique a
None <> :: Unique a -> Unique a -> Unique a
<> Unique a
a = Unique a
a
  Unique a
a <> Unique a
None = Unique a
a
  Unique a
_ <> Unique a
_ = Unique a
forall a. Unique a
NotUnique

instance Monoid (Unique a) where
  mempty :: Unique a
mempty = Unique a
forall a. Unique a
None
  mappend :: Unique a -> Unique a -> Unique a
mappend = Unique a -> Unique a -> Unique a
forall a. Semigroup a => a -> a -> a
(<>)

modifyConsoleReporter
    :: [OptionDescription]
    -> (OptionSet -> IO (TestName -> Maybe (WithLoHi Result) -> Result -> Result))
    -> Ingredient
modifyConsoleReporter :: [OptionDescription]
-> (OptionSet
    -> IO (String -> Maybe (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [OptionDescription]
desc' OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
iof = [OptionDescription]
-> (OptionSet
    -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter ([OptionDescription]
desc [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++ [OptionDescription]
desc') ((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 ->
  let nameSeqs :: IntMap (Seq String)
nameSeqs     = [(Key, Seq String)] -> IntMap (Seq String)
forall a. [(Key, a)] -> IntMap a
IM.fromDistinctAscList ([(Key, Seq String)] -> IntMap (Seq String))
-> [(Key, Seq String)] -> IntMap (Seq String)
forall a b. (a -> b) -> a -> b
$ [Key] -> [Seq String] -> [(Key, Seq String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0..] ([Seq String] -> [(Key, Seq String)])
-> [Seq String] -> [(Key, Seq String)]
forall a b. (a -> b) -> a -> b
$ OptionSet -> Benchmark -> [Seq String]
testNameSeqs OptionSet
opts Benchmark
tree
      namesAndDeps :: IntMap (String, Maybe (WithLoHi Key))
namesAndDeps = [(Key, (String, Maybe (WithLoHi Key)))]
-> IntMap (String, Maybe (WithLoHi Key))
forall a. [(Key, a)] -> IntMap a
IM.fromDistinctAscList ([(Key, (String, Maybe (WithLoHi Key)))]
 -> IntMap (String, Maybe (WithLoHi Key)))
-> [(Key, (String, Maybe (WithLoHi Key)))]
-> IntMap (String, Maybe (WithLoHi Key))
forall a b. (a -> b) -> a -> b
$ [Key]
-> [(String, Maybe (WithLoHi Key))]
-> [(Key, (String, Maybe (WithLoHi Key)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
0..] ([(String, Maybe (WithLoHi Key))]
 -> [(Key, (String, Maybe (WithLoHi Key)))])
-> [(String, Maybe (WithLoHi Key))]
-> [(Key, (String, Maybe (WithLoHi Key)))]
forall a b. (a -> b) -> a -> b
$ ((String, Unique (WithLoHi Key)) -> (String, Maybe (WithLoHi Key)))
-> [(String, Unique (WithLoHi Key))]
-> [(String, Maybe (WithLoHi Key))]
forall a b. (a -> b) -> [a] -> [b]
map ((Unique (WithLoHi Key) -> Maybe (WithLoHi Key))
-> (String, Unique (WithLoHi Key))
-> (String, Maybe (WithLoHi Key))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second Unique (WithLoHi Key) -> Maybe (WithLoHi Key)
forall {a}. Unique a -> Maybe a
isSingle)
                   ([(String, Unique (WithLoHi Key))]
 -> [(String, Maybe (WithLoHi Key))])
-> [(String, Unique (WithLoHi Key))]
-> [(String, Maybe (WithLoHi Key))]
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String)
-> OptionSet -> Benchmark -> [(String, Unique (WithLoHi Key))]
testNamesAndDeps IntMap (Seq String)
nameSeqs OptionSet
opts Benchmark
tree
      modifySMap :: StatusMap -> IO StatusMap
modifySMap   = (OptionSet
-> IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
iof OptionSet
opts IO (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> ((String -> Maybe (WithLoHi Result) -> Result -> Result)
    -> IO StatusMap)
-> IO StatusMap
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=) (((String -> Maybe (WithLoHi Result) -> Result -> Result)
  -> IO StatusMap)
 -> IO StatusMap)
-> (StatusMap
    -> (String -> Maybe (WithLoHi Result) -> Result -> Result)
    -> IO StatusMap)
-> StatusMap
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String -> Maybe (WithLoHi Result) -> Result -> Result)
 -> IntMap (String, Maybe (WithLoHi Key), TVar Status)
 -> IO StatusMap)
-> IntMap (String, Maybe (WithLoHi Key), TVar Status)
-> (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IO StatusMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IntMap (String, Maybe (WithLoHi Key), TVar Status)
-> IO StatusMap
postprocessResult
                   (IntMap (String, Maybe (WithLoHi Key), TVar Status)
 -> (String -> Maybe (WithLoHi Result) -> Result -> Result)
 -> IO StatusMap)
-> (StatusMap
    -> IntMap (String, Maybe (WithLoHi Key), TVar Status))
-> StatusMap
-> (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Maybe (WithLoHi Key))
 -> TVar Status -> (String, Maybe (WithLoHi Key), TVar Status))
-> IntMap (String, Maybe (WithLoHi Key))
-> StatusMap
-> IntMap (String, Maybe (WithLoHi Key), TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (\(String
a, Maybe (WithLoHi Key)
b) TVar Status
c -> (String
a, Maybe (WithLoHi Key)
b, TVar Status
c)) IntMap (String, Maybe (WithLoHi Key))
namesAndDeps
  in (StatusMap -> IO StatusMap
modifySMap (StatusMap -> IO StatusMap)
-> (StatusMap -> IO (Double -> IO Bool))
-> StatusMap
-> IO (Double -> IO Bool)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=>) ((StatusMap -> IO (Double -> IO Bool))
 -> StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb OptionSet
opts Benchmark
tree
  where
    ([OptionDescription]
desc, OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb) = case Ingredient
consoleTestReporter of
      TestReporter [OptionDescription]
d OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
c -> ([OptionDescription]
d, OptionSet
-> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool))
c)
      Ingredient
_ -> String
-> ([OptionDescription],
    OptionSet
    -> Benchmark -> Maybe (StatusMap -> IO (Double -> IO Bool)))
forall a. HasCallStack => String -> a
error String
"modifyConsoleReporter: consoleTestReporter must be TestReporter"

    isSingle :: Unique a -> Maybe a
isSingle (Unique a
a) = a -> Maybe a
forall a. a -> Maybe a
Just a
a
    isSingle Unique a
_ = Maybe a
forall a. Maybe a
Nothing

-- | Convert a test tree to a list of test names.
testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]
testNameSeqs :: OptionSet -> Benchmark -> [Seq String]
testNameSeqs = TreeFold [Seq String] -> OptionSet -> Benchmark -> [Seq String]
forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree TreeFold [Seq String]
forall b. Monoid b => TreeFold b
trivialFold
  { foldSingle = const $ const . (:[]) . Seq.singleton
#if MIN_VERSION_tasty(1,5,0)
  , foldGroup  = const $ (. concat) . map . (<|)
#else
  , foldGroup  = const $ map . (<|)
#endif
  }

testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi IM.Key))]
testNamesAndDeps :: IntMap (Seq String)
-> OptionSet -> Benchmark -> [(String, Unique (WithLoHi Key))]
testNamesAndDeps IntMap (Seq String)
im = TreeFold [(String, Unique (WithLoHi Key))]
-> OptionSet -> Benchmark -> [(String, Unique (WithLoHi Key))]
forall b. Monoid b => TreeFold b -> OptionSet -> Benchmark -> b
foldTestTree TreeFold [(String, Unique (WithLoHi Key))]
forall b. Monoid b => TreeFold b
trivialFold
  { foldSingle = const $ const . (: []) . (, mempty)
#if MIN_VERSION_tasty(1,5,0)
  , foldGroup  = const $ (. concat) . map . first . (++) . (++ ".")
#else
  , foldGroup  = const $ map . first . (++) . (++ ".")
#endif
  , foldAfter  = const foldDeps
  }
  where
    foldDeps :: DependencyType -> Expr -> [(a, Unique (WithLoHi IM.Key))] -> [(a, Unique (WithLoHi IM.Key))]
    foldDeps :: forall a.
DependencyType
-> Expr
-> [(a, Unique (WithLoHi Key))]
-> [(a, Unique (WithLoHi Key))]
foldDeps DependencyType
AllSucceed (And (StringLit String
xs) Expr
p)
      | String
bcomparePrefix String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
xs
      , Just (Double
lo :: Double, Double
hi :: Double) <- String -> Maybe (Double, Double)
forall a. Read a => String -> Maybe a
safeRead (String -> Maybe (Double, Double))
-> String -> Maybe (Double, Double)
forall a b. (a -> b) -> a -> b
$ Key -> ShowS
forall a. Key -> [a] -> [a]
drop (String -> Key
forall a. [a] -> Key
forall (t :: * -> *) a. Foldable t => t a -> Key
length String
bcomparePrefix) String
xs
      = ((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))]
forall a b. (a -> b) -> [a] -> [b]
map (((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
 -> [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))])
-> ((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> [(a, Unique (WithLoHi Key))]
-> [(a, Unique (WithLoHi Key))]
forall a b. (a -> b) -> a -> b
$ (Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key))
forall b c d. (b -> c) -> (d, b) -> (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ((Unique (WithLoHi Key) -> Unique (WithLoHi Key))
 -> (a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> (Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key))
forall a b. (a -> b) -> a -> b
$ Unique (WithLoHi Key)
-> Unique (WithLoHi Key) -> Unique (WithLoHi Key)
forall a. Monoid a => a -> a -> a
mappend (Unique (WithLoHi Key)
 -> Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> Unique (WithLoHi Key)
-> Unique (WithLoHi Key)
-> Unique (WithLoHi Key)
forall a b. (a -> b) -> a -> b
$ (\Key
x -> Key -> Double -> Double -> WithLoHi Key
forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Key
x Double
lo Double
hi) (Key -> WithLoHi Key) -> Unique Key -> Unique (WithLoHi Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Seq String) -> Expr -> Unique Key
findMatchingKeys IntMap (Seq String)
im Expr
p
    foldDeps DependencyType
_ Expr
_ = [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))]
forall a. a -> a
id

findMatchingKeys :: IntMap (Seq TestName) -> Expr -> Unique IM.Key
findMatchingKeys :: IntMap (Seq String) -> Expr -> Unique Key
findMatchingKeys IntMap (Seq String)
im Expr
pattern =
  ((Key, Seq String) -> Unique Key)
-> [(Key, Seq String)] -> Unique Key
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Key
k, Seq String
v) -> if Seq String -> M Bool -> Either String Bool
forall a. Seq String -> M a -> Either String a
withFields Seq String
v M Bool
pat Either String Bool -> Either String Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either String Bool
forall a b. b -> Either a b
Right Bool
True then Key -> Unique Key
forall a. a -> Unique a
Unique Key
k else Unique Key
forall a. Monoid a => a
mempty) ([(Key, Seq String)] -> Unique Key)
-> [(Key, Seq String)] -> Unique Key
forall a b. (a -> b) -> a -> b
$ IntMap (Seq String) -> [(Key, Seq String)]
forall a. IntMap a -> [(Key, a)]
IM.assocs IntMap (Seq String)
im
  where
    pat :: M Bool
pat = Expr -> M Value
eval Expr
pattern M Value -> (Value -> M Bool) -> M Bool
forall a b.
ReaderT (Seq String) (Either String) a
-> (a -> ReaderT (Seq String) (Either String) b)
-> ReaderT (Seq String) (Either String) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> M Bool
asB

postprocessResult
    :: (TestName -> Maybe (WithLoHi Result) -> Result -> Result)
    -> IntMap (TestName, Maybe (WithLoHi IM.Key), TVar Status)
    -> IO StatusMap
postprocessResult :: (String -> Maybe (WithLoHi Result) -> Result -> Result)
-> IntMap (String, Maybe (WithLoHi Key), TVar Status)
-> IO StatusMap
postprocessResult String -> Maybe (WithLoHi Result) -> Result -> Result
f IntMap (String, Maybe (WithLoHi Key), TVar Status)
src = do
  IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
paired <- IntMap (String, Maybe (WithLoHi Key), TVar Status)
-> ((String, Maybe (WithLoHi Key), TVar Status)
    -> IO (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
-> IO
     (IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IntMap (String, Maybe (WithLoHi Key), TVar Status)
src (((String, Maybe (WithLoHi Key), TVar Status)
  -> IO (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
 -> IO
      (IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)))
-> ((String, Maybe (WithLoHi Key), TVar Status)
    -> IO (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
-> IO
     (IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe (WithLoHi Key)
mDepId, TVar Status
tv) -> (String
name, Maybe (WithLoHi Key)
mDepId, TVar Status
tv,) (TVar Status
 -> (String, Maybe (WithLoHi Key), TVar Status, TVar Status))
-> IO (TVar Status)
-> IO (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> IO (TVar Status)
forall a. a -> IO (TVar a)
newTVarIO Status
NotStarted
  let doUpdate :: IO Bool
doUpdate = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
        (Any Bool
anyUpdated, All Bool
allDone) <-
          Ap STM (Any, All) -> STM (Any, All)
forall (f :: * -> *) a. Ap f a -> f a
getApp (Ap STM (Any, All) -> STM (Any, All))
-> Ap STM (Any, All) -> STM (Any, All)
forall a b. (a -> b) -> a -> b
$ (((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
  -> Ap STM (Any, All))
 -> IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
 -> Ap STM (Any, All))
-> IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
-> ((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
    -> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
 -> Ap STM (Any, All))
-> IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
-> Ap STM (Any, All)
forall m a. Monoid m => (a -> m) -> IntMap a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
paired (((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
  -> Ap STM (Any, All))
 -> Ap STM (Any, All))
-> ((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
    -> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ \(String
name, Maybe (WithLoHi Key)
mDepId, TVar Status
newTV, TVar Status
oldTV) -> STM (Any, All) -> Ap STM (Any, All)
forall (f :: * -> *) a. f a -> Ap f a
Ap (STM (Any, All) -> Ap STM (Any, All))
-> STM (Any, All) -> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ do
            Status
old <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
oldTV
            case Status
old of
              Done{} -> (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
True)
              Status
_ -> do
                Status
new <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
newTV
                case Status
new of
                  Done Result
res -> do

                    Maybe (WithLoHi Result)
depRes <- case Maybe (WithLoHi Key)
mDepId of
                      Maybe (WithLoHi Key)
Nothing -> Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (WithLoHi Result)
forall a. Maybe a
Nothing
                      Just (WithLoHi Key
depId Double
lo Double
hi) -> case Key
-> IntMap (String, Maybe (WithLoHi Key), TVar Status)
-> Maybe (String, Maybe (WithLoHi Key), TVar Status)
forall a. Key -> IntMap a -> Maybe a
IM.lookup Key
depId IntMap (String, Maybe (WithLoHi Key), TVar Status)
src of
                        Maybe (String, Maybe (WithLoHi Key), TVar Status)
Nothing -> Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (WithLoHi Result)
forall a. Maybe a
Nothing
                        Just (String
_, Maybe (WithLoHi Key)
_, TVar Status
depTV) -> do
                          Status
depStatus <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
depTV
                          case Status
depStatus of
                            Done Result
dep -> Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result)))
-> Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result))
forall a b. (a -> b) -> a -> b
$ WithLoHi Result -> Maybe (WithLoHi Result)
forall a. a -> Maybe a
Just (Result -> Double -> Double -> WithLoHi Result
forall a. a -> Double -> Double -> WithLoHi a
WithLoHi Result
dep Double
lo Double
hi)
                            Status
_ -> Maybe (WithLoHi Result) -> STM (Maybe (WithLoHi Result))
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (WithLoHi Result)
forall a. Maybe a
Nothing

                    TVar Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Result -> Status
Done (String -> Maybe (WithLoHi Result) -> Result -> Result
f String
name Maybe (WithLoHi Result)
depRes Result
res))
                    (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, Bool -> All
All Bool
True)
#if MIN_VERSION_tasty(1,5,0)
                  Executing Progress
newProgr -> do
                    let updated :: Bool
updated = case Status
old of
                          Executing Progress
oldProgr -> Progress
oldProgr Progress -> Progress -> Bool
forall a. Eq a => a -> a -> Bool
/= Progress
newProgr
                          Status
_ -> Bool
True
                    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
                      TVar Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Progress -> Status
Executing Progress
newProgr)
                    (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
updated, Bool -> All
All Bool
False)
#else
                  Executing{} -> pure (Any False, All False)
#endif
                  Status
NotStarted -> (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
False)
        if Bool
anyUpdated Bool -> Bool -> Bool
|| Bool
allDone then Bool -> STM Bool
forall a. a -> STM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
allDone else STM Bool
forall a. STM a
retry
      adNauseam :: IO ()
adNauseam = IO Bool
doUpdate IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
`unless` IO ()
adNauseam)
  ThreadId
_ <- IO () -> IO ThreadId
forkIO IO ()
adNauseam
  StatusMap -> IO StatusMap
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (StatusMap -> IO StatusMap) -> StatusMap -> IO StatusMap
forall a b. (a -> b) -> a -> b
$ ((String, Maybe (WithLoHi Key), TVar Status, TVar Status)
 -> TVar Status)
-> IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
-> StatusMap
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(String
_, Maybe (WithLoHi Key)
_, TVar Status
_, TVar Status
a) -> TVar Status
a) IntMap (String, Maybe (WithLoHi Key), TVar Status, TVar Status)
paired

int64ToDouble :: Int64 -> Double
int64ToDouble :: Int64 -> Double
int64ToDouble = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

word64ToInt64 :: Word64 -> Int64
word64ToInt64 :: Word64 -> Int64
word64ToInt64 = Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

#endif

word64ToDouble :: Word64 -> Double
word64ToDouble :: Word64 -> Double
word64ToDouble = Word64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral

#if !MIN_VERSION_base(4,10,0)
int64ToWord64 :: Int64 -> Word64
int64ToWord64 = fromIntegral
#endif


#if defined(mingw32_HOST_OS)

#if defined(i386_HOST_ARCH)
#define CCONV stdcall
#else
#define CCONV ccall
#endif

foreign import CCONV unsafe "windows.h GetConsoleOutputCP" getConsoleOutputCP :: IO Word32
foreign import CCONV unsafe "windows.h SetConsoleOutputCP" setConsoleOutputCP :: Word32 -> IO ()

#endif

#ifdef MIN_VERSION_tasty

-- | Map leaf benchmarks ('bench', not 'bgroup') with a provided function,
-- which has an access to leaf's reversed path.
--
-- This helper is useful for bulk application of 'bcompare'.
-- See also 'locateBenchmark'.
--
-- Real world examples:
--
-- * https://hackage.haskell.org/package/chimera-0.3.3.0/src/bench/Bench.hs
-- * https://hackage.haskell.org/package/text-builder-linear-0.1.1/src/bench/Main.hs
--
-- @since 0.3.2
mapLeafBenchmarks :: ([String] -> Benchmark -> Benchmark) -> Benchmark -> Benchmark
mapLeafBenchmarks :: ([String] -> Benchmark -> Benchmark) -> Benchmark -> Benchmark
mapLeafBenchmarks [String] -> Benchmark -> Benchmark
processLeaf = [String] -> Benchmark -> Benchmark
go [String]
forall a. Monoid a => a
mempty
  where
    go :: [String] -> Benchmark -> Benchmark
    go :: [String] -> Benchmark -> Benchmark
go [String]
path Benchmark
x = case Benchmark
x of
      SingleTest String
name t
t    -> [String] -> Benchmark -> Benchmark
processLeaf (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
path) (String -> t -> Benchmark
forall t. IsTest t => String -> t -> Benchmark
SingleTest String
name t
t)
      TestGroup String
name [Benchmark]
tts   -> String -> [Benchmark] -> Benchmark
TestGroup String
name ((Benchmark -> Benchmark) -> [Benchmark] -> [Benchmark]
forall a b. (a -> b) -> [a] -> [b]
map ([String] -> Benchmark -> Benchmark
go (String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
path))  [Benchmark]
tts)
      PlusTestOptions OptionSet -> OptionSet
g Benchmark
tt -> (OptionSet -> OptionSet) -> Benchmark -> Benchmark
PlusTestOptions OptionSet -> OptionSet
g ([String] -> Benchmark -> Benchmark
go [String]
path Benchmark
tt)
      WithResource ResourceSpec a
res IO a -> Benchmark
f   -> ResourceSpec a -> (IO a -> Benchmark) -> Benchmark
forall a. ResourceSpec a -> (IO a -> Benchmark) -> Benchmark
WithResource ResourceSpec a
res ([String] -> Benchmark -> Benchmark
go [String]
path (Benchmark -> Benchmark)
-> (IO a -> Benchmark) -> IO a -> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO a -> Benchmark
f)
      AskOptions OptionSet -> Benchmark
f         -> (OptionSet -> Benchmark) -> Benchmark
AskOptions ([String] -> Benchmark -> Benchmark
go [String]
path (Benchmark -> Benchmark)
-> (OptionSet -> Benchmark) -> OptionSet -> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OptionSet -> Benchmark
f)
      After DependencyType
dep Expr
expr Benchmark
tt    -> DependencyType -> Expr -> Benchmark -> Benchmark
After DependencyType
dep Expr
expr ([String] -> Benchmark -> Benchmark
go [String]
path Benchmark
tt)

-- | Construct an AWK expression to locate an individual element or elements in 'Benchmark'
-- by the suffix of the path. Names are listed in reverse order:
-- from 'bench'\'s own name to a name of the outermost 'bgroup'.
--
-- This function is meant to be used in conjunction with 'bcompare', e. g.,
-- 'bcompare' ('Test.Tasty.Patterns.Printer.printAwkExpr' ('locateBenchmark' @path@)).
-- See also 'mapLeafBenchmarks'.
--
-- Real world examples:
--
-- * https://hackage.haskell.org/package/chimera-0.3.3.0/src/bench/Bench.hs
-- * https://hackage.haskell.org/package/text-builder-linear-0.1.1/src/bench/Main.hs
--
-- @since 0.3.2
locateBenchmark :: [String] -> Expr
locateBenchmark :: [String] -> Expr
locateBenchmark [] = Key -> Expr
IntLit Key
1
locateBenchmark [String]
path
  = (Expr -> Expr -> Expr) -> [Expr] -> Expr
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Expr -> Expr -> Expr
And
  ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ (Key -> String -> Expr) -> [Key] -> [String] -> [Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Key
i String
name -> Expr -> Expr -> Expr
Patterns.EQ (Expr -> Expr
Field (Expr -> Expr -> Expr
Sub Expr
NF (Key -> Expr
IntLit Key
i))) (String -> Expr
StringLit String
name)) [Key
0..] [String]
path

#endif