testbench-0.2.1.3: Create tests and benchmarks together

Copyright(c) Ivan Lazar Miljenovic
LicenseMIT
MaintainerIvan.Miljenovic@gmail.com
Safe HaskellNone
LanguageHaskell2010

TestBench

Contents

Description

Make it easier to compare benchmarks and to test that benchmarks are indeed valid.

At the top level you will probably run the testBench function, and create comparisons using compareFunc or the list-based variants.

For example:

main :: IO ()
main = testBench $ do
  -- Compare how long it takes to make a list of the specified length.
  compareFunc "List length"
              (\n -> length (replicate n ()) == n)
              [testWith (@? "Not as long as specified"), benchNormalForm]
              (mapM_ (\n -> comp ("len == " ++ show n) n) [1..5])

When run, the output will look something like:

Cases: 7  Tried: 7  Errors: 0  Failures: 0
                          Mean    MeanLB    MeanUB    Stddev  StddevLB  StddevUB  OutlierVariance
List length
  len == 1            323.8 ns  318.6 ns  335.9 ns  23.86 ns  5.834 ns  40.90 ns              83%
  len == 2            352.8 ns  349.1 ns  358.1 ns  15.05 ns  11.76 ns  19.62 ns              61%
  len == 3            372.4 ns  358.4 ns  393.8 ns  62.50 ns  39.83 ns  90.85 ns              96%
  len == 4            396.3 ns  378.4 ns  419.2 ns  67.83 ns  46.71 ns  94.74 ns              96%
  len == 5            426.0 ns  407.0 ns  459.5 ns  82.23 ns  53.37 ns  110.2 ns              97%
Synopsis

Specification and running

type TestBench = TestBenchM () Source #

An environment for combining testing and benchmarking.

testBench :: TestBench -> IO () Source #

Run the specified benchmarks if and only if all tests pass, using a comparison-based format for benchmarking output.

For more control, use getTestBenches.

testBenchWith :: Config -> TestBench -> IO () Source #

As with testBench but allow specifying a custom default Config parameter rather than testBenchConfig.

Since: 0.2.0.0

testBenchConfig :: Config Source #

This is the same as defaultConfig from criterion but with the verbosity set to Quiet to avoid unnecessary noise on stdout.

Since: 0.2.0.0

Grouping

collection :: String -> TestBench -> TestBench Source #

Label a sub-part of a TestBench.

Comparisons

compareFunc :: ProvideParams params a b => String -> (a -> b) -> params -> Comparison a b -> TestBench Source #

Compare how various input values (of the same type) behave for a specific function.

By default:

  • Results are only evaluated to Weak Head Normal Form. To fully evaluate results, use benchNormalForm.
  • No tests are performed by default; use either baseline or testWith to specify one.

List of input values

Rather than manually stating all the arguments - especially if you're either a) dealing with a few different types or b) repeating all the possible targets a few times - it can be helpful to instead use an enum type to indicate all the possible options with a helper type class to generate all the possible benchmarks.

For example, consider a case where you wish to compare data structures of Word8 values:

import qualified Data.ByteString      as SB
import qualified Data.ByteString.Lazy as LB
import           Data.Monoid          ((<>))
import           Data.Proxy           (Proxy(..))
import qualified Data.Sequence        as Seq

-- | All the types we care about.
data SequenceType = List
                  | Sequence
                  | StrictBS
                  | LazyBS
  deriving (Eq, Ord, Show, Read, Enum, Bounded)

-- | The function we actually want to benchmark.
listLength :: (Sequential l) => Proxy l -> Int
listLength st = len (st `pack` sampleList)

-- | How to run a function on our chosen type.
chooseType :: SequenceType -> (forall s. (Sequential s) => Proxy s -> k) -> k
chooseType List      k = k (Proxy :: Proxy [Word8])
chooseType Sequence  k = k (Proxy :: Proxy (Seq.Seq Word8))
chooseType StrictBS  k = k (Proxy :: Proxy SB.ByteString)
chooseType LazyBS    k = k (Proxy :: Proxy LB.ByteString)

sampleList :: [Word8]
sampleList = replicate 1000000 0

-- | A common type class containing all the functions we want to test.
class Sequential xs where
  len :: xs -> Int

  pack :: Proxy xs -> [Word8] -> xs

instance Sequential [Word8] where
  len = length

  pack _ = id

instance Sequential (Seq.Seq Word8) where
  len = length

  pack _ = Seq.fromList

instance Sequential SB.ByteString where
  len = SB.length

  pack _ = SB.pack

instance Sequential LB.ByteString where
  len = fromIntegral . LB.length

  pack _ = LB.pack

We can then write as our benchmark:

compareFuncAll "Packing and length"
               (flip chooseType listLength)
               normalForm

This may seem like a lot of up-front work just to avoid having to write out all the cases manually, but if you write a lot of similar benchmarks comparing different aspects of these sequential structures then the chooseType function ends up being rather trivial to write (but alas, barring Template Haskell, not possible to easily automate).

Furthermore, you can now be sure that you won't forget a case!

compareFuncList :: (ProvideParams params a b, Show a, Eq b, Show b) => String -> (a -> b) -> params -> [a] -> TestBench Source #

As with compareFunc but use the provided list of values to base the benchmarking off of.

This is useful in situations where you create an enumeration type to describe everything you're benchmarking and a function that takes one of these values and evaluates it.

baseline is used on the first value (if non-empty); the Show instance is used to provide labels.

Since: 0.2.0.0

compareFuncListIO :: (ProvideParams params a (IO b), Show a, Eq b, Show b) => String -> (a -> IO b) -> params -> [a] -> TestBench Source #

A variant of compareFuncList that allows for the function to return an IO value.

Since: 0.2.0.0

compareFuncListWith :: (ProvideParams params a b, Show a) => (String -> a -> CompParams a b) -> String -> (a -> b) -> params -> [a] -> TestBench Source #

A variant of compareFuncList where you provide your own equivalent to baseline.

Most useful with baselineWith.

Since: 0.2.0.0

compareFuncList' :: (ProvideParams params a b, Show a) => String -> (a -> b) -> params -> [a] -> TestBench Source #

A variant of compareFuncList that doesn't use baseline (allowing you to specify your own test).

Since: 0.2.0.0

compareFuncAll :: (ProvideParams params a b, Show a, Enum a, Bounded a, Eq b, Show b) => String -> (a -> b) -> params -> TestBench Source #

An extension to compareFuncList that uses the Bounded and Enum instances to generate the list of all values.

Since: 0.2.0.0

compareFuncAllIO :: (ProvideParams params a (IO b), Show a, Enum a, Bounded a, Eq b, Show b) => String -> (a -> IO b) -> params -> TestBench Source #

An extension to compareFuncListIO that uses the Bounded and Enum instances to generate the list of all values.

Since: 0.2.0.0

compareFuncAllWith :: (ProvideParams params a b, Show a, Enum a, Bounded a, Eq b, Show b) => (String -> a -> CompParams a b) -> String -> (a -> b) -> params -> TestBench Source #

An extension to compareFuncListWith that uses the Bounded and Enum instances to generate the list of all values.

Since: 0.2.1.0

compareFuncAll' :: (ProvideParams params a b, Show a, Enum a, Bounded a) => String -> (a -> b) -> params -> TestBench Source #

A variant of comapreFuncAll that doesn't use baseline (allowing you to specify your own test).

Since: 0.2.0.0

Comparison parameters

data CompParams a b Source #

Monoidally build up the parameters used to control a Comparison environment.

This will typically be a combination of benchNormalForm with either baseline or testWith.

Instances
ProvideParams [CompParams a b] a b Source # 
Instance details

Defined in TestBench

Methods

toParams :: [CompParams a b] -> CompParams a b Source #

Semigroup (CompParams a b) Source # 
Instance details

Defined in TestBench

Methods

(<>) :: CompParams a b -> CompParams a b -> CompParams a b #

sconcat :: NonEmpty (CompParams a b) -> CompParams a b #

stimes :: Integral b0 => b0 -> CompParams a b -> CompParams a b #

Monoid (CompParams a b) Source # 
Instance details

Defined in TestBench

Methods

mempty :: CompParams a b #

mappend :: CompParams a b -> CompParams a b -> CompParams a b #

mconcat :: [CompParams a b] -> CompParams a b #

ProvideParams (CompParams a b) a b Source # 
Instance details

Defined in TestBench

Methods

toParams :: CompParams a b -> CompParams a b Source #

class ProvideParams cp a b | cp -> a b where Source #

A convenience class to make it easier to provide CompParams values.

You can either:

  • Provide no parameters with mempty
  • Provide values chained together using mappend or <>
  • Use the list instance and provide a list of CompParams values.

Since: 0.2.0.0

Methods

toParams :: cp -> CompParams a b Source #

Instances
ProvideParams [CompParams a b] a b Source # 
Instance details

Defined in TestBench

Methods

toParams :: [CompParams a b] -> CompParams a b Source #

ProvideParams (CompParams a b) a b Source # 
Instance details

Defined in TestBench

Methods

toParams :: CompParams a b -> CompParams a b Source #

normalForm :: NFData b => CompParams a b Source #

A combination of benchNormalForm and weigh, taking into account the common case that you want to consider a value that can - and should - be evaluated to normal form.

Since: 0.2.0.0

normalFormIO :: NFData b => CompParams a (IO b) Source #

A variant of normalForm where the results are within IO.

Since: 0.2.0.0

Control benchmarking

benchNormalForm :: NFData b => CompParams a b Source #

Evaluate all benchmarks to normal form.

benchIO :: CompParams a (IO b) Source #

Evaluate all IO-based benchmarks to weak head normal form.

Since: 0.2.0.0

benchNormalFormIO :: NFData b => CompParams a (IO b) Source #

Evaluate all IO-based benchmarks to normal form.

Since: 0.2.0.0

withBenchMode :: ((a -> b) -> a -> Benchmarkable) -> CompParams a b Source #

Allow specifying how benchmarks should be evaluated. This may allow usage of methods such as nfIO, but this has not been tested as yet.

noBenchmarks :: CompParams a b Source #

Don't run any benchmarks. I'm not sure why you'd want to do this as there's surely easier/better testing environments available, but this way it's possible.

Control testing

baseline :: (Eq b, Show b) => String -> a -> CompParams a b Source #

Specify a sample baseline value to benchmark and test against (such that the result of applying the function to this a is what everything should match).

You shouldn't specify this more than once, nor mix it with noTests or testWith.

Since: 0.2.0.0

baselineIO :: (Eq b, Show b) => String -> a -> CompParams a (IO b) Source #

A variant of baseline where the function returns an IO value.

Since: 0.2.0.0

baselineWith :: (b -> b -> Assertion) -> String -> a -> CompParams a b Source #

A variant of baseline that lets you specify how to test for equality.

The first argument to the provided function will be the "baseline" value; the second will be the value being tested.

Since: 0.2.0.0

testWith :: (b -> Assertion) -> CompParams a b Source #

Specify a predicate that all results should satisfy.

Note that the last statement between testWith, baseline and noTests "wins" in specifying which testing (if any) to do.

noTests :: CompParams a b Source #

Don't run any tests. This isn't recommended, but could be useful if all you want to do is run comparisons (potentially because no meaningful tests are possible).

Control function weighing

weigh :: NFData b => CompParams a b Source #

Calculate memory usage of the various parameters.

Note that to achieve this, testBench and associated functions will run copies of itself to be able to calculate memory usage in a pristine environment (i.e. without influence of caching from testing and benchmarking). As such, you may wish to use the -threaded GHC option when building your benchmarking executable.

Since: 0.2.0.0

weighIO :: NFData b => CompParams a (IO b) Source #

An IO-based equivalent to weigh

Since: 0.2.0.0

data GetWeight Source #

The results from measuring memory usage.

Since: 0.2.0.0

getWeight :: NFData b => (a -> b) -> a -> GetWeight Source #

How to weigh a function.

Since: 0.2.0.0

getWeightIO :: NFData b => (a -> IO b) -> a -> GetWeight Source #

An IO-based variant of getWeight.

Since: 0.2.0.0

Specify comparisons

type Comparison a b = ComparisonM a b () Source #

A specialised monad used solely for running comparisons.

No lifting is permitted; the only operations permitted are comp, compBench and compTest.

comp :: String -> a -> Comparison a b Source #

Benchmark and test (if specified) this value against the specified function.

compBench :: String -> a -> Comparison a b Source #

Only benchmark and possibly weigh (but do not test) this value against the specified function.

compTest :: String -> a -> Comparison a b Source #

Only test (but do not benchmark or weigh) this value against the specified function.

Lower-level types

data ComparisonM a b r Source #

Instances
Monad (ComparisonM a b) Source # 
Instance details

Defined in TestBench

Methods

(>>=) :: ComparisonM a b a0 -> (a0 -> ComparisonM a b b0) -> ComparisonM a b b0 #

(>>) :: ComparisonM a b a0 -> ComparisonM a b b0 -> ComparisonM a b b0 #

return :: a0 -> ComparisonM a b a0 #

fail :: String -> ComparisonM a b a0 #

Functor (ComparisonM a b) Source # 
Instance details

Defined in TestBench

Methods

fmap :: (a0 -> b0) -> ComparisonM a b a0 -> ComparisonM a b b0 #

(<$) :: a0 -> ComparisonM a b b0 -> ComparisonM a b a0 #

Applicative (ComparisonM a b) Source # 
Instance details

Defined in TestBench

Methods

pure :: a0 -> ComparisonM a b a0 #

(<*>) :: ComparisonM a b (a0 -> b0) -> ComparisonM a b a0 -> ComparisonM a b b0 #

liftA2 :: (a0 -> b0 -> c) -> ComparisonM a b a0 -> ComparisonM a b b0 -> ComparisonM a b c #

(*>) :: ComparisonM a b a0 -> ComparisonM a b b0 -> ComparisonM a b b0 #

(<*) :: ComparisonM a b a0 -> ComparisonM a b b0 -> ComparisonM a b a0 #

MonadIO (ComparisonM a b) Source # 
Instance details

Defined in TestBench

Methods

liftIO :: IO a0 -> ComparisonM a b a0 #

Manual construction of a TestBench

getTestBenches :: TestBench -> IO (Test, EvalForest) Source #

Obtain the resulting tests and benchmarks from the specified TestBench.

data Eval Source #

Constructors

Eval 

type EvalTree = LabelTree Eval Source #

A more explicit tree-like structure for benchmarks than using Criterion's Benchmark type.

flattenBenchForest :: EvalForest -> [Benchmark] Source #

Remove the explicit tree-like structure into the implicit one used by Criterion.

Useful for embedding the results into an existing benchmark suite.

evalForest :: Config -> EvalForest -> IO () Source #

Run the specified benchmarks, printing the results (once they're all complete) to stdout in a tabular format for easier comparisons.

Direct benchmarks/tests

nfEq :: (NFData b, Show b, Eq b) => b -> (a -> b) -> String -> a -> TestBench Source #

Create a single benchmark evaluated to normal form, where the results should equal the value specified.

Will also weigh the function.

whnfEq :: (Show b, Eq b) => b -> (a -> b) -> String -> a -> TestBench Source #

Create a single benchmark evaluated to weak head normal form, where the results should equal the value specified.

mkTestBench Source #

Arguments

:: ((a -> b) -> a -> Maybe Benchmarkable)

Define the benchmark to be performed, if any.

-> ((a -> b) -> a -> Maybe GetWeight)

If a benchmark is performed, should its memory usage also be calculated? See the documentation for weigh on how to get this work.

-> (b -> Maybe Assertion)

Should the result be checked?

-> (a -> b) 
-> String 
-> a 
-> TestBench 

A way of writing custom testing/benchmarking statements. You will probably want to use one of the pre-defined versions instead.

Lower-level types

data TestBenchM r Source #

Instances
Monad TestBenchM Source # 
Instance details

Defined in TestBench

Methods

(>>=) :: TestBenchM a -> (a -> TestBenchM b) -> TestBenchM b #

(>>) :: TestBenchM a -> TestBenchM b -> TestBenchM b #

return :: a -> TestBenchM a #

fail :: String -> TestBenchM a #

Functor TestBenchM Source # 
Instance details

Defined in TestBench

Methods

fmap :: (a -> b) -> TestBenchM a -> TestBenchM b #

(<$) :: a -> TestBenchM b -> TestBenchM a #

Applicative TestBenchM Source # 
Instance details

Defined in TestBench

Methods

pure :: a -> TestBenchM a #

(<*>) :: TestBenchM (a -> b) -> TestBenchM a -> TestBenchM b #

liftA2 :: (a -> b -> c) -> TestBenchM a -> TestBenchM b -> TestBenchM c #

(*>) :: TestBenchM a -> TestBenchM b -> TestBenchM b #

(<*) :: TestBenchM a -> TestBenchM b -> TestBenchM a #

MonadIO TestBenchM Source # 
Instance details

Defined in TestBench

Methods

liftIO :: IO a -> TestBenchM a #

type OpTree = LabelTree Operation Source #

A tree of operations.

data Operation Source #

An individual operation potentially consisting of a benchmark and/or test.

data LabelTree a Source #

A simple labelled rose-tree data structure also containing the depth.

Constructors

Leaf !Depth a 
Branch !Depth String [LabelTree a] 
Instances
Functor LabelTree Source # 
Instance details

Defined in TestBench.LabelTree

Methods

fmap :: (a -> b) -> LabelTree a -> LabelTree b #

(<$) :: a -> LabelTree b -> LabelTree a #

Eq a => Eq (LabelTree a) Source # 
Instance details

Defined in TestBench.LabelTree

Methods

(==) :: LabelTree a -> LabelTree a -> Bool #

(/=) :: LabelTree a -> LabelTree a -> Bool #

Ord a => Ord (LabelTree a) Source # 
Instance details

Defined in TestBench.LabelTree

Read a => Read (LabelTree a) Source # 
Instance details

Defined in TestBench.LabelTree

Show a => Show (LabelTree a) Source # 
Instance details

Defined in TestBench.LabelTree

type Depth = Int Source #