module BuildBox.Benchmark.BenchResult
(
BenchResult (..)
, concatBenchResult
, collateBenchResult
, statCollatedBenchResult
, statBenchResult
, compareBenchResults
, compareBenchResultWith
, compareManyBenchResults
, predBenchResult
, swungBenchResult
, BenchRunResult (..)
, appBenchRunResult
, appRunResultAspects
, liftBenchRunResult
, liftBenchRunResult2
, liftToAspectsOfBenchResult
, liftToAspectsOfBenchResult2
, liftRunResultAspects
, liftRunResultAspects2)
where
import BuildBox.Aspect
import BuildBox.Pretty
import Data.List
data BenchResult c
= BenchResult
{ benchResultName :: String
, benchResultRuns :: [BenchRunResult c] }
deriving instance
( Show (c Seconds), Show (c Bytes))
=> Show (BenchResult c)
deriving instance
( HasUnits (c Bytes) Bytes
, Read (c Bytes)
, HasUnits (c Seconds) Seconds
, Read (c Seconds))
=> Read (BenchResult c)
instance ( Pretty (c Seconds), Pretty (c Bytes))
=> Pretty (BenchResult c) where
ppr result
= text (benchResultName result)
$+$ nest 4 (vcat $ map ppr $ benchResultRuns result)
concatBenchResult :: BenchResult c1 -> BenchResult c1
concatBenchResult
= liftBenchRunResult
$ \bsResults -> [BenchRunResult 0 (concatMap benchRunResultAspects bsResults)]
collateBenchResult :: BenchResult Single -> BenchResult []
collateBenchResult
= liftToAspectsOfBenchResult collateWithUnits
statCollatedBenchResult :: BenchResult [] -> BenchResult Stats
statCollatedBenchResult
= liftToAspectsOfBenchResult (map (liftWithUnits makeAspectStats))
statBenchResult :: BenchResult Single -> BenchResult Stats
statBenchResult
= statCollatedBenchResult . collateBenchResult . concatBenchResult
compareBenchResults
:: BenchResult Stats -> BenchResult Stats -> BenchResult StatsComparison
compareBenchResults
= liftBenchRunResult2 (zipWith (liftRunResultAspects2 (liftsWithUnits2 makeAspectComparisons)))
compareBenchResultWith
:: [BenchResult Stats] -> BenchResult Stats -> BenchResult StatsComparison
compareBenchResultWith base result
| Just baseResult <- find (\baseResult -> benchResultName baseResult == benchResultName result) base
= compareBenchResults baseResult result
| otherwise
= liftToAspectsOfBenchResult (liftsWithUnits (map (liftAspect makeStatsComparisonNew))) result
compareManyBenchResults
:: [BenchResult Stats] -> [BenchResult Stats] -> [BenchResult StatsComparison]
compareManyBenchResults base new
= map (compareBenchResultWith base) new
predBenchResult
:: (forall units. Real units => c units -> Bool)
-> BenchResult c -> Bool
predBenchResult f
= appBenchRunResult $ or . map (appRunResultAspects $ or . map (appAspectWithUnits f))
swungBenchResult :: Double -> BenchResult StatsComparison -> Bool
swungBenchResult limit
= predBenchResult (predSwingStatsComparison (\x -> abs x > limit))
appBenchRunResult :: ([BenchRunResult c1] -> b) -> BenchResult c1 -> b
appBenchRunResult f (BenchResult _ runs) = f runs
liftBenchRunResult
:: ([BenchRunResult c1] -> [BenchRunResult c2])
-> (BenchResult c1 -> BenchResult c2)
liftBenchRunResult f (BenchResult name runs)
= BenchResult name (f runs)
liftBenchRunResult2
:: ([BenchRunResult c1] -> [BenchRunResult c2] -> [BenchRunResult c3])
-> BenchResult c1 -> BenchResult c2 -> BenchResult c3
liftBenchRunResult2 f (BenchResult name1 runs1) (BenchResult name2 runs2)
| name1 == name2 = BenchResult name1 (f runs1 runs2)
| otherwise = error "liftBenchRunResult2: names don't match"
liftToAspectsOfBenchResult
:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)])
-> BenchResult c1 -> BenchResult c2
liftToAspectsOfBenchResult
= liftBenchRunResult . map . liftRunResultAspects
liftToAspectsOfBenchResult2
:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)])
-> BenchResult c1 -> BenchResult c2 -> BenchResult c3
liftToAspectsOfBenchResult2
= liftBenchRunResult2 . zipWith . liftRunResultAspects2
data BenchRunResult c
= BenchRunResult
{
benchRunResultIndex :: Integer
, benchRunResultAspects :: [WithUnits (Aspect c)] }
deriving instance
( Show (c Seconds), Show (c Bytes))
=> Show (BenchRunResult c)
deriving instance
( HasUnits (c Bytes) Bytes
, Read (c Bytes)
, HasUnits (c Seconds) Seconds
, Read (c Seconds))
=> Read (BenchRunResult c)
instance ( Pretty (c Seconds), Pretty (c Bytes))
=> Pretty (BenchRunResult c) where
ppr result
| benchRunResultIndex result == 0
= (nest 2 $ vcat $ map ppr $ benchRunResultAspects result)
| otherwise
= ppr (benchRunResultIndex result)
$$ (nest 2 $ vcat $ map ppr $ benchRunResultAspects result)
appRunResultAspects :: ([WithUnits (Aspect c1)] -> b) -> BenchRunResult c1 -> b
appRunResultAspects f (BenchRunResult _ aspects) = f aspects
liftRunResultAspects
:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)])
-> BenchRunResult c1 -> BenchRunResult c2
liftRunResultAspects f (BenchRunResult ix as)
= BenchRunResult ix (f as)
liftRunResultAspects2
:: ([WithUnits (Aspect c1)] -> [WithUnits (Aspect c2)] -> [WithUnits (Aspect c3)])
-> BenchRunResult c1 -> BenchRunResult c2 -> BenchRunResult c3
liftRunResultAspects2 f (BenchRunResult ix1 as) (BenchRunResult ix2 bs)
| ix1 == ix2 = BenchRunResult ix1 (f as bs)
| otherwise = error "liftRunResultAspects2: indices don't match"