{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, RecordWildCards #-}

-- |
-- Module      : Criterion.Main.Options
-- Copyright   : (c) 2014 Bryan O'Sullivan
--
-- License     : BSD-style
-- Maintainer  : bos@serpentine.com
-- Stability   : experimental
-- Portability : GHC
--
-- Benchmarking command-line configuration.

module Criterion.Main.Options
    (
      Mode(..)
    , MatchType(..)
    , defaultConfig
    , parseWith
    , config
    , describe
    , describeWith
    , versionInfo
    ) where

import Control.Monad (when)
import Criterion.Analysis (validateAccessors)
import Criterion.Types (Config(..), Verbosity(..), measureAccessors,
                        measureKeys)
import Data.Char (isSpace, toLower)
import Data.Data (Data, Typeable)
import Data.Int (Int64)
import Data.List (isPrefixOf)
import Data.Version (showVersion)
import GHC.Generics (Generic)
import Options.Applicative
import Options.Applicative.Help (Chunk(..), tabulate)
import Options.Applicative.Help.Pretty ((.$.))
import Options.Applicative.Types
import Paths_criterion (version)
import Prelude ()
import Prelude.Compat
import Prettyprinter (Doc, pretty)
import Prettyprinter.Render.Terminal (AnsiStyle)
import Statistics.Types (mkCL,cl95)
import qualified Data.Map as M

-- | How to match a benchmark name.
data MatchType = Prefix
                 -- ^ Match by prefix. For example, a prefix of
                 -- @\"foo\"@ will match @\"foobar\"@.
               | Glob
                 -- ^ Match by Unix-style glob pattern. When using this match
                 -- type, benchmark names are treated as if they were
                 -- file-paths. For example, the glob patterns @\"*/ba*\"@ and
                 -- @\"*/*\"@ will match @\"foo/bar\"@, but @\"*\"@ or @\"*bar\"@
                 -- __will not__.
               | Pattern
                 -- ^ Match by searching given substring in benchmark
                 -- paths.
               | IPattern
                 -- ^ Same as 'Pattern', but case insensitive.
               deriving (MatchType -> MatchType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchType -> MatchType -> Bool
$c/= :: MatchType -> MatchType -> Bool
== :: MatchType -> MatchType -> Bool
$c== :: MatchType -> MatchType -> Bool
Eq, Eq MatchType
MatchType -> MatchType -> Bool
MatchType -> MatchType -> Ordering
MatchType -> MatchType -> MatchType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MatchType -> MatchType -> MatchType
$cmin :: MatchType -> MatchType -> MatchType
max :: MatchType -> MatchType -> MatchType
$cmax :: MatchType -> MatchType -> MatchType
>= :: MatchType -> MatchType -> Bool
$c>= :: MatchType -> MatchType -> Bool
> :: MatchType -> MatchType -> Bool
$c> :: MatchType -> MatchType -> Bool
<= :: MatchType -> MatchType -> Bool
$c<= :: MatchType -> MatchType -> Bool
< :: MatchType -> MatchType -> Bool
$c< :: MatchType -> MatchType -> Bool
compare :: MatchType -> MatchType -> Ordering
$ccompare :: MatchType -> MatchType -> Ordering
Ord, MatchType
forall a. a -> a -> Bounded a
maxBound :: MatchType
$cmaxBound :: MatchType
minBound :: MatchType
$cminBound :: MatchType
Bounded, Int -> MatchType
MatchType -> Int
MatchType -> [MatchType]
MatchType -> MatchType
MatchType -> MatchType -> [MatchType]
MatchType -> MatchType -> MatchType -> [MatchType]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: MatchType -> MatchType -> MatchType -> [MatchType]
$cenumFromThenTo :: MatchType -> MatchType -> MatchType -> [MatchType]
enumFromTo :: MatchType -> MatchType -> [MatchType]
$cenumFromTo :: MatchType -> MatchType -> [MatchType]
enumFromThen :: MatchType -> MatchType -> [MatchType]
$cenumFromThen :: MatchType -> MatchType -> [MatchType]
enumFrom :: MatchType -> [MatchType]
$cenumFrom :: MatchType -> [MatchType]
fromEnum :: MatchType -> Int
$cfromEnum :: MatchType -> Int
toEnum :: Int -> MatchType
$ctoEnum :: Int -> MatchType
pred :: MatchType -> MatchType
$cpred :: MatchType -> MatchType
succ :: MatchType -> MatchType
$csucc :: MatchType -> MatchType
Enum, ReadPrec [MatchType]
ReadPrec MatchType
Int -> ReadS MatchType
ReadS [MatchType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MatchType]
$creadListPrec :: ReadPrec [MatchType]
readPrec :: ReadPrec MatchType
$creadPrec :: ReadPrec MatchType
readList :: ReadS [MatchType]
$creadList :: ReadS [MatchType]
readsPrec :: Int -> ReadS MatchType
$creadsPrec :: Int -> ReadS MatchType
Read, Int -> MatchType -> ShowS
[MatchType] -> ShowS
MatchType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchType] -> ShowS
$cshowList :: [MatchType] -> ShowS
show :: MatchType -> String
$cshow :: MatchType -> String
showsPrec :: Int -> MatchType -> ShowS
$cshowsPrec :: Int -> MatchType -> ShowS
Show, Typeable, Typeable MatchType
MatchType -> DataType
MatchType -> Constr
(forall b. Data b => b -> b) -> MatchType -> MatchType
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MatchType -> u
forall u. (forall d. Data d => d -> u) -> MatchType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MatchType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MatchType -> c MatchType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MatchType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MatchType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MatchType -> m MatchType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MatchType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MatchType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MatchType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MatchType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> MatchType -> r
gmapT :: (forall b. Data b => b -> b) -> MatchType -> MatchType
$cgmapT :: (forall b. Data b => b -> b) -> MatchType -> MatchType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MatchType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MatchType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MatchType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MatchType)
dataTypeOf :: MatchType -> DataType
$cdataTypeOf :: MatchType -> DataType
toConstr :: MatchType -> Constr
$ctoConstr :: MatchType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MatchType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MatchType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MatchType -> c MatchType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MatchType -> c MatchType
Data,
                         forall x. Rep MatchType x -> MatchType
forall x. MatchType -> Rep MatchType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatchType x -> MatchType
$cfrom :: forall x. MatchType -> Rep MatchType x
Generic)

-- | Execution mode for a benchmark program.
data Mode = List
            -- ^ List all benchmarks.
          | Version
            -- ^ Print the version.
          | RunIters Config Int64 MatchType [String]
            -- ^ Run the given benchmarks, without collecting or
            -- analysing performance numbers.
          | Run Config MatchType [String]
            -- ^ Run and analyse the given benchmarks.
          deriving (Mode -> Mode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Mode -> Mode -> Bool
$c/= :: Mode -> Mode -> Bool
== :: Mode -> Mode -> Bool
$c== :: Mode -> Mode -> Bool
Eq, ReadPrec [Mode]
ReadPrec Mode
Int -> ReadS Mode
ReadS [Mode]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Mode]
$creadListPrec :: ReadPrec [Mode]
readPrec :: ReadPrec Mode
$creadPrec :: ReadPrec Mode
readList :: ReadS [Mode]
$creadList :: ReadS [Mode]
readsPrec :: Int -> ReadS Mode
$creadsPrec :: Int -> ReadS Mode
Read, Int -> Mode -> ShowS
[Mode] -> ShowS
Mode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Mode] -> ShowS
$cshowList :: [Mode] -> ShowS
show :: Mode -> String
$cshow :: Mode -> String
showsPrec :: Int -> Mode -> ShowS
$cshowsPrec :: Int -> Mode -> ShowS
Show, Typeable, Typeable Mode
Mode -> DataType
Mode -> Constr
(forall b. Data b => b -> b) -> Mode -> Mode
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
forall u. (forall d. Data d => d -> u) -> Mode -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Mode -> m Mode
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Mode -> r
gmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
$cgmapT :: (forall b. Data b => b -> b) -> Mode -> Mode
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Mode)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Mode)
dataTypeOf :: Mode -> DataType
$cdataTypeOf :: Mode -> DataType
toConstr :: Mode -> Constr
$ctoConstr :: Mode -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Mode
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
Data, forall x. Rep Mode x -> Mode
forall x. Mode -> Rep Mode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Mode x -> Mode
$cfrom :: forall x. Mode -> Rep Mode x
Generic)

-- | Default benchmarking configuration.
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config {
      confInterval :: CL Double
confInterval = forall a. Fractional a => CL a
cl95
    , timeLimit :: Double
timeLimit    = Double
5
    , resamples :: Int
resamples    = Int
1000
    , regressions :: [([String], String)]
regressions  = []
    , rawDataFile :: Maybe String
rawDataFile  = forall a. Maybe a
Nothing
    , reportFile :: Maybe String
reportFile   = forall a. Maybe a
Nothing
    , csvFile :: Maybe String
csvFile      = forall a. Maybe a
Nothing
    , jsonFile :: Maybe String
jsonFile     = forall a. Maybe a
Nothing
    , junitFile :: Maybe String
junitFile    = forall a. Maybe a
Nothing
    , verbosity :: Verbosity
verbosity    = Verbosity
Normal
    , template :: String
template     = String
"default"
    }

-- | Parse a command line.
parseWith :: Config
             -- ^ Default configuration to use if options are not
             -- explicitly specified.
          -> Parser Mode
parseWith :: Config -> Parser Mode
parseWith Config
cfg =
  Parser Mode
runOrRunIters forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Mode
List forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"list" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"List benchmarks")) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  (Mode
Version forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mod FlagFields Bool -> Parser Bool
switch (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Show version info"))
  where
    runOrRunIters :: Parser Mode
    runOrRunIters :: Parser Mode
runOrRunIters =
          -- Because Run and RunIters are separate Modes, it's tempting to
          -- split them out into their own Parsers and choose between them
          -- using (<|>), i.e.,
          --
          --       (Run      <$> config cfg                   <*> ...)
          --   <|> (RunIters <$> config cfg <*> (... "iters") <*> ...)
          --
          -- This is possible, but it has the unfortunate consequence of
          -- invoking the same Parsers (e.g., @config@) multiple times. As a
          -- result, the help text for each Parser would be duplicated when the
          -- user runs --help. See #168.
          --
          -- To avoid this problem, we combine Run and RunIters into a single
          -- Parser that only runs each of its sub-Parsers once. The trick is
          -- to make the Parser for "iters" (the key difference between Run and
          -- RunIters) an optional Parser. If the Parser yields Nothing, select
          -- Run, and if the Parser yields Just, select RunIters.
          --
          -- This is admittedly a bit of a design smell, as the idiomatic way
          -- to handle this would be to turn Run and RunIters into subcommands
          -- rather than options. That way, each subcommand would have its own
          -- --help prompt, thereby avoiding the need to deduplicate the help
          -- text. Unfortunately, this would require breaking the CLI interface
          -- of every criterion-based program, which seems like a leap too far.
          -- The solution used here, while a bit grimy, gets the job done while
          -- keeping Run and RunIters as options.
          (\Config
cfg' Maybe Int64
mbIters ->
            case Maybe Int64
mbIters of
              Just Int64
iters -> Config -> Int64 -> MatchType -> [String] -> Mode
RunIters Config
cfg' Int64
iters
              Maybe Int64
Nothing    -> Config -> MatchType -> [String] -> Mode
Run Config
cfg')
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Config -> Parser Config
config Config
cfg
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall a. ReadM a -> Mod OptionFields a -> Parser a
option forall a. Read a => ReadM a
auto
          (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"iters" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ITERS" forall a. Semigroup a => a -> a -> a
<>
           forall (f :: * -> *) a. String -> Mod f a
help String
"Run benchmarks, don't analyse"))
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM MatchType
match
          (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"match" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MATCH" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value MatchType
Prefix forall a. Semigroup a => a -> a -> a
<>
           forall (f :: * -> *) a. String -> Mod f a
help String
"How to match benchmark names (\"prefix\", \"glob\", \"pattern\", or \"ipattern\")")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument forall s. IsString s => ReadM s
str (forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"NAME..."))

-- | Parse a configuration.
config :: Config -> Parser Config
config :: Config -> Parser Config
config Config{Double
Int
String
[([String], String)]
Maybe String
CL Double
Verbosity
template :: String
verbosity :: Verbosity
junitFile :: Maybe String
jsonFile :: Maybe String
csvFile :: Maybe String
reportFile :: Maybe String
rawDataFile :: Maybe String
regressions :: [([String], String)]
resamples :: Int
timeLimit :: Double
confInterval :: CL Double
template :: Config -> String
verbosity :: Config -> Verbosity
junitFile :: Config -> Maybe String
jsonFile :: Config -> Maybe String
csvFile :: Config -> Maybe String
reportFile :: Config -> Maybe String
rawDataFile :: Config -> Maybe String
regressions :: Config -> [([String], String)]
resamples :: Config -> Int
timeLimit :: Config -> Double
confInterval :: Config -> CL Double
..} = CL Double
-> Double
-> Int
-> [([String], String)]
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Verbosity
-> String
-> Config
Config
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (Ord a, Num a) => a -> CL a
mkCL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Double
0.001 Double
0.999)
      (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ci" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'I' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CI" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value CL Double
confInterval forall a. Semigroup a => a -> a -> a
<>
       forall (f :: * -> *) a. String -> Mod f a
help String
"Confidence interval")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Double
0.1 Double
86400)
      (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"time-limit" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'L' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECS" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
timeLimit forall a. Semigroup a => a -> a -> a
<>
       forall (f :: * -> *) a. String -> Mod f a
help String
"Time limit to run a benchmark")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Int
1 Int
1000000)
      (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"resamples" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COUNT" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
resamples forall a. Semigroup a => a -> a -> a
<>
       forall (f :: * -> *) a. String -> Mod f a
help String
"Number of bootstrap resamples to perform")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. [a] -> Parser a -> Parser [a]
manyDefault [([String], String)]
regressions
           (forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ([String], String)
regressParams
            (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"regress" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"RESP:PRED.." forall a. Semigroup a => a -> a -> a
<>
             forall (f :: * -> *) a. String -> Mod f a
help String
"Regressions to perform"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
rawDataFile (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"raw" forall a. Semigroup a => a -> a -> a
<>
                                forall (f :: * -> *) a. String -> Mod f a
help String
"File to write raw data to")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
reportFile (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' forall a. Semigroup a => a -> a -> a
<>
                               forall (f :: * -> *) a. String -> Mod f a
help String
"File to write report to")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
csvFile (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"csv" forall a. Semigroup a => a -> a -> a
<>
                            forall (f :: * -> *) a. String -> Mod f a
help String
"File to write CSV summary to")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
jsonFile (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"json" forall a. Semigroup a => a -> a -> a
<>
                             forall (f :: * -> *) a. String -> Mod f a
help String
"File to write JSON summary to")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
junitFile (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"junit" forall a. Semigroup a => a -> a -> a
<>
                              forall (f :: * -> *) a. String -> Mod f a
help String
"File to write JUnit summary to")
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall a. Enum a => Int -> a
toEnum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ReadM a -> Mod OptionFields a -> Parser a
option (forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Int
0 Int
2)
                  (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbosity" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"LEVEL" forall a. Semigroup a => a -> a -> a
<>
                   forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (forall a. Enum a => a -> Int
fromEnum Verbosity
verbosity) forall a. Semigroup a => a -> a -> a
<>
                   forall (f :: * -> *) a. String -> Mod f a
help String
"Verbosity level"))
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"template" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" forall a. Semigroup a => a -> a -> a
<>
                 forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
template forall a. Semigroup a => a -> a -> a
<>
                 forall (f :: * -> *) a. String -> Mod f a
help String
"Template to use for report")

manyDefault :: [a] -> Parser a -> Parser [a]
manyDefault :: forall a. [a] -> Parser a -> Parser [a]
manyDefault [a]
def Parser a
m = [a] -> [a]
set_default forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser a
m
  where
    set_default :: [a] -> [a]
set_default [] = [a]
def
    set_default [a]
xs = [a]
xs

outputOption :: Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption :: Maybe String -> Mod OptionFields String -> Parser (Maybe String)
outputOption Maybe String
file Mod OptionFields String
m =
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String
m forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Maybe String
file))

range :: (Show a, Read a, Ord a) => a -> a -> ReadM a
range :: forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range a
lo a
hi = do
  String
s <- ReadM String
readerAsk
  case forall a. Read a => ReadS a
reads String
s of
    [(a
i, String
"")]
      | a
i forall a. Ord a => a -> a -> Bool
>= a
lo Bool -> Bool -> Bool
&& a
i forall a. Ord a => a -> a -> Bool
<= a
hi -> forall (m :: * -> *) a. Monad m => a -> m a
return a
i
      | Bool
otherwise -> forall a. String -> ReadM a
readerError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show a
i forall a. [a] -> [a] -> [a]
++ String
" is outside range " forall a. [a] -> [a] -> [a]
++
                                   forall a. Show a => a -> String
show (a
lo,a
hi)
    [(a, String)]
_             -> forall a. String -> ReadM a
readerError forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show String
s forall a. [a] -> [a] -> [a]
++ String
" is not a number"

match :: ReadM MatchType
match :: ReadM MatchType
match = do
  String
m <- ReadM String
readerAsk
  case forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
m of
    String
mm | String
mm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"pfx"      -> forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Prefix
       | String
mm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"prefix"   -> forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Prefix
       | String
mm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"glob"     -> forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Glob
       | String
mm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"pattern"  -> forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Pattern
       | String
mm forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"ipattern" -> forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
IPattern
       | Bool
otherwise                  -> forall a. String -> ReadM a
readerError forall a b. (a -> b) -> a -> b
$
                                       forall a. Show a => a -> String
show String
m forall a. [a] -> [a] -> [a]
++ String
" is not a known match type"
                                              forall a. [a] -> [a] -> [a]
++ String
"Try \"prefix\", \"pattern\", \"ipattern\" or \"glob\"."

regressParams :: ReadM ([String], String)
regressParams :: ReadM ([String], String)
regressParams = do
  String
m <- ReadM String
readerAsk
  let repl :: Char -> Char
repl Char
','   = Char
' '
      repl Char
c     = Char
c
      tidy :: ShowS
tidy       = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
      (String
r,String
ps)     = forall a. (a -> Bool) -> [a] -> ([a], [a])
break (forall a. Eq a => a -> a -> Bool
==Char
':') String
m
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r) forall a b. (a -> b) -> a -> b
$
    forall a. String -> ReadM a
readerError String
"no responder specified"
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ps) forall a b. (a -> b) -> a -> b
$
    forall a. String -> ReadM a
readerError String
"no predictors specified"
  let ret :: ([String], String)
ret = (String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
repl forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
1 forall a b. (a -> b) -> a -> b
$ String
ps, ShowS
tidy String
r)
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> ReadM a
readerError (forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ([String], String)
ret)) forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry [String]
-> String -> Either String [(String, Measured -> Maybe Double)]
validateAccessors ([String], String)
ret

-- | Flesh out a command-line parser.
describe :: Config -> ParserInfo Mode
describe :: Config -> ParserInfo Mode
describe Config
cfg = forall a. Parser a -> ParserInfo a
describeWith forall a b. (a -> b) -> a -> b
$ Config -> Parser Mode
parseWith Config
cfg

-- | Flesh out command-line information using a custom 'Parser'.
describeWith :: Parser a -> ParserInfo a
describeWith :: forall a. Parser a -> ParserInfo a
describeWith Parser a
parser = forall a. Parser a -> InfoMod a -> ParserInfo a
info (forall a. Parser (a -> a)
helper forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) forall a b. (a -> b) -> a -> b
$
    forall a. String -> InfoMod a
header (String
"Microbenchmark suite - " forall a. Semigroup a => a -> a -> a
<> String
versionInfo) forall a. Semigroup a => a -> a -> a
<>
    forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<>
    forall a. Maybe Doc -> InfoMod a
footerDoc (forall a. Chunk a -> Maybe a
unChunk Chunk Doc
regressionHelp)

-- | A string describing the version of this benchmark (really, the
-- version of criterion that was used to build it).
versionInfo :: String
versionInfo :: String
versionInfo = String
"built with criterion " forall a. Semigroup a => a -> a -> a
<> Version -> String
showVersion Version
version

-- We sort not by name, but by likely frequency of use.
regressionHelp :: Chunk (Doc AnsiStyle)
regressionHelp :: Chunk Doc
regressionHelp =
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a ann. Pretty a => a -> Doc ann
pretty String
"Regression metrics (for use with --regress):" Doc -> Doc -> Doc
.$.) forall a b. (a -> b) -> a -> b
$
      Int -> [(Doc, Doc)] -> Chunk Doc
tabulate
        (ParserPrefs -> Int
prefTabulateFill ParserPrefs
defaultPrefs)
        [(forall a ann. Pretty a => a -> Doc ann
pretty String
n, forall a ann. Pretty a => a -> Doc ann
pretty String
d) | (String
n,(Measured -> Maybe Double
_,String
d)) <- forall a b. (a -> b) -> [a] -> [b]
map String -> (String, (Measured -> Maybe Double, String))
f [String]
measureKeys]
  where f :: String -> (String, (Measured -> Maybe Double, String))
f String
k = (String
k, Map String (Measured -> Maybe Double, String)
measureAccessors forall k a. Ord k => Map k a -> k -> a
M.! String
k)