    {-# LANGUAGE Trustworthy #-}

    -- |
    -- Module      : Criterion.Main
    -- Copyright   : (c) 2009-2014 Bryan O'Sullivan
    --
    -- License     : BSD-style
    -- Maintainer  : bos@serpentine.com
    -- Stability   : experimental
    -- Portability : GHC
    --
    -- Wrappers for compiling and running benchmarks quickly and easily.
    -- See 'defaultMain' below for an example.
    --
    -- All of the 'IO'-returning functions in this module initialize the timer
    -- before measuring time (refer to the documentation for 'initializeTime'
    -- for more details).

    module Criterion.Main
        (
        -- * How to write benchmarks
        -- $bench

        -- ** Benchmarking IO actions
        -- $io

        -- ** Benchmarking pure code
        -- $pure

        -- ** Fully evaluating a result
        -- $rnf

        -- * Types
          Benchmarkable
        , Benchmark
        -- * Creating a benchmark suite
        , env
        , envWithCleanup
        , perBatchEnv
        , perBatchEnvWithCleanup
        , perRunEnv
        , perRunEnvWithCleanup
        , toBenchmarkable
        , bench
        , bgroup
        -- ** Running a benchmark
        , nf
        , whnf
        , nfIO
        , whnfIO
        , nfAppIO
        , whnfAppIO
        -- * Turning a suite of benchmarks into a program
        , defaultMain
        , defaultMainWith
        , defaultConfig
        -- * Other useful code
        , makeMatcher
        , runMode
        ) where

    import Control.Monad (unless)
    import Control.Monad.Trans (liftIO)
    import Criterion.IO.Printf (printError, writeCsv)
    import Criterion.Internal (runAndAnalyse, runFixedIters)
    import Criterion.Main.Options (MatchType(..), Mode(..), defaultConfig, describe,
                                   versionInfo)
    import Criterion.Measurement (initializeTime)
    import Criterion.Monad (withConfig)
    import Criterion.Types
    import Data.Char (toLower)
    import Data.List (isInfixOf, isPrefixOf, sort, stripPrefix)
    import Data.Maybe (fromMaybe)
    import Options.Applicative (execParser)
    import System.Environment (getProgName)
    import System.Exit (ExitCode(..), exitWith)
    import System.FilePath.Glob

    -- | An entry point that can be used as a @main@ function.
    --
    -- > import Criterion.Main
    -- >
    -- > fib :: Int -> Int
    -- > fib 0 = 0
    -- > fib 1 = 1
    -- > fib n = fib (n-1) + fib (n-2)
    -- >
    -- > main = defaultMain [
    -- >        bgroup "fib" [ bench "10" $ whnf fib 10
    -- >                     , bench "35" $ whnf fib 35
    -- >                     , bench "37" $ whnf fib 37
    -- >                     ]
    -- >                    ]
    defaultMain :: [Benchmark] -> IO ()
    defaultMain :: [Benchmark] -> IO ()
    defaultMain = Config -> [Benchmark] -> IO ()
    defaultMainWith Config
    defaultConfig

    -- | Create a function that can tell if a name given on the command
    -- line matches a benchmark.
    makeMatcher :: MatchType
                -> [String]
                -- ^ Command line arguments.
                -> Either String (String -> Bool)
    makeMatcher :: MatchType -> [String] -> Either String (String -> Bool)
    makeMatcher matchKind :: MatchType
    matchKind args :: [String]
    args =
      case MatchType
    matchKind of
        Prefix -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. b -> Either a b
    Right ((String -> Bool) -> Either String (String -> Bool))
    -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $ \b :: String
    b -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args Bool -> Bool -> Bool
    || (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    b) [String]
    args
        Glob ->
          let compOptions :: CompOptions
    compOptions = CompOptions
    compDefault { errorRecovery :: Bool
    errorRecovery = Bool
    False }
          in case (String -> Either String Pattern)
    -> [String] -> Either String [Pattern]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (CompOptions -> String -> Either String Pattern
    tryCompileWith CompOptions
    compOptions) [String]
    args of
               Left errMsg :: String
    errMsg -> String -> Either String (String -> Bool)
    forall a b. a -> Either a b
    Left (String -> Either String (String -> Bool))
    -> (String -> String) -> String -> Either String (String -> Bool)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe String -> String
    forall a. a -> Maybe a -> a
    fromMaybe String
    errMsg (Maybe String -> String)
    -> (String -> Maybe String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String -> Maybe String
    forall a. Eq a => [a] -> [a] -> Maybe [a]
    stripPrefix "compile :: " (String -> Either String (String -> Bool))
    -> String -> Either String (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $
                              String
    errMsg
               Right ps :: [Pattern]
    ps -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. b -> Either a b
    Right ((String -> Bool) -> Either String (String -> Bool))
    -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $ \b :: String
    b -> [Pattern] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Pattern]
    ps Bool -> Bool -> Bool
    || (Pattern -> Bool) -> [Pattern] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (Pattern -> String -> Bool
    `match` String
    b) [Pattern]
    ps
        Pattern -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. b -> Either a b
    Right ((String -> Bool) -> Either String (String -> Bool))
    -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $ \b :: String
    b -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args Bool -> Bool -> Bool
    || (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` String
    b) [String]
    args
        IPattern -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. b -> Either a b
    Right ((String -> Bool) -> Either String (String -> Bool))
    -> (String -> Bool) -> Either String (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $ \b :: String
    b -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    args Bool -> Bool -> Bool
    || (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isInfixOf` (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    b) ((String -> String) -> [String] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower) [String]
    args)

    selectBenches :: MatchType -> [String] -> Benchmark -> IO (String -> Bool)
    selectBenches :: MatchType -> [String] -> Benchmark -> IO (String -> Bool)
    selectBenches matchType :: MatchType
    matchType benches :: [String]
    benches bsgroup :: Benchmark
    bsgroup = do
      String -> Bool
    toRun <- (String -> IO (String -> Bool))
    -> ((String -> Bool) -> IO (String -> Bool))
    -> Either String (String -> Bool)
    -> IO (String -> Bool)
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either String -> IO (String -> Bool)
    forall a. String -> IO a
    parseError (String -> Bool) -> IO (String -> Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Either String (String -> Bool) -> IO (String -> Bool))
    -> ([String] -> Either String (String -> Bool))
    -> [String]
    -> IO (String -> Bool)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MatchType -> [String] -> Either String (String -> Bool)
    makeMatcher MatchType
    matchType ([String] -> IO (String -> Bool))
    -> [String] -> IO (String -> Bool)
    forall a b. (a -> b) -> a -> b
    $ [String]
    benches
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless ([String] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    benches Bool -> Bool -> Bool
    || (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any String -> Bool
    toRun (Benchmark -> [String]
    benchNames Benchmark
    bsgroup)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        String -> IO ()
    forall a. String -> IO a
    parseError "none of the specified names matches a benchmark"
      (String -> Bool) -> IO (String -> Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return String -> Bool
    toRun

    -- | An entry point that can be used as a @main@ function, with
    -- configurable defaults.
    --
    -- Example:
    --
    -- > import Criterion.Main.Options
    -- > import Criterion.Main
    -- >
    -- > myConfig = defaultConfig {
    -- >               -- Resample 10 times for bootstrapping
    -- >               resamples = 10
    -- >            }
    -- >
    -- > main = defaultMainWith myConfig [
    -- >          bench "fib 30" $ whnf fib 30
    -- >        ]
    --
    -- If you save the above example as @\"Fib.hs\"@, you should be able
    -- to compile it as follows:
    --
    -- > ghc -O --make Fib
    --
    -- Run @\"Fib --help\"@ on the command line to get a list of command
    -- line options.
    defaultMainWith :: Config
                    -> [Benchmark]
                    -> IO ()
    defaultMainWith :: Config -> [Benchmark] -> IO ()
    defaultMainWith defCfg :: Config
    defCfg bs :: [Benchmark]
    bs = do
      Mode
    wat <- ParserInfo Mode -> IO Mode
    forall a. ParserInfo a -> IO a
    execParser (Config -> ParserInfo Mode
    describe Config
    defCfg)
      Mode -> [Benchmark] -> IO ()
    runMode Mode
    wat [Benchmark]
    bs

    -- | Run a set of 'Benchmark's with the given 'Mode'.
    --
    -- This can be useful if you have a 'Mode' from some other source (e.g. from a
    -- one in your benchmark driver's command-line parser).
    runMode :: Mode -> [Benchmark] -> IO ()
    runMode :: Mode -> [Benchmark] -> IO ()
    runMode wat :: Mode
    wat bs :: [Benchmark]
    bs =
      case Mode
    wat of
        List -> (String -> IO ()) -> [String] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ String -> IO ()
    putStrLn ([String] -> IO ())
    -> ([Benchmark] -> [String]) -> [Benchmark] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. Ord a => [a] -> [a]
    sort ([String] -> [String])
    -> ([Benchmark] -> [String]) -> [Benchmark] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Benchmark -> [String]) -> [Benchmark] -> [String]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Benchmark -> [String]
    benchNames ([Benchmark] -> IO ()) -> [Benchmark] -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Benchmark]
    bs
        Version -> String -> IO ()
    putStrLn String
    versionInfo
        RunIters cfg :: Config
    cfg iters :: Int64
    iters matchType :: MatchType
    matchType benches :: [String]
    benches -> do
          String -> Bool
    shouldRun <- MatchType -> [String] -> Benchmark -> IO (String -> Bool)
    selectBenches MatchType
    matchType [String]
    benches Benchmark
    bsgroup
          Config -> Criterion () -> IO ()
    forall a. Config -> Criterion a -> IO a
    withConfig Config
    cfg (Criterion () -> IO ()) -> Criterion () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            Int64 -> (String -> Bool) -> Benchmark -> Criterion ()
    runFixedIters Int64
    iters String -> Bool
    shouldRun Benchmark
    bsgroup
        Run cfg :: Config
    cfg matchType :: MatchType
    matchType benches :: [String]
    benches -> do
          String -> Bool
    shouldRun <- MatchType -> [String] -> Benchmark -> IO (String -> Bool)
    selectBenches MatchType
    matchType [String]
    benches Benchmark
    bsgroup
          Config -> Criterion () -> IO ()
    forall a. Config -> Criterion a -> IO a
    withConfig Config
    cfg (Criterion () -> IO ()) -> Criterion () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
            (String, String, String, String, String, String, String)
    -> Criterion ()
    forall a. ToRecord a => a -> Criterion ()
    writeCsv ("Name","Mean","MeanLB","MeanUB","Stddev","StddevLB",
                      "StddevUB")
            IO () -> Criterion ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ()
    initializeTime
            (String -> Bool) -> Benchmark -> Criterion ()
    runAndAnalyse String -> Bool
    shouldRun Benchmark
    bsgroup
      where bsgroup :: Benchmark
    bsgroup = String -> [Benchmark] -> Benchmark
    BenchGroup "" [Benchmark]
    bs

    -- | Display an error message from a command line parsing failure, and
    -- exit.
    parseError :: String -> IO a
    parseError :: String -> IO a
    parseError msg :: String
    msg = do
      Any
    _ <- String -> String -> IO Any
    forall r. CritHPrintfType r => String -> r
    printError "Error: %s\n" String
    msg
      Any
    _ <- String -> String -> IO Any
    forall r. CritHPrintfType r => String -> r
    printError "Run \"%s --help\" for usage information\n" (String -> IO Any) -> IO String -> IO Any
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< IO String
    getProgName
      ExitCode -> IO a
    forall a. ExitCode -> IO a
    exitWith (Int -> ExitCode
    ExitFailure 64)

    -- $bench
    --
    -- The 'Benchmarkable' type is a container for code that can be
    -- benchmarked.  The value inside must run a benchmark the given
    -- number of times.  We are most interested in benchmarking two
    -- things:
    --
    -- * 'IO' actions.  Most 'IO' actions can be benchmarked directly.
    --
    -- * Pure functions.  GHC optimises aggressively when compiling with
    --   @-O@, so it is easy to write innocent-looking benchmark code that
    --   doesn't measure the performance of a pure function at all.  We
    --   work around this by benchmarking both a function and its final
    --   argument together.

    -- $io
    --
    -- Most 'IO' actions can be benchmarked easily using one of the following
    -- two functions:
    --
    -- @
    -- 'nfIO'   :: 'NFData' a => 'IO' a -> 'Benchmarkable'
    -- 'whnfIO' ::               'IO' a -> 'Benchmarkable'
    -- @
    --
    -- In certain corner cases, you may find it useful to use the following
    -- variants, which take the input as a separate argument:
    --
    -- @
    -- 'nfAppIO'   :: 'NFData' b => (a -> 'IO' b) -> a -> 'Benchmarkable'
    -- 'whnfAppIO' ::               (a -> 'IO' b) -> a -> 'Benchmarkable'
    -- @
    --
    -- This is useful when the bulk of the work performed by the function is
    -- not bound by IO, but rather by pure computations that may optimize away if
    -- the argument is known statically, as in 'nfIO'/'whnfIO'.

    -- $pure
    --
    -- Because GHC optimises aggressively when compiling with @-O@, it is
    -- potentially easy to write innocent-looking benchmark code that will
    -- only be evaluated once, for which all but the first iteration of
    -- the timing loop will be timing the cost of doing nothing.
    --
    -- To work around this, we provide two functions for benchmarking pure
    -- code.
    --
    -- The first will cause results to be fully evaluated to normal form
    -- (NF):
    --
    -- @
    -- 'nf' :: 'NFData' b => (a -> b) -> a -> 'Benchmarkable'
    -- @
    --
    -- The second will cause results to be evaluated to weak head normal
    -- form (the Haskell default):
    --
    -- @
    -- 'whnf' :: (a -> b) -> a -> 'Benchmarkable'
    -- @
    --
    -- As both of these types suggest, when you want to benchmark a
    -- function, you must supply two values:
    --
    -- * The first element is the function, saturated with all but its
    --   last argument.
    --
    -- * The second element is the last argument to the function.
    --
    -- Here is an example that makes the use of these functions clearer.
    -- Suppose we want to benchmark the following function:
    --
    -- @
    -- firstN :: Int -> [Int]
    -- firstN k = take k [(0::Int)..]
    -- @
    --
    -- So in the easy case, we construct a benchmark as follows:
    --
    -- @
    -- 'nf' firstN 1000
    -- @

    -- $rnf
    --
    -- The 'whnf' harness for evaluating a pure function only evaluates
    -- the result to weak head normal form (WHNF).  If you need the result
    -- evaluated all the way to normal form, use the 'nf' function to
    -- force its complete evaluation.
    --
    -- Using the @firstN@ example from earlier, to naive eyes it might
    -- /appear/ that the following code ought to benchmark the production
    -- of the first 1000 list elements:
    --
    -- @
    -- 'whnf' firstN 1000
    -- @
    --
    -- Since we are using 'whnf', in this case the result will only be
    -- forced until it reaches WHNF, so what this would /actually/
    -- benchmark is merely how long it takes to produce the first list
    -- element!