{-# LANGUAGE Trustworthy #-}
module Criterion.Main
(
Benchmarkable
, Benchmark
, env
, envWithCleanup
, perBatchEnv
, perBatchEnvWithCleanup
, perRunEnv
, perRunEnvWithCleanup
, toBenchmarkable
, bench
, bgroup
, nf
, whnf
, nfIO
, whnfIO
, nfAppIO
, whnfAppIO
, defaultMain
, defaultMainWith
, defaultConfig
, 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
defaultMain :: [Benchmark] -> IO ()
defaultMain :: [Benchmark] -> IO ()
defaultMain = Config -> [Benchmark] -> IO ()
defaultMainWith Config
defaultConfig
makeMatcher :: MatchType
-> [String]
-> Either String (String -> Bool)
makeMatcher :: MatchType -> [String] -> Either String (String -> Bool)
makeMatcher MatchType
matchKind [String]
args =
case MatchType
matchKind of
MatchType
Prefix -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \String
b -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
b) [String]
args
MatchType
Glob ->
let compOptions :: CompOptions
compOptions = CompOptions
compDefault { errorRecovery :: Bool
errorRecovery = Bool
False }
in case 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 String
errMsg -> forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a -> a
fromMaybe String
errMsg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"compile :: " forall a b. (a -> b) -> a -> b
$
String
errMsg
Right [Pattern]
ps -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \String
b -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Pattern]
ps Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Pattern -> String -> Bool
`match` String
b) [Pattern]
ps
MatchType
Pattern -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \String
b -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
b) [String]
args
MatchType
IPattern -> forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ \String
b -> forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
b) (forall a b. (a -> b) -> [a] -> [b]
map (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 [String]
benches Benchmark
bsgroup = do
String -> Bool
toRun <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. String -> IO a
parseError forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. MatchType -> [String] -> Either String (String -> Bool)
makeMatcher MatchType
matchType forall a b. (a -> b) -> a -> b
$ [String]
benches
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
benches Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any String -> Bool
toRun (Benchmark -> [String]
benchNames Benchmark
bsgroup)) forall a b. (a -> b) -> a -> b
$
forall a. String -> IO a
parseError String
"none of the specified names matches a benchmark"
forall (m :: * -> *) a. Monad m => a -> m a
return String -> Bool
toRun
defaultMainWith :: Config
-> [Benchmark]
-> IO ()
defaultMainWith :: Config -> [Benchmark] -> IO ()
defaultMainWith Config
defCfg [Benchmark]
bs = do
Mode
wat <- forall a. ParserInfo a -> IO a
execParser (Config -> ParserInfo Mode
describe Config
defCfg)
Mode -> [Benchmark] -> IO ()
runMode Mode
wat [Benchmark]
bs
runMode :: Mode -> [Benchmark] -> IO ()
runMode :: Mode -> [Benchmark] -> IO ()
runMode Mode
wat [Benchmark]
bs =
case Mode
wat of
Mode
List -> forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Benchmark -> [String]
benchNames forall a b. (a -> b) -> a -> b
$ [Benchmark]
bs
Mode
Version -> String -> IO ()
putStrLn String
versionInfo
RunIters Config
cfg Int64
iters MatchType
matchType [String]
benches -> do
String -> Bool
shouldRun <- MatchType -> [String] -> Benchmark -> IO (String -> Bool)
selectBenches MatchType
matchType [String]
benches Benchmark
bsgroup
forall a. Config -> Criterion a -> IO a
withConfig Config
cfg forall a b. (a -> b) -> a -> b
$
Int64 -> (String -> Bool) -> Benchmark -> Criterion ()
runFixedIters Int64
iters String -> Bool
shouldRun Benchmark
bsgroup
Run Config
cfg MatchType
matchType [String]
benches -> do
String -> Bool
shouldRun <- MatchType -> [String] -> Benchmark -> IO (String -> Bool)
selectBenches MatchType
matchType [String]
benches Benchmark
bsgroup
forall a. Config -> Criterion a -> IO a
withConfig Config
cfg forall a b. (a -> b) -> a -> b
$ do
forall a. ToRecord a => a -> Criterion ()
writeCsv (String
"Name",String
"Mean",String
"MeanLB",String
"MeanUB",String
"Stddev",String
"StddevLB",
String
"StddevUB")
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 String
"" [Benchmark]
bs
parseError :: String -> IO a
parseError :: forall a. String -> IO a
parseError String
msg = do
Any
_ <- forall r. CritHPrintfType r => String -> r
printError String
"Error: %s\n" String
msg
Any
_ <- forall r. CritHPrintfType r => String -> r
printError String
"Run \"%s --help\" for usage information\n" forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO String
getProgName
forall a. ExitCode -> IO a
exitWith (Int -> ExitCode
ExitFailure Int
64)