module Test.Framework.CriterionWrapper (
HtfBenchmark, ComparisonBenchmark
, mkComparison, mkComparisonWithMargin
, simpleBenchmark, withBenchmarkConfig
, withBenchmarkComparison, withBenchmarkComparisonAndConfig
, IsHtfBenchmark, asHtfBenchmark, prepareHtfBenchmark
, defaultBenchmarkConfig
) where
import Data.Maybe (isJust)
import Criterion
import Criterion.Monad
import Criterion.Environment
import Criterion.Config
import Test.Framework.TestConfig
data AnyBenchmarkable = forall b . Benchmarkable b => AnyBenchmarkable b
instance Benchmarkable AnyBenchmarkable where
run (AnyBenchmarkable b) n = run b n
data HtfBenchmark
= HtfBenchmark
{ htfb_benchmarkable :: AnyBenchmarkable
, htfb_config :: Config
, htfb_comparison :: Maybe ComparisonBenchmark
, htfb_pending :: Bool
}
instance Benchmarkable HtfBenchmark where
run b n = run (htfb_benchmarkable b) n
data ComparisonBenchmark
= ComparisonBenchmark
{ cb_benchmarkable :: AnyBenchmarkable
, cb_factor :: Double
, cb_margin :: Double
}
defaultBenchmarkConfig :: Config
defaultBenchmarkConfig = defaultConfig
mkComparison :: Benchmarkable b => b -> Double -> ComparisonBenchmark
mkComparison b f = mkComparisonWithMargin b f 0.1
mkComparisonWithMargin :: Benchmarkable b => b -> Double -> Double -> ComparisonBenchmark
mkComparisonWithMargin b f m = ComparisonBenchmark (AnyBenchmarkable b) f m
simpleBenchmark :: Benchmarkable b => b -> HtfBenchmark
simpleBenchmark b =
HtfBenchmark
{
htfb_benchmarkable = AnyBenchmarkable b
, htfb_config = defaultConfig
, htfb_comparison = Nothing
, htfb_pending = False
}
withBenchmarkConfig :: Benchmarkable b => Config -> b -> HtfBenchmark
withBenchmarkConfig cfg b =
HtfBenchmark
{
htfb_benchmarkable = AnyBenchmarkable b
, htfb_config = cfg
, htfb_comparison = Nothing
, htfb_pending = False
}
withBenchmarkComparison :: Benchmarkable b => ComparisonBenchmark -> b -> HtfBenchmark
withBenchmarkComparison cmp b =
HtfBenchmark
{
htfb_benchmarkable = AnyBenchmarkable b
, htfb_config = defaultConfig
, htfb_comparison = Just cmp
, htfb_pending = False
}
withBenchmarkComparisonAndConfig ::
Benchmarkable b => ComparisonBenchmark -> Config -> b -> HtfBenchmark
withBenchmarkComparisonAndConfig cmp cfg b =
HtfBenchmark
{
htfb_benchmarkable = AnyBenchmarkable b
, htfb_config = cfg
, htfb_comparison = Just cmp
, htfb_pending = False
}
class IsHtfBenchmark a where
isHtfBenchmark :: a -> Maybe HtfBenchmark
instance IsHtfBenchmark HtfBenchmark where
isHtfBenchmark = Just
instance Benchmarkable b => IsHtfBenchmark b where
isHtfBenchmark = Just . simpleBenchmark
asHtfBenchmark :: (Benchmarkable b, IsHtfBenchmark b) => b -> HtfBenchmark
asHtfBenchmark b =
case isHtfBenchmark b of
Nothing -> simpleBenchmark b
Just h -> h
prepareHtfBenchmark :: HtfBenchmark -> (TestConfig -> Bool, IO ())
prepareHtfBenchmark bench =
(\tc -> tc_benchmarks tc || isJust (htfb_comparison bench),
putStrLn "running benchmarks not yet implemented")
benchmarkPending :: (Benchmarkable b, IsHtfBenchmark b) => b -> HtfBenchmark
benchmarkPending x =
(asHtfBenchmark x) { htfb_pending = True }