module BuildBox.Benchmark
( module BuildBox.Benchmark.BenchResult
, Benchmark(..)
, runTimedCommand
, runBenchmarkOnce
, outRunBenchmarkOnce
, outRunBenchmarkWith)
where
import BuildBox.Build
import BuildBox.Aspect
import BuildBox.Benchmark.Benchmark
import BuildBox.Benchmark.BenchResult
import Data.Time
runTimedCommand
:: Build a
-> Build (NominalDiffTime, a)
runTimedCommand cmd
= do start <- io $ getCurrentTime
result <- cmd
finish <- io $ getCurrentTime
return (diffUTCTime finish start, result)
runBenchmarkOnce
:: Integer
-> Benchmark
-> Build (BenchRunResult Single)
runBenchmarkOnce iteration bench
= do
benchmarkSetup bench
(diffTime, asRun)
<- runTimedCommand
$ benchmarkCommand bench
asCheck <- benchmarkCheck bench
return $ BenchRunResult
{ benchRunResultIndex = iteration
, benchRunResultAspects
= Time TotalWall `secs` (fromRational $ toRational diffTime)
: asRun ++ asCheck
, benchRunResultQuirks = [] }
outRunBenchmarkOnce
:: Integer
-> Benchmark
-> Build (BenchRunResult Single)
outRunBenchmarkOnce iteration bench
= do out $ "Running " ++ benchmarkName bench ++ "..."
result <- runBenchmarkOnce iteration bench
outLn "ok"
outLn result
outBlank
return result
outRunBenchmarkWith
:: Int
-> [BenchResult Stats]
-> Benchmark
-> Build (BenchResult Single)
outRunBenchmarkWith iterations priors bench
= do out $ "Running " ++ benchmarkName bench ++ " " ++ show iterations ++ " times..."
runResults <- mapM ((flip runBenchmarkOnce) bench) $ take iterations [1..]
outLn "ok"
let result = BenchResult
{ benchResultName = benchmarkName bench
, benchResultRuns = runResults }
outLn $ compareBenchResultWith priors
$ statBenchResult result
outBlank
return result