module Criterion.Main
(
Benchmarkable(..)
, Benchmark
, bench
, bgroup
, defaultMain
, defaultMainWith
, defaultOptions
, parseArgs
) where
import Control.Monad (MonadPlus(..))
import Criterion (runAndAnalyse)
import Criterion.Config
import Criterion.Environment (measureEnvironment)
import Criterion.IO (note, printError)
import Criterion.MultiMap (singleton)
import Criterion.Monad (doIO, withConfig)
import Criterion.Types (Benchmarkable(..), Benchmark(..), bench, benchNames, bgroup)
import Data.List (isPrefixOf, sort)
import Data.Monoid (Monoid(..), Last(..))
import System.Console.GetOpt
import System.Environment (getArgs, getProgName)
import System.Exit (ExitCode(..), exitWith)
import Text.ParserCombinators.Parsec
parsePlot :: Parser PlotOutput
parsePlot = try (dim "window" Window 800 600)
`mplus` try (dim "win" Window 800 600)
`mplus` try (dim "pdf" PDF 432 324)
`mplus` try (dim "png" PNG 800 600)
`mplus` try (dim "svg" SVG 432 324)
`mplus` (string "csv" >> return CSV)
where dim s c dx dy = do
string s
try (uncurry c `fmap` dimensions) `mplus`
(eof >> return (c dx dy))
dimensions = do
char ':'
a <- many1 digit
char 'x'
b <- many1 digit
case (reads a, reads b) of
([(x,[])],[(y,[])]) -> return (x, y)
_ -> mzero
<?> "dimensions"
plot :: Plot -> String -> IO Config
plot p s = case parse parsePlot "" s of
Left _err -> parseError "unknown plot type\n"
Right t -> return mempty { cfgPlot = singleton p t }
ci :: String -> IO Config
ci s = case reads s' of
[(d,"%")] -> check (d/100)
[(d,"")] -> check d
_ -> parseError "invalid confidence interval provided"
where s' = case s of
('.':_) -> '0':s
_ -> s
check d | d <= 0 = parseError "confidence interval is negative"
| d >= 1 = parseError "confidence interval is greater than 1"
| otherwise = return mempty { cfgConfInterval = ljust d }
pos :: (Num a, Ord a, Read a) =>
String -> (Last a -> Config) -> String -> IO Config
pos q f s =
case reads s of
[(n,"")] | n > 0 -> return . f $ ljust n
| otherwise -> parseError $ q ++ " must be positive"
_ -> parseError $ "invalid " ++ q ++ " provided"
noArg :: Config -> ArgDescr (IO Config)
noArg = NoArg . return
defaultOptions :: [OptDescr (IO Config)]
defaultOptions = [
Option ['h','?'] ["help"] (noArg mempty { cfgPrintExit = Help })
"print help, then exit"
, Option ['G'] ["no-gc"] (noArg mempty { cfgPerformGC = ljust False })
"do not collect garbage between iterations"
, Option ['g'] ["gc"] (noArg mempty { cfgPerformGC = ljust True })
"collect garbage between iterations"
, Option ['I'] ["ci"] (ReqArg ci "CI")
"bootstrap confidence interval"
, Option ['l'] ["list"] (noArg mempty { cfgPrintExit = List })
"print a list of all benchmark names, then exit"
, Option ['k'] ["plot-kde"] (ReqArg (plot KernelDensity) "TYPE")
"plot kernel density estimate of probabilities"
, Option [] ["kde-same-axis"] (noArg mempty {cfgPlotSameAxis = ljust True })
"plot all KDE graphs with the same X axis range (useful for comparison)"
, Option ['q'] ["quiet"] (noArg mempty { cfgVerbosity = ljust Quiet })
"print less output"
, Option [] ["resamples"]
(ReqArg (pos "resample count"$ \n -> mempty { cfgResamples = n }) "N")
"number of bootstrap resamples to perform"
, Option ['s'] ["samples"]
(ReqArg (pos "sample count" $ \n -> mempty { cfgSamples = n }) "N")
"number of samples to collect"
, Option ['t'] ["plot-timing"] (ReqArg (plot Timing) "TYPE")
"plot timings"
, Option ['u'] ["summary"] (ReqArg (\s -> return $ mempty { cfgSummaryFile = ljust s }) "FILENAME")
"produce a summary CSV file of all the benchmark means and standard deviations"
, Option ['V'] ["version"] (noArg mempty { cfgPrintExit = Version })
"display version, then exit"
, Option ['v'] ["verbose"] (noArg mempty { cfgVerbosity = ljust Verbose })
"print more output"
]
printBanner :: Config -> IO ()
printBanner cfg = withConfig cfg $
case cfgBanner cfg of
Last (Just b) -> note "%s\n" b
_ -> note "Hey, nobody told me what version I am!\n"
printUsage :: [OptDescr (IO Config)] -> ExitCode -> IO a
printUsage options exitCode = do
p <- getProgName
putStr (usageInfo ("Usage: " ++ p ++ " [OPTIONS] [BENCHMARKS]") options)
mapM_ putStrLn [
""
, "If no benchmark names are given, all are run"
, "Otherwise, benchmarks are run by prefix match"
, ""
, "Plot types:"
, " window or win display a window immediately"
, " csv save a CSV file"
, " pdf save a PDF file"
, " png save a PNG file"
, " svg save an SVG file"
, ""
, "You can specify plot dimensions via a suffix, e.g. \"window:640x480\""
, "Units are pixels for png and window, 72dpi points for pdf and svg"
]
exitWith exitCode
parseArgs :: Config -> [OptDescr (IO Config)] -> [String]
-> IO (Config, [String])
parseArgs defCfg options args =
case getOpt Permute options args of
(_, _, (err:_)) -> parseError err
(opts, rest, _) -> do
cfg <- (mappend defCfg . mconcat) `fmap` sequence opts
case cfgPrintExit cfg of
Help -> printBanner cfg >> printUsage options ExitSuccess
Version -> printBanner cfg >> exitWith ExitSuccess
_ -> return (cfg, rest)
defaultMain :: [Benchmark] -> IO ()
defaultMain = defaultMainWith defaultConfig
defaultMainWith :: Config -> [Benchmark] -> IO ()
defaultMainWith defCfg bs = do
(cfg, args) <- parseArgs defCfg defaultOptions =<< getArgs
withConfig cfg $
if cfgPrintExit cfg == List
then do
note "Benchmarks:\n"
mapM_ (note " %s\n") (sort $ concatMap benchNames bs)
else do
case getLast $ cfgSummaryFile cfg of
Just fn -> doIO $ writeFile fn "Name,Mean,MeanLB,MeanUB,Stddev,StddevLB,StddevUB\n"
Nothing -> return ()
env <- measureEnvironment
let shouldRun b = null args || any (`isPrefixOf` b) args
runAndAnalyse shouldRun env $ BenchGroup "" bs
parseError :: String -> IO a
parseError msg = do
printError "Error: %s" msg
printError "Run \"%s --help\" for usage information\n" =<< getProgName
exitWith (ExitFailure 64)