{-# 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 Statistics.Types (mkCL,cl95)
import Text.PrettyPrint.ANSI.Leijen (Doc, text)
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
(MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> Bool) -> Eq MatchType
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
Eq MatchType
-> (MatchType -> MatchType -> Ordering)
-> (MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> Bool)
-> (MatchType -> MatchType -> MatchType)
-> (MatchType -> MatchType -> MatchType)
-> Ord 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
$cp1Ord :: Eq MatchType
Ord, MatchType
MatchType -> MatchType -> Bounded 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]
(MatchType -> MatchType)
-> (MatchType -> MatchType)
-> (Int -> MatchType)
-> (MatchType -> Int)
-> (MatchType -> [MatchType])
-> (MatchType -> MatchType -> [MatchType])
-> (MatchType -> MatchType -> [MatchType])
-> (MatchType -> MatchType -> MatchType -> [MatchType])
-> Enum 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]
(Int -> ReadS MatchType)
-> ReadS [MatchType]
-> ReadPrec MatchType
-> ReadPrec [MatchType]
-> Read 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
(Int -> MatchType -> ShowS)
-> (MatchType -> String)
-> ([MatchType] -> ShowS)
-> Show MatchType
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
DataType
Constr
Typeable MatchType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> MatchType -> c MatchType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c MatchType)
-> (MatchType -> Constr)
-> (MatchType -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> MatchType -> MatchType)
-> (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 u. (forall d. Data d => d -> u) -> MatchType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> MatchType -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> MatchType -> m MatchType)
-> Data MatchType
MatchType -> DataType
MatchType -> Constr
(forall b. Data b => b -> b) -> MatchType -> MatchType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MatchType -> c MatchType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cIPattern :: Constr
$cPattern :: Constr
$cGlob :: Constr
$cPrefix :: Constr
$tMatchType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> MatchType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MatchType -> u
gmapQ :: (forall d. Data d => d -> u) -> MatchType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MatchType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable MatchType
Data,
                         (forall x. MatchType -> Rep MatchType x)
-> (forall x. Rep MatchType x -> MatchType) -> Generic MatchType
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
(Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
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]
(Int -> ReadS Mode)
-> ReadS [Mode] -> ReadPrec Mode -> ReadPrec [Mode] -> Read 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
(Int -> Mode -> ShowS)
-> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
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
DataType
Constr
Typeable Mode
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Mode -> c Mode)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Mode)
-> (Mode -> Constr)
-> (Mode -> DataType)
-> (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))
-> ((forall b. Data b => b -> b) -> Mode -> Mode)
-> (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 u. (forall d. Data d => d -> u) -> Mode -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u)
-> (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 (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Mode -> m Mode)
-> Data Mode
Mode -> DataType
Mode -> Constr
(forall b. Data b => b -> b) -> Mode -> Mode
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Mode -> c Mode
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cRun :: Constr
$cRunIters :: Constr
$cVersion :: Constr
$cList :: Constr
$tMode :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Mode -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Mode -> u
gmapQ :: (forall d. Data d => d -> u) -> Mode -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Mode -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Mode
Data, (forall x. Mode -> Rep Mode x)
-> (forall x. Rep Mode x -> Mode) -> Generic Mode
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 :: CL Double
-> Double
-> Int
-> [([String], String)]
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Maybe String
-> Verbosity
-> String
-> Config
Config {
      confInterval :: CL Double
confInterval = CL Double
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  = Maybe String
forall a. Maybe a
Nothing
    , reportFile :: Maybe String
reportFile   = Maybe String
forall a. Maybe a
Nothing
    , csvFile :: Maybe String
csvFile      = Maybe String
forall a. Maybe a
Nothing
    , jsonFile :: Maybe String
jsonFile     = Maybe String
forall a. Maybe a
Nothing
    , junitFile :: Maybe String
junitFile    = Maybe String
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 = Config -> Parser Config
config Config
cfg Parser Config -> Parser (Config -> Mode) -> Parser Mode
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (Config -> Mode)
runMode
                -- Important: only run `config` once here, as we only want the
                -- command-line options resulting from `config` to appear once
                -- in the `--help` output. See #168.
  where
    runMode :: Parser (Config -> Mode)
    runMode :: Parser (Config -> Mode)
runMode =
      Parser (MatchType -> [String] -> Config -> Mode)
-> Parser (Config -> Mode)
matchNames ((MatchType -> [String] -> Config -> Mode)
-> Parser (MatchType -> [String] -> Config -> Mode)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((MatchType -> [String] -> Config -> Mode)
 -> Parser (MatchType -> [String] -> Config -> Mode))
-> (MatchType -> [String] -> Config -> Mode)
-> Parser (MatchType -> [String] -> Config -> Mode)
forall a b. (a -> b) -> a -> b
$ \MatchType
mt [String]
bs Config
cfg' -> Config -> MatchType -> [String] -> Mode
Run Config
cfg' MatchType
mt [String]
bs) Parser (Config -> Mode)
-> Parser (Config -> Mode) -> Parser (Config -> Mode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      Parser (Config -> Mode)
runIters Parser (Config -> Mode)
-> Parser (Config -> Mode) -> Parser (Config -> Mode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (Mode -> Config -> Mode
forall a b. a -> b -> a
const Mode
List (Config -> Mode) -> Parser Bool -> Parser (Config -> Mode)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"list" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'l' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"List benchmarks")) Parser (Config -> Mode)
-> Parser (Config -> Mode) -> Parser (Config -> Mode)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
      (Mode -> Config -> Mode
forall a b. a -> b -> a
const Mode
Version (Config -> Mode) -> Parser Bool -> Parser (Config -> Mode)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Mod FlagFields Bool -> Parser Bool
switch (String -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Bool
forall (f :: * -> *) a. String -> Mod f a
help String
"Show version info"))

    runIters :: Parser (Config -> Mode)
    runIters :: Parser (Config -> Mode)
runIters = Parser (MatchType -> [String] -> Config -> Mode)
-> Parser (Config -> Mode)
matchNames (Parser (MatchType -> [String] -> Config -> Mode)
 -> Parser (Config -> Mode))
-> Parser (MatchType -> [String] -> Config -> Mode)
-> Parser (Config -> Mode)
forall a b. (a -> b) -> a -> b
$ (\Int64
iters MatchType
mt [String]
bs Config
cfg' -> Config -> Int64 -> MatchType -> [String] -> Mode
RunIters Config
cfg' Int64
iters MatchType
mt [String]
bs)
      (Int64 -> MatchType -> [String] -> Config -> Mode)
-> Parser Int64 -> Parser (MatchType -> [String] -> Config -> Mode)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int64 -> Mod OptionFields Int64 -> Parser Int64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Int64
forall a. Read a => ReadM a
auto
          (String -> Mod OptionFields Int64
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"iters" Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int64
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'n' Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int64
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"ITERS" Mod OptionFields Int64
-> Mod OptionFields Int64 -> Mod OptionFields Int64
forall a. Semigroup a => a -> a -> a
<>
           String -> Mod OptionFields Int64
forall (f :: * -> *) a. String -> Mod f a
help String
"Run benchmarks, don't analyse")

    matchNames :: Parser (MatchType -> [String] -> Config -> Mode)
               -> Parser (Config -> Mode)
    matchNames :: Parser (MatchType -> [String] -> Config -> Mode)
-> Parser (Config -> Mode)
matchNames Parser (MatchType -> [String] -> Config -> Mode)
wat = Parser (MatchType -> [String] -> Config -> Mode)
wat
      Parser (MatchType -> [String] -> Config -> Mode)
-> Parser MatchType -> Parser ([String] -> Config -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM MatchType -> Mod OptionFields MatchType -> Parser MatchType
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM MatchType
match
          (String -> Mod OptionFields MatchType
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"match" Mod OptionFields MatchType
-> Mod OptionFields MatchType -> Mod OptionFields MatchType
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields MatchType
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'm' Mod OptionFields MatchType
-> Mod OptionFields MatchType -> Mod OptionFields MatchType
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields MatchType
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"MATCH" Mod OptionFields MatchType
-> Mod OptionFields MatchType -> Mod OptionFields MatchType
forall a. Semigroup a => a -> a -> a
<> MatchType -> Mod OptionFields MatchType
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value MatchType
Prefix Mod OptionFields MatchType
-> Mod OptionFields MatchType -> Mod OptionFields MatchType
forall a. Semigroup a => a -> a -> a
<>
           String -> Mod OptionFields MatchType
forall (f :: * -> *) a. String -> Mod f a
help String
"How to match benchmark names (\"prefix\", \"glob\", \"pattern\", or \"ipattern\")")
      Parser ([String] -> Config -> Mode)
-> Parser [String] -> Parser (Config -> Mode)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser String -> Parser [String]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (ReadM String -> Mod ArgumentFields String -> Parser String
forall a. ReadM a -> Mod ArgumentFields a -> Parser a
argument ReadM String
forall s. IsString s => ReadM s
str (String -> Mod ArgumentFields String
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
  (CL Double
 -> Double
 -> Int
 -> [([String], String)]
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Maybe String
 -> Verbosity
 -> String
 -> Config)
-> Parser (CL Double)
-> Parser
     (Double
      -> Int
      -> [([String], String)]
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Verbosity
      -> String
      -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM (CL Double)
-> Mod OptionFields (CL Double) -> Parser (CL Double)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Double -> CL Double
forall a. (Ord a, Num a) => a -> CL a
mkCL (Double -> CL Double) -> ReadM Double -> ReadM (CL Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Double -> Double -> ReadM Double
forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Double
0.001 Double
0.999)
      (String -> Mod OptionFields (CL Double)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"ci" Mod OptionFields (CL Double)
-> Mod OptionFields (CL Double) -> Mod OptionFields (CL Double)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (CL Double)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'I' Mod OptionFields (CL Double)
-> Mod OptionFields (CL Double) -> Mod OptionFields (CL Double)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields (CL Double)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"CI" Mod OptionFields (CL Double)
-> Mod OptionFields (CL Double) -> Mod OptionFields (CL Double)
forall a. Semigroup a => a -> a -> a
<> CL Double -> Mod OptionFields (CL Double)
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value CL Double
confInterval Mod OptionFields (CL Double)
-> Mod OptionFields (CL Double) -> Mod OptionFields (CL Double)
forall a. Semigroup a => a -> a -> a
<>
       String -> Mod OptionFields (CL Double)
forall (f :: * -> *) a. String -> Mod f a
help String
"Confidence interval")
  Parser
  (Double
   -> Int
   -> [([String], String)]
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Verbosity
   -> String
   -> Config)
-> Parser Double
-> Parser
     (Int
      -> [([String], String)]
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Verbosity
      -> String
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Double -> Mod OptionFields Double -> Parser Double
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Double -> Double -> ReadM Double
forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Double
0.1 Double
86400)
      (String -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"time-limit" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Double
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'L' Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Double
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"SECS" Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<> Double -> Mod OptionFields Double
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Double
timeLimit Mod OptionFields Double
-> Mod OptionFields Double -> Mod OptionFields Double
forall a. Semigroup a => a -> a -> a
<>
       String -> Mod OptionFields Double
forall (f :: * -> *) a. String -> Mod f a
help String
"Time limit to run a benchmark")
  Parser
  (Int
   -> [([String], String)]
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Verbosity
   -> String
   -> Config)
-> Parser Int
-> Parser
     ([([String], String)]
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Verbosity
      -> String
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Int -> ReadM Int
forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Int
1 Int
1000000)
      (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"resamples" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"COUNT" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value Int
resamples Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
       String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Number of bootstrap resamples to perform")
  Parser
  ([([String], String)]
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Verbosity
   -> String
   -> Config)
-> Parser [([String], String)]
-> Parser
     (Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Verbosity
      -> String
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [([String], String)]
-> Parser ([String], String) -> Parser [([String], String)]
forall a. [a] -> Parser a -> Parser [a]
manyDefault [([String], String)]
regressions
           (ReadM ([String], String)
-> Mod OptionFields ([String], String) -> Parser ([String], String)
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM ([String], String)
regressParams
            (String -> Mod OptionFields ([String], String)
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"regress" Mod OptionFields ([String], String)
-> Mod OptionFields ([String], String)
-> Mod OptionFields ([String], String)
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields ([String], String)
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"RESP:PRED.." Mod OptionFields ([String], String)
-> Mod OptionFields ([String], String)
-> Mod OptionFields ([String], String)
forall a. Semigroup a => a -> a -> a
<>
             String -> Mod OptionFields ([String], String)
forall (f :: * -> *) a. String -> Mod f a
help String
"Regressions to perform"))
  Parser
  (Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Verbosity
   -> String
   -> Config)
-> Parser (Maybe String)
-> Parser
     (Maybe String
      -> Maybe String
      -> Maybe String
      -> Maybe String
      -> Verbosity
      -> String
      -> Config)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"raw" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                                String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to write raw data to")
  Parser
  (Maybe String
   -> Maybe String
   -> Maybe String
   -> Maybe String
   -> Verbosity
   -> String
   -> Config)
-> Parser (Maybe String)
-> Parser
     (Maybe String
      -> Maybe String -> Maybe String -> Verbosity -> String -> Config)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"output" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'o' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                               String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to write report to")
  Parser
  (Maybe String
   -> Maybe String -> Maybe String -> Verbosity -> String -> Config)
-> Parser (Maybe String)
-> Parser
     (Maybe String -> Maybe String -> Verbosity -> String -> Config)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"csv" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                            String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to write CSV summary to")
  Parser
  (Maybe String -> Maybe String -> Verbosity -> String -> Config)
-> Parser (Maybe String)
-> Parser (Maybe String -> Verbosity -> String -> Config)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"json" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                             String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to write JSON summary to")
  Parser (Maybe String -> Verbosity -> String -> Config)
-> Parser (Maybe String) -> Parser (Verbosity -> String -> Config)
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 (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"junit" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                              String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"File to write JUnit summary to")
  Parser (Verbosity -> String -> Config)
-> Parser Verbosity -> Parser (String -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int -> Verbosity
forall a. Enum a => Int -> a
toEnum (Int -> Verbosity) -> Parser Int -> Parser Verbosity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
option (Int -> Int -> ReadM Int
forall a. (Show a, Read a, Ord a) => a -> a -> ReadM a
range Int
0 Int
2)
                  (String -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"verbosity" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'v' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields Int
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"LEVEL" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
                   Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value (Verbosity -> Int
forall a. Enum a => a -> Int
fromEnum Verbosity
verbosity) Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
                   String -> Mod OptionFields Int
forall (f :: * -> *) a. String -> Mod f a
help String
"Verbosity level"))
  Parser (String -> Config) -> Parser String -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (String -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"template" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields String
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
't' Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                 String -> Mod OptionFields String
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
template Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<>
                 String -> Mod OptionFields String
forall (f :: * -> *) a. String -> Mod f a
help String
"Template to use for report")

manyDefault :: [a] -> Parser a -> Parser [a]
manyDefault :: [a] -> Parser a -> Parser [a]
manyDefault [a]
def Parser a
m = [a] -> [a]
set_default ([a] -> [a]) -> Parser [a] -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> Parser [a]
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 =
  Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Mod OptionFields String -> Parser String
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields String
m Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> String -> Mod OptionFields String
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"FILE" Mod OptionFields String
-> Mod OptionFields String -> Mod OptionFields String
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields String
-> (String -> Mod OptionFields String)
-> Maybe String
-> Mod OptionFields String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Mod OptionFields String
forall a. Monoid a => a
mempty String -> Mod OptionFields String
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 :: a -> a -> ReadM a
range a
lo a
hi = do
  String
s <- ReadM String
readerAsk
  case ReadS a
forall a. Read a => ReadS a
reads String
s of
    [(a
i, String
"")]
      | a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
lo Bool -> Bool -> Bool
&& a
i a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
hi -> a -> ReadM a
forall (m :: * -> *) a. Monad m => a -> m a
return a
i
      | Bool
otherwise -> String -> ReadM a
forall a. String -> ReadM a
readerError (String -> ReadM a) -> String -> ReadM a
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is outside range " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                   (a, a) -> String
forall a. Show a => a -> String
show (a
lo,a
hi)
    [(a, String)]
_             -> String -> ReadM a
forall a. String -> ReadM a
readerError (String -> ReadM a) -> String -> ReadM a
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. Show a => a -> String
show String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a number"

match :: ReadM MatchType
match :: ReadM MatchType
match = do
  String
m <- ReadM String
readerAsk
  case (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
m of
    String
mm | String
mm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"pfx"      -> MatchType -> ReadM MatchType
forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Prefix
       | String
mm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"prefix"   -> MatchType -> ReadM MatchType
forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Prefix
       | String
mm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"glob"     -> MatchType -> ReadM MatchType
forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Glob
       | String
mm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"pattern"  -> MatchType -> ReadM MatchType
forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
Pattern
       | String
mm String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
"ipattern" -> MatchType -> ReadM MatchType
forall (m :: * -> *) a. Monad m => a -> m a
return MatchType
IPattern
       | Bool
otherwise                  -> String -> ReadM MatchType
forall a. String -> ReadM a
readerError (String -> ReadM MatchType) -> String -> ReadM MatchType
forall a b. (a -> b) -> a -> b
$
                                       ShowS
forall a. Show a => a -> String
show String
m String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a known match type"
                                              String -> ShowS
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       = ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
      (String
r,String
ps)     = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
':') String
m
  Bool -> ReadM () -> ReadM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
r) (ReadM () -> ReadM ()) -> ReadM () -> ReadM ()
forall a b. (a -> b) -> a -> b
$
    String -> ReadM ()
forall a. String -> ReadM a
readerError String
"no responder specified"
  Bool -> ReadM () -> ReadM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ps) (ReadM () -> ReadM ()) -> ReadM () -> ReadM ()
forall a b. (a -> b) -> a -> b
$
    String -> ReadM ()
forall a. String -> ReadM a
readerError String
"no predictors specified"
  let ret :: ([String], String)
ret = (String -> [String]
words (String -> [String]) -> ShowS -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
repl ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ String
ps, ShowS
tidy String
r)
  (String -> ReadM ([String], String))
-> ([(String, Measured -> Maybe Double)]
    -> ReadM ([String], String))
-> Either String [(String, Measured -> Maybe Double)]
-> ReadM ([String], String)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReadM ([String], String)
forall a. String -> ReadM a
readerError (ReadM ([String], String)
-> [(String, Measured -> Maybe Double)] -> ReadM ([String], String)
forall a b. a -> b -> a
const (([String], String) -> ReadM ([String], String)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String], String)
ret)) (Either String [(String, Measured -> Maybe Double)]
 -> ReadM ([String], String))
-> Either String [(String, Measured -> Maybe Double)]
-> ReadM ([String], String)
forall a b. (a -> b) -> a -> b
$ ([String]
 -> String -> Either String [(String, Measured -> Maybe Double)])
-> ([String], String)
-> Either String [(String, Measured -> Maybe Double)]
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 = Parser Mode -> ParserInfo Mode
forall a. Parser a -> ParserInfo a
describeWith (Parser Mode -> ParserInfo Mode) -> Parser Mode -> ParserInfo Mode
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 :: Parser a -> ParserInfo a
describeWith Parser a
parser = Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser (a -> a)
forall a. Parser (a -> a)
helper Parser (a -> a) -> Parser a -> Parser a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a
parser) (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$
    String -> InfoMod a
forall a. String -> InfoMod a
header (String
"Microbenchmark suite - " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
versionInfo) InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<>
    InfoMod a
forall a. InfoMod a
fullDesc InfoMod a -> InfoMod a -> InfoMod a
forall a. Semigroup a => a -> a -> a
<>
    Maybe Doc -> InfoMod a
forall a. Maybe Doc -> InfoMod a
footerDoc (Chunk Doc -> Maybe Doc
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 " String -> ShowS
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
regressionHelp :: Chunk Doc
regressionHelp =
    (Doc -> Doc) -> Chunk Doc -> Chunk Doc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> Doc
text String
"Regression metrics (for use with --regress):" Doc -> Doc -> Doc
.$.) (Chunk Doc -> Chunk Doc) -> Chunk Doc -> Chunk Doc
forall a b. (a -> b) -> a -> b
$
      [(Doc, Doc)] -> Chunk Doc
tabulate [(String -> Doc
text String
n,String -> Doc
text String
d) | (String
n,(Measured -> Maybe Double
_,String
d)) <- (String -> (String, (Measured -> Maybe Double, String)))
-> [String] -> [(String, (Measured -> Maybe Double, String))]
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 Map String (Measured -> Maybe Double, String)
-> String -> (Measured -> Maybe Double, String)
forall k a. Ord k => Map k a -> k -> a
M.! String
k)