module BuildBox.Benchmark
( module BuildBox.Benchmark.TimeAspect
, module BuildBox.Benchmark.Pretty
, module BuildBox.Benchmark.Compare
, Benchmark(..)
, Timing(..)
, BenchRunResult(..)
, BenchResult(..)
, runTimedCommand
, runBenchmarkOnce
, outRunBenchmarkOnce
, outRunBenchmarkAgainst
, outRunBenchmarkWith)
where
import BuildBox.Build
import BuildBox.Pretty
import BuildBox.Benchmark.Base
import BuildBox.Benchmark.TimeAspect
import BuildBox.Benchmark.Pretty
import BuildBox.Benchmark.Compare
import Data.Time
import Data.List
import Control.Monad
runTimedCommand
:: Build a
-> Build (NominalDiffTime, a)
runTimedCommand cmd
= do start <- io $ getCurrentTime
result <- cmd
finish <- io $ getCurrentTime
return (diffUTCTime finish start, result)
runBenchmarkOnce
:: Benchmark
-> Build BenchRunResult
runBenchmarkOnce bench
= do
benchmarkSetup bench
(diffTime, mKernelTimings)
<- runTimedCommand
$ benchmarkCommand bench
benchmarkCheck bench
return $ BenchRunResult
{ benchRunResultElapsed = fromRational $ toRational diffTime
, benchRunResultKernel = mKernelTimings }
outRunBenchmarkOnce
:: Benchmark
-> Build BenchRunResult
outRunBenchmarkOnce bench
= do out $ "Running " ++ benchmarkName bench ++ "..."
result <- runBenchmarkOnce bench
outLn "ok"
outLn $ text " elapsed = " <> (pprFloatTime $ benchRunResultElapsed result)
maybe (return ()) (\t -> outLn $ text " kernel elapsed = " <> pprFloatTime t)
$ takeTimeAspectOfBenchRunResult TimeAspectKernelElapsed result
maybe (return ()) (\t -> outLn $ text " kernel cpu = " <> pprFloatTime t)
$ takeTimeAspectOfBenchRunResult TimeAspectKernelCpu result
maybe (return ()) (\t -> outLn $ text " kernel system = " <> pprFloatTime t)
$ takeTimeAspectOfBenchRunResult TimeAspectKernelSys result
outBlank
return result
outRunBenchmarkAgainst
:: Int
-> Maybe BenchResult
-> Benchmark
-> Build BenchResult
outRunBenchmarkAgainst iterations mPrior bench
= do out $ "Running " ++ benchmarkName bench ++ " " ++ show iterations ++ " times..."
runResults <- replicateM iterations (runBenchmarkOnce bench)
outLn "ok"
let result = BenchResult
{ benchResultName = benchmarkName bench
, benchResultRuns = runResults }
outLn pprBenchResultAspectHeader
maybe (return ()) outLn $ pprBenchResultAspect TimeAspectElapsed mPrior result
maybe (return ()) outLn $ pprBenchResultAspect TimeAspectKernelElapsed mPrior result
maybe (return ()) outLn $ pprBenchResultAspect TimeAspectKernelCpu mPrior result
maybe (return ()) outLn $ pprBenchResultAspect TimeAspectKernelSys mPrior result
outBlank
return result
outRunBenchmarkWith
:: Int
-> [BenchResult]
-> Benchmark
-> Build BenchResult
outRunBenchmarkWith iterations priors bench
= let mPrior = find (\b -> benchResultName b == benchmarkName bench) priors
in outRunBenchmarkAgainst iterations mPrior bench