{-# LANGUAGE FlexibleInstances #-}

{- | Plutarch benchmarking tools

Interface mirrors the one from @tasty-bench@ but 'bench' instead of taking @Benchmarkable@
takes 'Plutarch.ClosedTerm'

To compare benchmark run against baseline file you need to generate it first with
@cabal run bench -- --csv baseline.csv@. Then after making modifications you can rerun the
benchmarks to compare with previous values with @cabal run bench -- --baseline baseline.csv@.
You can instruct benchmarks to fail if certain values changed by too much using @--fail-if-*@
flags. See @cabal run bench -- --help@ for all available flags. To regenreate baseline file
run with @--csv@ flag again.
-}
module Plutarch.Test.Bench (
  BenchConfig (Optimizing, NonOptimizing),
  Plutarch.Test.Bench.defaultMain,
  bench,
  benchWithConfig,
  bcompare,
  bcompareWithin,

  -- * CLI options

  -- | Benchmarks can be compared against CSV file and fail if they differ too much.
  -- Run @cabal run bench -- --help@ to see available flags and descriptions.
  -- These options are available by default when running benchmarks in 'Plutarch.Test.Bench.defaultMain'
  BaselinePath,
  CsvPath,
  FailIfMoreCpu,
  FailIfLessCpu,
  FailIfMoreMem,
  FailIfLessMem,
  FailIfBigger,
  FailIfSmaller,

  -- * Ingredients

  -- | These are used by default in 'Plutarch.Test.Bench.defaultMain'.
  -- You do not need to do anything with them unless you build your own benchmark runner
  consoleBenchReporter,
  csvReporter,
) where

import Control.DeepSeq (force)
import Control.Exception (bracket, evaluate)
import Control.Monad (forM, guard, unless, when, (>=>))
import Data.Bifunctor (first, second)
import Data.ByteString.Short qualified as Short
import Data.Foldable (traverse_)
import Data.Int (Int64)
import Data.IntMap.Strict (IntMap)
import Data.IntMap.Strict qualified as IntMap
import Data.List (intercalate, isPrefixOf, stripPrefix)
import Data.Maybe (isNothing)
import Data.Monoid (All (All), Any (Any))
import Data.Proxy (Proxy (Proxy))
import Data.SatInt (fromSatInt)
import Data.Sequence (Seq, (<|))
import Data.Sequence qualified as Seq
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Tagged (Tagged (Tagged))
import Data.Text qualified as Text
import GHC.Conc (TVar, atomically, forkIO, newTVarIO, readTVar, retry, writeTVar)
import GHC.IO.Encoding (setLocaleEncoding, utf8)
import Plutarch.Evaluate (evalScriptUnlimited)
import Plutarch.Internal.Term (Config (NoTracing), compile, compileOptimized)
import Plutarch.Prelude
import Plutarch.Script (Script (unScript))
import PlutusCore.Evaluation.Machine.ExBudget (ExBudget (ExBudget))
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory))
import PlutusLedgerApi.Common (serialiseUPLC)
import System.Exit (exitFailure, exitSuccess)
import System.IO (
  BufferMode (LineBuffering),
  Handle,
  IOMode (WriteMode),
  hClose,
  hPutStrLn,
  hSetBuffering,
  openFile,
  stderr,
 )
import Test.Tasty
import Test.Tasty.Ingredients (Ingredient (TestReporter), composeReporters, tryIngredients)
import Test.Tasty.Ingredients.ConsoleReporter (MinDurationToReport (MinDurationToReport))
import Test.Tasty.Options (
  IsOption (defaultValue, optionHelp, optionName, parseValue),
  OptionDescription (Option),
  OptionSet,
  lookupOption,
  safeRead,
  setOption,
 )
import Test.Tasty.Patterns.Eval (asB, eval, withFields)
import Test.Tasty.Patterns.Types (Expr (And, StringLit))
import Test.Tasty.Providers (IsTest (run, testOptions), singleTest, testFailed, testPassed)
import Test.Tasty.Runners (
  Ap (Ap, getApp),
  FailureReason (TestFailed),
  Outcome (Failure),
  Result (resultDescription, resultOutcome, resultShortDescription),
  Status (Done, Executing, NotStarted),
  StatusMap,
  TreeFold (foldAfter, foldGroup, foldSingle),
  consoleTestReporter,
  foldTestTree,
  formatMessage,
  installSignalHandlers,
  listingTests,
  parseExpr,
  parseOptions,
  resultSuccessful,
  testsNames,
  trivialFold,
 )
import Text.Printf (printf)

-- | @since WIP
data BenchConfig
  = -- | Compile with UPLC simplifier pass and no tracing
    Optimizing
  | -- | Compile without UPLC simplifier and configurable tracing
    NonOptimizing Config

{- | Create benchmark from Plutarch term without tracing and no UPLC simplifier

@since WIP
-}
bench :: TestName -> ClosedTerm a -> TestTree
bench :: forall (a :: PType). TestName -> ClosedTerm a -> TestTree
bench TestName
name = TestName -> BenchConfig -> (forall {s :: S}. Term s a) -> TestTree
forall (a :: PType).
TestName -> BenchConfig -> ClosedTerm a -> TestTree
benchWithConfig TestName
name (Config -> BenchConfig
NonOptimizing Config
NoTracing)

{- | Like 'bench' but with customizable compilation config

@since WIP
-}
benchWithConfig :: TestName -> BenchConfig -> ClosedTerm a -> TestTree
benchWithConfig :: forall (a :: PType).
TestName -> BenchConfig -> ClosedTerm a -> TestTree
benchWithConfig TestName
name BenchConfig
config ClosedTerm a
term = TestName -> PBenchmarkable -> TestTree
forall t. IsTest t => TestName -> t -> TestTree
singleTest TestName
name (PBenchmarkable -> TestTree) -> PBenchmarkable -> TestTree
forall a b. (a -> b) -> a -> b
$ BenchConfig -> ClosedTerm a -> PBenchmarkable
forall (a :: PType). BenchConfig -> ClosedTerm a -> PBenchmarkable
PBenchmarkable BenchConfig
config Term s a
ClosedTerm a
term

{- | Compare benchmarks, reporting relative CPU, MEM, and size differences

 @since WIP
-}
bcompare ::
  -- | Tasty pattern to compare as baseline
  String ->
  -- | Test or test tree to compare with baseline test
  TestTree ->
  TestTree
bcompare :: TestName -> TestTree -> TestTree
bcompare = (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> TestName
-> TestTree
-> TestTree
bcompareWithin (Double
-1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0, Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) (Double
-1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0, Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0) (Double
-1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0, Double
1 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0)

{- | Like 'bcompare' but with customizable upper and lower bounds of relative differences

@since WIP
-}
bcompareWithin ::
  -- | CPU bounds
  (Double, Double) ->
  -- | MEM bounds
  (Double, Double) ->
  -- | Size bounds
  (Double, Double) ->
  -- | Tasty pattern to compare as baseline
  String ->
  -- | Test or test tree to compare with baseline test
  TestTree ->
  TestTree
bcompareWithin :: (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> TestName
-> TestTree
-> TestTree
bcompareWithin (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size TestName
s = case TestName -> Maybe Expr
parseExpr TestName
s of
  Maybe Expr
Nothing -> TestName -> TestTree -> TestTree
forall a. HasCallStack => TestName -> a
error (TestName -> TestTree -> TestTree)
-> TestName -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ TestName
"Could not parse pbcompare pattern " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
s
  Just Expr
e -> DependencyType -> Expr -> TestTree -> TestTree
after_ DependencyType
AllSucceed (Expr -> Expr -> Expr
And (TestName -> Expr
StringLit (TestName
pbcomparePrefix TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ WithLoHi () -> TestName
forall a. Show a => a -> TestName
show (()
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi ()
forall a.
a
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi a
WithLoHi () (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size))) Expr
e)

{- | Use this instead of 'Test.Tasty.defaultMain' from @Test.Tasty@ to run benchmarks to get formatted output

@since WIP
-}
defaultMain :: TestTree -> IO ()
defaultMain :: TestTree -> IO ()
defaultMain TestTree
bs = do
  TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
  IO ()
installSignalHandlers
  let pbenchIngredients :: l
pbenchIngredients = [Item l
Ingredient
listingTests, Ingredient -> Ingredient -> Ingredient
composeReporters Ingredient
consoleBenchReporter Ingredient
csvReporter]
  OptionSet
opts <- [Ingredient] -> TestTree -> IO OptionSet
parseOptions [Ingredient]
forall {l}.
((Item l :: Type) ~ (Ingredient :: Type), IsList l) =>
l
pbenchIngredients TestTree
bs
  let opts' :: OptionSet
opts' = MinDurationToReport -> OptionSet -> OptionSet
forall v. IsOption v => v -> OptionSet -> OptionSet
setOption (Integer -> MinDurationToReport
MinDurationToReport Integer
1000000000000) OptionSet
opts
  case [Ingredient] -> OptionSet -> TestTree -> Maybe (IO Bool)
tryIngredients [Ingredient]
forall {l}.
((Item l :: Type) ~ (Ingredient :: Type), IsList l) =>
l
pbenchIngredients OptionSet
opts' TestTree
bs of
    Maybe (IO Bool)
Nothing -> IO ()
forall a. IO a
exitFailure
    Just IO Bool
act -> IO Bool
act IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> if Bool
x then IO ()
forall a. IO a
exitSuccess else IO ()
forall a. IO a
exitFailure

-- | @since WIP
consoleBenchReporter :: Ingredient
consoleBenchReporter :: Ingredient
consoleBenchReporter = [OptionDescription]
-> (OptionSet
    -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [Proxy @Type (Maybe BaselinePath) -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type (Maybe BaselinePath)
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy (Maybe BaselinePath))] ((OptionSet
  -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result))
 -> Ingredient)
-> (OptionSet
    -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
opts -> do
  Set TestName
baseline <- case OptionSet -> Maybe BaselinePath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts of
    Maybe BaselinePath
Nothing -> Set TestName -> IO (Set TestName)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Set TestName
forall a. Set a
Set.empty
    Just (BaselinePath TestName
path) ->
      [TestName] -> Set TestName
forall a. Ord a => [a] -> Set a
Set.fromList
        ([TestName] -> Set TestName)
-> (TestName -> [TestName]) -> TestName -> Set TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TestName] -> [TestName]
joinQuotedFields
        ([TestName] -> [TestName])
-> (TestName -> [TestName]) -> TestName -> [TestName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> [TestName]
lines
        (TestName -> Set TestName) -> IO TestName -> IO (Set TestName)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> (TestName -> IO TestName
readFile TestName
path IO TestName -> (TestName -> IO TestName) -> IO TestName
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= TestName -> IO TestName
forall a. a -> IO a
evaluate (TestName -> IO TestName)
-> (TestName -> TestName) -> TestName -> IO TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> TestName
forall a. NFData a => a -> a
force)
  (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((TestName -> Unique (WithLoHi Result) -> Result -> Result)
 -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result))
-> (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result)
forall a b. (a -> b) -> a -> b
$ \TestName
name Unique (WithLoHi Result)
uDepR Result
r ->
    case Unique (WithLoHi Result)
uDepR of
      Unique (WithLoHi Result)
None -> TestName -> Result
testFailed TestName
"Failed to find pattern from `bcompare`"
      Unique (WithLoHi Result)
NotUnique -> TestName -> Result
testFailed TestName
"Pattern from `bcompare` is not unique"
      Unique (WithLoHi Result)
mDepR ->
        case TestName -> Maybe (WithLoHi ExecutionBudget)
forall a. Read a => TestName -> Maybe a
safeRead (Result -> TestName
resultDescription Result
r) of
          Maybe (WithLoHi ExecutionBudget)
Nothing -> Result
r
          Just
            ( WithLoHi
                est :: ExecutionBudget
est@(ExecutionBudget Integer
budgetCpu' Integer
budgetMem' Integer
budgetSize')
                (Double
lowerBoundCpu, Double
upperBoundCpu)
                (Double
lowerBoundMem, Double
upperBoundMem)
                (Double
lowerBoundSize, Double
upperBoundSize)
              ) ->
              (if Bool
isAcceptable then Result -> Result
forall a. a -> a
id else Result -> Result
forceFail)
                Result
r
                  { resultDescription =
                      toTableAligned
                        [ ["CPU", show budgetCpu', bcompareCpu, showSlowdown slowDownCpu]
                        , ["MEM", show budgetMem', bcompareMem, showSlowdown slowDownMem]
                        , ["SIZE", show budgetSize', bcompareSize, showSlowdown slowDownSize]
                        ]
                  }
              where
                showSlowdown :: Double -> TestName
showSlowdown Double
s = if Maybe (Double, Double, Double) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (Double, Double, Double)
mSlowDown then TestName
"" else Double -> TestName
formatSlowDown Double
s
                isAcceptable :: Bool
isAcceptable = Bool
isAcceptableVsBaseline Bool -> Bool -> Bool
&& Bool
isAcceptableVsBcompare
                mSlowDown :: Maybe (Double, Double, Double)
mSlowDown = Set TestName
-> TestName -> ExecutionBudget -> Maybe (Double, Double, Double)
compareVsBaseline Set TestName
baseline TestName
name ExecutionBudget
est
                slowDownCpu :: Double
slowDownCpu = Double
-> ((Double, Double, Double) -> Double)
-> Maybe (Double, Double, Double)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
1 (\(Double
cpu, Double
_, Double
_) -> Double
cpu) Maybe (Double, Double, Double)
mSlowDown
                slowDownMem :: Double
slowDownMem = Double
-> ((Double, Double, Double) -> Double)
-> Maybe (Double, Double, Double)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
1 (\(Double
_, Double
mem, Double
_) -> Double
mem) Maybe (Double, Double, Double)
mSlowDown
                slowDownSize :: Double
slowDownSize = Double
-> ((Double, Double, Double) -> Double)
-> Maybe (Double, Double, Double)
-> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
1 (\(Double
_, Double
_, Double
size) -> Double
size) Maybe (Double, Double, Double)
mSlowDown
                isAcceptableVsBaseline :: Bool
isAcceptableVsBaseline =
                  Double
slowDownCpu Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lowerBoundCpu
                    Bool -> Bool -> Bool
&& Double
slowDownCpu Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
upperBoundCpu
                    Bool -> Bool -> Bool
&& Double
slowDownMem Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lowerBoundMem
                    Bool -> Bool -> Bool
&& Double
slowDownMem Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
upperBoundMem
                    Bool -> Bool -> Bool
&& Double
slowDownSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
lowerBoundSize
                    Bool -> Bool -> Bool
&& Double
slowDownSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
upperBoundSize
                (Bool
isAcceptableVsBcompare, TestName
bcompareCpu, TestName
bcompareMem, TestName
bcompareSize) = case Unique (WithLoHi Result)
mDepR of
                  Unique (WithLoHi Result)
NotProvided -> (Bool
True, TestName
"", TestName
"", TestName
"" :: String)
                  Unique
                    ( WithLoHi
                        Result
depR
                        (Double
depLowerBoundCpu, Double
depUpperBoundCpu)
                        (Double
depLowerBoundMem, Double
depUpperBoundMem)
                        (Double
depLowerBoundSize, Double
depUpperBoundSize)
                      ) -> case TestName -> Maybe (WithLoHi ExecutionBudget)
forall a. Read a => TestName -> Maybe a
safeRead (Result -> TestName
resultDescription Result
depR) of
                      Maybe (WithLoHi ExecutionBudget)
Nothing -> (Bool
True, TestName
"", TestName
"", TestName
"")
                      Just (WithLoHi (ExecutionBudget Integer
depCpu Integer
depMem Integer
depSize) (Double, Double)
_ (Double, Double)
_ (Double, Double)
_) ->
                        let
                          Double
ratioCpu :: Double = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
budgetCpu' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
depCpu
                          Double
ratioMem :: Double = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
budgetMem' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
depMem
                          Double
ratioSize :: Double = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
budgetSize' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
depSize
                         in
                          ( Double
ratioCpu Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
depLowerBoundCpu
                              Bool -> Bool -> Bool
&& Double
ratioCpu Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
depUpperBoundCpu
                              Bool -> Bool -> Bool
&& Double
ratioMem Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
depLowerBoundMem
                              Bool -> Bool -> Bool
&& Double
ratioMem Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
depUpperBoundMem
                              Bool -> Bool -> Bool
&& Double
ratioSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
depLowerBoundSize
                              Bool -> Bool -> Bool
&& Double
ratioSize Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
depUpperBoundSize
                          , TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fx" Double
ratioCpu
                          , TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fx" Double
ratioMem
                          , TestName -> Double -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%.2fx" Double
ratioSize
                          )

-- | @since WIP
csvReporter :: Ingredient
csvReporter :: Ingredient
csvReporter = [OptionDescription]
-> (OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter [Proxy @Type (Maybe CsvPath) -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type (Maybe CsvPath)
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy (Maybe CsvPath))] ((OptionSet
  -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
 -> Ingredient)
-> (OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$
  \OptionSet
opts TestTree
tree -> do
    CsvPath TestName
path <- OptionSet -> Maybe CsvPath
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
    let names :: [TestName]
names = OptionSet -> TestTree -> [TestName]
testsNames OptionSet
opts TestTree
tree
        namesMap :: IntMap TestName
namesMap = [(Key, TestName)] -> IntMap TestName
forall a. [(Key, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Key, TestName)] -> IntMap TestName)
-> [(Key, TestName)] -> IntMap TestName
forall a b. (a -> b) -> a -> b
$ [Key] -> [TestName] -> [(Key, TestName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
Item [Key]
0 ..] [TestName]
names
    (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((StatusMap -> IO (Double -> IO Bool))
 -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall a b. (a -> b) -> a -> b
$ \StatusMap
smap -> do
      case [TestName] -> Maybe TestName
forall a. Ord a => [a] -> Maybe a
findNonUniqueElement [TestName]
names of
        Maybe TestName
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        Just TestName
name -> do
          Handle -> TestName -> IO ()
hPutStrLn Handle
stderr (TestName -> IO ()) -> TestName -> IO ()
forall a b. (a -> b) -> a -> b
$ TestName
"CSV report cannot proceed, because name '" TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
name TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"' corresponds to two or more benchmarks. Please disambiguate them."
          IO ()
forall a. IO a
exitFailure
      let augmented :: IntMap (TestName, TVar Status)
augmented = (TestName -> TVar Status -> (TestName, TVar Status))
-> IntMap TestName -> StatusMap -> IntMap (TestName, TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith (,) IntMap TestName
namesMap StatusMap
smap
      IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
        ( do
            Handle
h <- TestName -> IOMode -> IO Handle
openFile TestName
path IOMode
WriteMode
            Handle -> BufferMode -> IO ()
hSetBuffering Handle
h BufferMode
LineBuffering
            Handle -> TestName -> IO ()
hPutStrLn Handle
h TestName
"name,cpu,mem,size"
            Handle -> IO Handle
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Handle
h
        )
        Handle -> IO ()
hClose
        (Handle -> IntMap (TestName, TVar Status) -> IO ()
`csvOutput` IntMap (TestName, TVar Status)
augmented)
      (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((Double -> IO Bool) -> IO (Double -> IO Bool))
-> (Double -> IO Bool) -> IO (Double -> IO Bool)
forall a b. (a -> b) -> a -> b
$ IO Bool -> Double -> IO Bool
forall a b. a -> b -> a
const (IO Bool -> Double -> IO Bool) -> IO Bool -> Double -> IO Bool
forall a b. (a -> b) -> a -> b
$ StatusMap -> IO Bool
isSuccessful StatusMap
smap

-- | @since WIP
newtype FailIfMoreCpu = FailIfMoreCpu Double
  deriving stock
    ( -- | @since WIP
      FailIfMoreCpu -> FailIfMoreCpu -> Bool
(FailIfMoreCpu -> FailIfMoreCpu -> Bool)
-> (FailIfMoreCpu -> FailIfMoreCpu -> Bool) -> Eq FailIfMoreCpu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
== :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
$c/= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
/= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
Eq
    , -- | @since WIP
      Eq FailIfMoreCpu
Eq FailIfMoreCpu =>
(FailIfMoreCpu -> FailIfMoreCpu -> Ordering)
-> (FailIfMoreCpu -> FailIfMoreCpu -> Bool)
-> (FailIfMoreCpu -> FailIfMoreCpu -> Bool)
-> (FailIfMoreCpu -> FailIfMoreCpu -> Bool)
-> (FailIfMoreCpu -> FailIfMoreCpu -> Bool)
-> (FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> Ord FailIfMoreCpu
FailIfMoreCpu -> FailIfMoreCpu -> Bool
FailIfMoreCpu -> FailIfMoreCpu -> Ordering
FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfMoreCpu -> FailIfMoreCpu -> Ordering
compare :: FailIfMoreCpu -> FailIfMoreCpu -> Ordering
$c< :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
< :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
$c<= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
<= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
$c> :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
> :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
$c>= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
>= :: FailIfMoreCpu -> FailIfMoreCpu -> Bool
$cmax :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
max :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
$cmin :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
min :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
Ord
    , -- | @since WIP
      Key -> FailIfMoreCpu -> TestName -> TestName
[FailIfMoreCpu] -> TestName -> TestName
FailIfMoreCpu -> TestName
(Key -> FailIfMoreCpu -> TestName -> TestName)
-> (FailIfMoreCpu -> TestName)
-> ([FailIfMoreCpu] -> TestName -> TestName)
-> Show FailIfMoreCpu
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfMoreCpu -> TestName -> TestName
showsPrec :: Key -> FailIfMoreCpu -> TestName -> TestName
$cshow :: FailIfMoreCpu -> TestName
show :: FailIfMoreCpu -> TestName
$cshowList :: [FailIfMoreCpu] -> TestName -> TestName
showList :: [FailIfMoreCpu] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfMoreCpu]
ReadPrec FailIfMoreCpu
Key -> ReadS FailIfMoreCpu
ReadS [FailIfMoreCpu]
(Key -> ReadS FailIfMoreCpu)
-> ReadS [FailIfMoreCpu]
-> ReadPrec FailIfMoreCpu
-> ReadPrec [FailIfMoreCpu]
-> Read FailIfMoreCpu
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfMoreCpu
readsPrec :: Key -> ReadS FailIfMoreCpu
$creadList :: ReadS [FailIfMoreCpu]
readList :: ReadS [FailIfMoreCpu]
$creadPrec :: ReadPrec FailIfMoreCpu
readPrec :: ReadPrec FailIfMoreCpu
$creadListPrec :: ReadPrec [FailIfMoreCpu]
readListPrec :: ReadPrec [FailIfMoreCpu]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfMoreCpu
FailIfMoreCpu -> FailIfMoreCpu
FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
(FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu)
-> (Integer -> FailIfMoreCpu)
-> Num FailIfMoreCpu
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
+ :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
$c- :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
- :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
$c* :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
* :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
$cnegate :: FailIfMoreCpu -> FailIfMoreCpu
negate :: FailIfMoreCpu -> FailIfMoreCpu
$cabs :: FailIfMoreCpu -> FailIfMoreCpu
abs :: FailIfMoreCpu -> FailIfMoreCpu
$csignum :: FailIfMoreCpu -> FailIfMoreCpu
signum :: FailIfMoreCpu -> FailIfMoreCpu
$cfromInteger :: Integer -> FailIfMoreCpu
fromInteger :: Integer -> FailIfMoreCpu
Num
    , -- | @since WIP
      Num FailIfMoreCpu
Num FailIfMoreCpu =>
(FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu)
-> (FailIfMoreCpu -> FailIfMoreCpu)
-> (Rational -> FailIfMoreCpu)
-> Fractional FailIfMoreCpu
Rational -> FailIfMoreCpu
FailIfMoreCpu -> FailIfMoreCpu
FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
/ :: FailIfMoreCpu -> FailIfMoreCpu -> FailIfMoreCpu
$crecip :: FailIfMoreCpu -> FailIfMoreCpu
recip :: FailIfMoreCpu -> FailIfMoreCpu
$cfromRational :: Rational -> FailIfMoreCpu
fromRational :: Rational -> FailIfMoreCpu
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfMoreCpu where
  defaultValue :: FailIfMoreCpu
defaultValue = Double -> FailIfMoreCpu
FailIfMoreCpu (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfMoreCpu
parseValue = (Double -> FailIfMoreCpu) -> Maybe Double -> Maybe FailIfMoreCpu
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfMoreCpu
FailIfMoreCpu (Maybe Double -> Maybe FailIfMoreCpu)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfMoreCpu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfMoreCpu TestName
optionName = TestName -> Tagged @Type FailIfMoreCpu TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-more-cpu"
  optionHelp :: Tagged @Type FailIfMoreCpu TestName
optionHelp = TestName -> Tagged @Type FailIfMoreCpu TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark uses unacceptably more CPU than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype FailIfLessCpu = FailIfLessCpu Double
  deriving stock
    ( -- | @since WIP
      FailIfLessCpu -> FailIfLessCpu -> Bool
(FailIfLessCpu -> FailIfLessCpu -> Bool)
-> (FailIfLessCpu -> FailIfLessCpu -> Bool) -> Eq FailIfLessCpu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfLessCpu -> FailIfLessCpu -> Bool
== :: FailIfLessCpu -> FailIfLessCpu -> Bool
$c/= :: FailIfLessCpu -> FailIfLessCpu -> Bool
/= :: FailIfLessCpu -> FailIfLessCpu -> Bool
Eq
    , -- | @since WIP
      Eq FailIfLessCpu
Eq FailIfLessCpu =>
(FailIfLessCpu -> FailIfLessCpu -> Ordering)
-> (FailIfLessCpu -> FailIfLessCpu -> Bool)
-> (FailIfLessCpu -> FailIfLessCpu -> Bool)
-> (FailIfLessCpu -> FailIfLessCpu -> Bool)
-> (FailIfLessCpu -> FailIfLessCpu -> Bool)
-> (FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> Ord FailIfLessCpu
FailIfLessCpu -> FailIfLessCpu -> Bool
FailIfLessCpu -> FailIfLessCpu -> Ordering
FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfLessCpu -> FailIfLessCpu -> Ordering
compare :: FailIfLessCpu -> FailIfLessCpu -> Ordering
$c< :: FailIfLessCpu -> FailIfLessCpu -> Bool
< :: FailIfLessCpu -> FailIfLessCpu -> Bool
$c<= :: FailIfLessCpu -> FailIfLessCpu -> Bool
<= :: FailIfLessCpu -> FailIfLessCpu -> Bool
$c> :: FailIfLessCpu -> FailIfLessCpu -> Bool
> :: FailIfLessCpu -> FailIfLessCpu -> Bool
$c>= :: FailIfLessCpu -> FailIfLessCpu -> Bool
>= :: FailIfLessCpu -> FailIfLessCpu -> Bool
$cmax :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
max :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
$cmin :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
min :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
Ord
    , -- | @since WIP
      Key -> FailIfLessCpu -> TestName -> TestName
[FailIfLessCpu] -> TestName -> TestName
FailIfLessCpu -> TestName
(Key -> FailIfLessCpu -> TestName -> TestName)
-> (FailIfLessCpu -> TestName)
-> ([FailIfLessCpu] -> TestName -> TestName)
-> Show FailIfLessCpu
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfLessCpu -> TestName -> TestName
showsPrec :: Key -> FailIfLessCpu -> TestName -> TestName
$cshow :: FailIfLessCpu -> TestName
show :: FailIfLessCpu -> TestName
$cshowList :: [FailIfLessCpu] -> TestName -> TestName
showList :: [FailIfLessCpu] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfLessCpu]
ReadPrec FailIfLessCpu
Key -> ReadS FailIfLessCpu
ReadS [FailIfLessCpu]
(Key -> ReadS FailIfLessCpu)
-> ReadS [FailIfLessCpu]
-> ReadPrec FailIfLessCpu
-> ReadPrec [FailIfLessCpu]
-> Read FailIfLessCpu
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfLessCpu
readsPrec :: Key -> ReadS FailIfLessCpu
$creadList :: ReadS [FailIfLessCpu]
readList :: ReadS [FailIfLessCpu]
$creadPrec :: ReadPrec FailIfLessCpu
readPrec :: ReadPrec FailIfLessCpu
$creadListPrec :: ReadPrec [FailIfLessCpu]
readListPrec :: ReadPrec [FailIfLessCpu]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfLessCpu
FailIfLessCpu -> FailIfLessCpu
FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
(FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu)
-> (Integer -> FailIfLessCpu)
-> Num FailIfLessCpu
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
+ :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
$c- :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
- :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
$c* :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
* :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
$cnegate :: FailIfLessCpu -> FailIfLessCpu
negate :: FailIfLessCpu -> FailIfLessCpu
$cabs :: FailIfLessCpu -> FailIfLessCpu
abs :: FailIfLessCpu -> FailIfLessCpu
$csignum :: FailIfLessCpu -> FailIfLessCpu
signum :: FailIfLessCpu -> FailIfLessCpu
$cfromInteger :: Integer -> FailIfLessCpu
fromInteger :: Integer -> FailIfLessCpu
Num
    , -- | @since WIP
      Num FailIfLessCpu
Num FailIfLessCpu =>
(FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu)
-> (FailIfLessCpu -> FailIfLessCpu)
-> (Rational -> FailIfLessCpu)
-> Fractional FailIfLessCpu
Rational -> FailIfLessCpu
FailIfLessCpu -> FailIfLessCpu
FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
/ :: FailIfLessCpu -> FailIfLessCpu -> FailIfLessCpu
$crecip :: FailIfLessCpu -> FailIfLessCpu
recip :: FailIfLessCpu -> FailIfLessCpu
$cfromRational :: Rational -> FailIfLessCpu
fromRational :: Rational -> FailIfLessCpu
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfLessCpu where
  defaultValue :: FailIfLessCpu
defaultValue = Double -> FailIfLessCpu
FailIfLessCpu (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfLessCpu
parseValue = (Double -> FailIfLessCpu) -> Maybe Double -> Maybe FailIfLessCpu
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfLessCpu
FailIfLessCpu (Maybe Double -> Maybe FailIfLessCpu)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfLessCpu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfLessCpu TestName
optionName = TestName -> Tagged @Type FailIfLessCpu TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-less-cpu"
  optionHelp :: Tagged @Type FailIfLessCpu TestName
optionHelp = TestName -> Tagged @Type FailIfLessCpu TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark uses unacceptably less CPU than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype FailIfMoreMem = FailIfMoreMem Double
  deriving stock
    ( -- | @since WIP
      FailIfMoreMem -> FailIfMoreMem -> Bool
(FailIfMoreMem -> FailIfMoreMem -> Bool)
-> (FailIfMoreMem -> FailIfMoreMem -> Bool) -> Eq FailIfMoreMem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfMoreMem -> FailIfMoreMem -> Bool
== :: FailIfMoreMem -> FailIfMoreMem -> Bool
$c/= :: FailIfMoreMem -> FailIfMoreMem -> Bool
/= :: FailIfMoreMem -> FailIfMoreMem -> Bool
Eq
    , -- | @since WIP
      Eq FailIfMoreMem
Eq FailIfMoreMem =>
(FailIfMoreMem -> FailIfMoreMem -> Ordering)
-> (FailIfMoreMem -> FailIfMoreMem -> Bool)
-> (FailIfMoreMem -> FailIfMoreMem -> Bool)
-> (FailIfMoreMem -> FailIfMoreMem -> Bool)
-> (FailIfMoreMem -> FailIfMoreMem -> Bool)
-> (FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> Ord FailIfMoreMem
FailIfMoreMem -> FailIfMoreMem -> Bool
FailIfMoreMem -> FailIfMoreMem -> Ordering
FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfMoreMem -> FailIfMoreMem -> Ordering
compare :: FailIfMoreMem -> FailIfMoreMem -> Ordering
$c< :: FailIfMoreMem -> FailIfMoreMem -> Bool
< :: FailIfMoreMem -> FailIfMoreMem -> Bool
$c<= :: FailIfMoreMem -> FailIfMoreMem -> Bool
<= :: FailIfMoreMem -> FailIfMoreMem -> Bool
$c> :: FailIfMoreMem -> FailIfMoreMem -> Bool
> :: FailIfMoreMem -> FailIfMoreMem -> Bool
$c>= :: FailIfMoreMem -> FailIfMoreMem -> Bool
>= :: FailIfMoreMem -> FailIfMoreMem -> Bool
$cmax :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
max :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
$cmin :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
min :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
Ord
    , -- | @since WIP
      Key -> FailIfMoreMem -> TestName -> TestName
[FailIfMoreMem] -> TestName -> TestName
FailIfMoreMem -> TestName
(Key -> FailIfMoreMem -> TestName -> TestName)
-> (FailIfMoreMem -> TestName)
-> ([FailIfMoreMem] -> TestName -> TestName)
-> Show FailIfMoreMem
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfMoreMem -> TestName -> TestName
showsPrec :: Key -> FailIfMoreMem -> TestName -> TestName
$cshow :: FailIfMoreMem -> TestName
show :: FailIfMoreMem -> TestName
$cshowList :: [FailIfMoreMem] -> TestName -> TestName
showList :: [FailIfMoreMem] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfMoreMem]
ReadPrec FailIfMoreMem
Key -> ReadS FailIfMoreMem
ReadS [FailIfMoreMem]
(Key -> ReadS FailIfMoreMem)
-> ReadS [FailIfMoreMem]
-> ReadPrec FailIfMoreMem
-> ReadPrec [FailIfMoreMem]
-> Read FailIfMoreMem
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfMoreMem
readsPrec :: Key -> ReadS FailIfMoreMem
$creadList :: ReadS [FailIfMoreMem]
readList :: ReadS [FailIfMoreMem]
$creadPrec :: ReadPrec FailIfMoreMem
readPrec :: ReadPrec FailIfMoreMem
$creadListPrec :: ReadPrec [FailIfMoreMem]
readListPrec :: ReadPrec [FailIfMoreMem]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfMoreMem
FailIfMoreMem -> FailIfMoreMem
FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
(FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem)
-> (Integer -> FailIfMoreMem)
-> Num FailIfMoreMem
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
+ :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
$c- :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
- :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
$c* :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
* :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
$cnegate :: FailIfMoreMem -> FailIfMoreMem
negate :: FailIfMoreMem -> FailIfMoreMem
$cabs :: FailIfMoreMem -> FailIfMoreMem
abs :: FailIfMoreMem -> FailIfMoreMem
$csignum :: FailIfMoreMem -> FailIfMoreMem
signum :: FailIfMoreMem -> FailIfMoreMem
$cfromInteger :: Integer -> FailIfMoreMem
fromInteger :: Integer -> FailIfMoreMem
Num
    , -- | @since WIP
      Num FailIfMoreMem
Num FailIfMoreMem =>
(FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem)
-> (FailIfMoreMem -> FailIfMoreMem)
-> (Rational -> FailIfMoreMem)
-> Fractional FailIfMoreMem
Rational -> FailIfMoreMem
FailIfMoreMem -> FailIfMoreMem
FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
/ :: FailIfMoreMem -> FailIfMoreMem -> FailIfMoreMem
$crecip :: FailIfMoreMem -> FailIfMoreMem
recip :: FailIfMoreMem -> FailIfMoreMem
$cfromRational :: Rational -> FailIfMoreMem
fromRational :: Rational -> FailIfMoreMem
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfMoreMem where
  defaultValue :: FailIfMoreMem
defaultValue = Double -> FailIfMoreMem
FailIfMoreMem (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfMoreMem
parseValue = (Double -> FailIfMoreMem) -> Maybe Double -> Maybe FailIfMoreMem
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfMoreMem
FailIfMoreMem (Maybe Double -> Maybe FailIfMoreMem)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfMoreMem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfMoreMem TestName
optionName = TestName -> Tagged @Type FailIfMoreMem TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-more-cpu"
  optionHelp :: Tagged @Type FailIfMoreMem TestName
optionHelp = TestName -> Tagged @Type FailIfMoreMem TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark uses unacceptably more MEM than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype FailIfLessMem = FailIfLessMem Double
  deriving stock
    ( -- | @since WIP
      FailIfLessMem -> FailIfLessMem -> Bool
(FailIfLessMem -> FailIfLessMem -> Bool)
-> (FailIfLessMem -> FailIfLessMem -> Bool) -> Eq FailIfLessMem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfLessMem -> FailIfLessMem -> Bool
== :: FailIfLessMem -> FailIfLessMem -> Bool
$c/= :: FailIfLessMem -> FailIfLessMem -> Bool
/= :: FailIfLessMem -> FailIfLessMem -> Bool
Eq
    , -- | @since WIP
      Eq FailIfLessMem
Eq FailIfLessMem =>
(FailIfLessMem -> FailIfLessMem -> Ordering)
-> (FailIfLessMem -> FailIfLessMem -> Bool)
-> (FailIfLessMem -> FailIfLessMem -> Bool)
-> (FailIfLessMem -> FailIfLessMem -> Bool)
-> (FailIfLessMem -> FailIfLessMem -> Bool)
-> (FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> Ord FailIfLessMem
FailIfLessMem -> FailIfLessMem -> Bool
FailIfLessMem -> FailIfLessMem -> Ordering
FailIfLessMem -> FailIfLessMem -> FailIfLessMem
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfLessMem -> FailIfLessMem -> Ordering
compare :: FailIfLessMem -> FailIfLessMem -> Ordering
$c< :: FailIfLessMem -> FailIfLessMem -> Bool
< :: FailIfLessMem -> FailIfLessMem -> Bool
$c<= :: FailIfLessMem -> FailIfLessMem -> Bool
<= :: FailIfLessMem -> FailIfLessMem -> Bool
$c> :: FailIfLessMem -> FailIfLessMem -> Bool
> :: FailIfLessMem -> FailIfLessMem -> Bool
$c>= :: FailIfLessMem -> FailIfLessMem -> Bool
>= :: FailIfLessMem -> FailIfLessMem -> Bool
$cmax :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
max :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
$cmin :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
min :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
Ord
    , -- | @since WIP
      Key -> FailIfLessMem -> TestName -> TestName
[FailIfLessMem] -> TestName -> TestName
FailIfLessMem -> TestName
(Key -> FailIfLessMem -> TestName -> TestName)
-> (FailIfLessMem -> TestName)
-> ([FailIfLessMem] -> TestName -> TestName)
-> Show FailIfLessMem
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfLessMem -> TestName -> TestName
showsPrec :: Key -> FailIfLessMem -> TestName -> TestName
$cshow :: FailIfLessMem -> TestName
show :: FailIfLessMem -> TestName
$cshowList :: [FailIfLessMem] -> TestName -> TestName
showList :: [FailIfLessMem] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfLessMem]
ReadPrec FailIfLessMem
Key -> ReadS FailIfLessMem
ReadS [FailIfLessMem]
(Key -> ReadS FailIfLessMem)
-> ReadS [FailIfLessMem]
-> ReadPrec FailIfLessMem
-> ReadPrec [FailIfLessMem]
-> Read FailIfLessMem
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfLessMem
readsPrec :: Key -> ReadS FailIfLessMem
$creadList :: ReadS [FailIfLessMem]
readList :: ReadS [FailIfLessMem]
$creadPrec :: ReadPrec FailIfLessMem
readPrec :: ReadPrec FailIfLessMem
$creadListPrec :: ReadPrec [FailIfLessMem]
readListPrec :: ReadPrec [FailIfLessMem]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfLessMem
FailIfLessMem -> FailIfLessMem
FailIfLessMem -> FailIfLessMem -> FailIfLessMem
(FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem)
-> (Integer -> FailIfLessMem)
-> Num FailIfLessMem
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
+ :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
$c- :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
- :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
$c* :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
* :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
$cnegate :: FailIfLessMem -> FailIfLessMem
negate :: FailIfLessMem -> FailIfLessMem
$cabs :: FailIfLessMem -> FailIfLessMem
abs :: FailIfLessMem -> FailIfLessMem
$csignum :: FailIfLessMem -> FailIfLessMem
signum :: FailIfLessMem -> FailIfLessMem
$cfromInteger :: Integer -> FailIfLessMem
fromInteger :: Integer -> FailIfLessMem
Num
    , -- | @since WIP
      Num FailIfLessMem
Num FailIfLessMem =>
(FailIfLessMem -> FailIfLessMem -> FailIfLessMem)
-> (FailIfLessMem -> FailIfLessMem)
-> (Rational -> FailIfLessMem)
-> Fractional FailIfLessMem
Rational -> FailIfLessMem
FailIfLessMem -> FailIfLessMem
FailIfLessMem -> FailIfLessMem -> FailIfLessMem
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
/ :: FailIfLessMem -> FailIfLessMem -> FailIfLessMem
$crecip :: FailIfLessMem -> FailIfLessMem
recip :: FailIfLessMem -> FailIfLessMem
$cfromRational :: Rational -> FailIfLessMem
fromRational :: Rational -> FailIfLessMem
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfLessMem where
  defaultValue :: FailIfLessMem
defaultValue = Double -> FailIfLessMem
FailIfLessMem (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfLessMem
parseValue = (Double -> FailIfLessMem) -> Maybe Double -> Maybe FailIfLessMem
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfLessMem
FailIfLessMem (Maybe Double -> Maybe FailIfLessMem)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfLessMem
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfLessMem TestName
optionName = TestName -> Tagged @Type FailIfLessMem TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-less-mem"
  optionHelp :: Tagged @Type FailIfLessMem TestName
optionHelp = TestName -> Tagged @Type FailIfLessMem TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark uses unacceptably less MEM than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype FailIfBigger = FailIfBigger Double
  deriving stock
    ( -- | @since WIP
      FailIfBigger -> FailIfBigger -> Bool
(FailIfBigger -> FailIfBigger -> Bool)
-> (FailIfBigger -> FailIfBigger -> Bool) -> Eq FailIfBigger
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfBigger -> FailIfBigger -> Bool
== :: FailIfBigger -> FailIfBigger -> Bool
$c/= :: FailIfBigger -> FailIfBigger -> Bool
/= :: FailIfBigger -> FailIfBigger -> Bool
Eq
    , -- | @since WIP
      Eq FailIfBigger
Eq FailIfBigger =>
(FailIfBigger -> FailIfBigger -> Ordering)
-> (FailIfBigger -> FailIfBigger -> Bool)
-> (FailIfBigger -> FailIfBigger -> Bool)
-> (FailIfBigger -> FailIfBigger -> Bool)
-> (FailIfBigger -> FailIfBigger -> Bool)
-> (FailIfBigger -> FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger -> FailIfBigger)
-> Ord FailIfBigger
FailIfBigger -> FailIfBigger -> Bool
FailIfBigger -> FailIfBigger -> Ordering
FailIfBigger -> FailIfBigger -> FailIfBigger
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfBigger -> FailIfBigger -> Ordering
compare :: FailIfBigger -> FailIfBigger -> Ordering
$c< :: FailIfBigger -> FailIfBigger -> Bool
< :: FailIfBigger -> FailIfBigger -> Bool
$c<= :: FailIfBigger -> FailIfBigger -> Bool
<= :: FailIfBigger -> FailIfBigger -> Bool
$c> :: FailIfBigger -> FailIfBigger -> Bool
> :: FailIfBigger -> FailIfBigger -> Bool
$c>= :: FailIfBigger -> FailIfBigger -> Bool
>= :: FailIfBigger -> FailIfBigger -> Bool
$cmax :: FailIfBigger -> FailIfBigger -> FailIfBigger
max :: FailIfBigger -> FailIfBigger -> FailIfBigger
$cmin :: FailIfBigger -> FailIfBigger -> FailIfBigger
min :: FailIfBigger -> FailIfBigger -> FailIfBigger
Ord
    , -- | @since WIP
      Key -> FailIfBigger -> TestName -> TestName
[FailIfBigger] -> TestName -> TestName
FailIfBigger -> TestName
(Key -> FailIfBigger -> TestName -> TestName)
-> (FailIfBigger -> TestName)
-> ([FailIfBigger] -> TestName -> TestName)
-> Show FailIfBigger
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfBigger -> TestName -> TestName
showsPrec :: Key -> FailIfBigger -> TestName -> TestName
$cshow :: FailIfBigger -> TestName
show :: FailIfBigger -> TestName
$cshowList :: [FailIfBigger] -> TestName -> TestName
showList :: [FailIfBigger] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfBigger]
ReadPrec FailIfBigger
Key -> ReadS FailIfBigger
ReadS [FailIfBigger]
(Key -> ReadS FailIfBigger)
-> ReadS [FailIfBigger]
-> ReadPrec FailIfBigger
-> ReadPrec [FailIfBigger]
-> Read FailIfBigger
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfBigger
readsPrec :: Key -> ReadS FailIfBigger
$creadList :: ReadS [FailIfBigger]
readList :: ReadS [FailIfBigger]
$creadPrec :: ReadPrec FailIfBigger
readPrec :: ReadPrec FailIfBigger
$creadListPrec :: ReadPrec [FailIfBigger]
readListPrec :: ReadPrec [FailIfBigger]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfBigger
FailIfBigger -> FailIfBigger
FailIfBigger -> FailIfBigger -> FailIfBigger
(FailIfBigger -> FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger)
-> (Integer -> FailIfBigger)
-> Num FailIfBigger
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfBigger -> FailIfBigger -> FailIfBigger
+ :: FailIfBigger -> FailIfBigger -> FailIfBigger
$c- :: FailIfBigger -> FailIfBigger -> FailIfBigger
- :: FailIfBigger -> FailIfBigger -> FailIfBigger
$c* :: FailIfBigger -> FailIfBigger -> FailIfBigger
* :: FailIfBigger -> FailIfBigger -> FailIfBigger
$cnegate :: FailIfBigger -> FailIfBigger
negate :: FailIfBigger -> FailIfBigger
$cabs :: FailIfBigger -> FailIfBigger
abs :: FailIfBigger -> FailIfBigger
$csignum :: FailIfBigger -> FailIfBigger
signum :: FailIfBigger -> FailIfBigger
$cfromInteger :: Integer -> FailIfBigger
fromInteger :: Integer -> FailIfBigger
Num
    , -- | @since WIP
      Num FailIfBigger
Num FailIfBigger =>
(FailIfBigger -> FailIfBigger -> FailIfBigger)
-> (FailIfBigger -> FailIfBigger)
-> (Rational -> FailIfBigger)
-> Fractional FailIfBigger
Rational -> FailIfBigger
FailIfBigger -> FailIfBigger
FailIfBigger -> FailIfBigger -> FailIfBigger
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfBigger -> FailIfBigger -> FailIfBigger
/ :: FailIfBigger -> FailIfBigger -> FailIfBigger
$crecip :: FailIfBigger -> FailIfBigger
recip :: FailIfBigger -> FailIfBigger
$cfromRational :: Rational -> FailIfBigger
fromRational :: Rational -> FailIfBigger
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfBigger where
  defaultValue :: FailIfBigger
defaultValue = Double -> FailIfBigger
FailIfBigger (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfBigger
parseValue = (Double -> FailIfBigger) -> Maybe Double -> Maybe FailIfBigger
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfBigger
FailIfBigger (Maybe Double -> Maybe FailIfBigger)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfBigger
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfBigger TestName
optionName = TestName -> Tagged @Type FailIfBigger TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-bigger"
  optionHelp :: Tagged @Type FailIfBigger TestName
optionHelp = TestName -> Tagged @Type FailIfBigger TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark is unacceptably bigger than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype FailIfSmaller = FailIfSmaller Double
  deriving stock
    ( -- | @since WIP
      FailIfSmaller -> FailIfSmaller -> Bool
(FailIfSmaller -> FailIfSmaller -> Bool)
-> (FailIfSmaller -> FailIfSmaller -> Bool) -> Eq FailIfSmaller
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FailIfSmaller -> FailIfSmaller -> Bool
== :: FailIfSmaller -> FailIfSmaller -> Bool
$c/= :: FailIfSmaller -> FailIfSmaller -> Bool
/= :: FailIfSmaller -> FailIfSmaller -> Bool
Eq
    , -- | @since WIP
      Eq FailIfSmaller
Eq FailIfSmaller =>
(FailIfSmaller -> FailIfSmaller -> Ordering)
-> (FailIfSmaller -> FailIfSmaller -> Bool)
-> (FailIfSmaller -> FailIfSmaller -> Bool)
-> (FailIfSmaller -> FailIfSmaller -> Bool)
-> (FailIfSmaller -> FailIfSmaller -> Bool)
-> (FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> Ord FailIfSmaller
FailIfSmaller -> FailIfSmaller -> Bool
FailIfSmaller -> FailIfSmaller -> Ordering
FailIfSmaller -> FailIfSmaller -> FailIfSmaller
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: FailIfSmaller -> FailIfSmaller -> Ordering
compare :: FailIfSmaller -> FailIfSmaller -> Ordering
$c< :: FailIfSmaller -> FailIfSmaller -> Bool
< :: FailIfSmaller -> FailIfSmaller -> Bool
$c<= :: FailIfSmaller -> FailIfSmaller -> Bool
<= :: FailIfSmaller -> FailIfSmaller -> Bool
$c> :: FailIfSmaller -> FailIfSmaller -> Bool
> :: FailIfSmaller -> FailIfSmaller -> Bool
$c>= :: FailIfSmaller -> FailIfSmaller -> Bool
>= :: FailIfSmaller -> FailIfSmaller -> Bool
$cmax :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
max :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
$cmin :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
min :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
Ord
    , -- | @since WIP
      Key -> FailIfSmaller -> TestName -> TestName
[FailIfSmaller] -> TestName -> TestName
FailIfSmaller -> TestName
(Key -> FailIfSmaller -> TestName -> TestName)
-> (FailIfSmaller -> TestName)
-> ([FailIfSmaller] -> TestName -> TestName)
-> Show FailIfSmaller
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> FailIfSmaller -> TestName -> TestName
showsPrec :: Key -> FailIfSmaller -> TestName -> TestName
$cshow :: FailIfSmaller -> TestName
show :: FailIfSmaller -> TestName
$cshowList :: [FailIfSmaller] -> TestName -> TestName
showList :: [FailIfSmaller] -> TestName -> TestName
Show
    , -- | @since WIP
      ReadPrec [FailIfSmaller]
ReadPrec FailIfSmaller
Key -> ReadS FailIfSmaller
ReadS [FailIfSmaller]
(Key -> ReadS FailIfSmaller)
-> ReadS [FailIfSmaller]
-> ReadPrec FailIfSmaller
-> ReadPrec [FailIfSmaller]
-> Read FailIfSmaller
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS FailIfSmaller
readsPrec :: Key -> ReadS FailIfSmaller
$creadList :: ReadS [FailIfSmaller]
readList :: ReadS [FailIfSmaller]
$creadPrec :: ReadPrec FailIfSmaller
readPrec :: ReadPrec FailIfSmaller
$creadListPrec :: ReadPrec [FailIfSmaller]
readListPrec :: ReadPrec [FailIfSmaller]
Read
    )
  deriving
    ( -- | @since WIP
      Integer -> FailIfSmaller
FailIfSmaller -> FailIfSmaller
FailIfSmaller -> FailIfSmaller -> FailIfSmaller
(FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller)
-> (Integer -> FailIfSmaller)
-> Num FailIfSmaller
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
+ :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
$c- :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
- :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
$c* :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
* :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
$cnegate :: FailIfSmaller -> FailIfSmaller
negate :: FailIfSmaller -> FailIfSmaller
$cabs :: FailIfSmaller -> FailIfSmaller
abs :: FailIfSmaller -> FailIfSmaller
$csignum :: FailIfSmaller -> FailIfSmaller
signum :: FailIfSmaller -> FailIfSmaller
$cfromInteger :: Integer -> FailIfSmaller
fromInteger :: Integer -> FailIfSmaller
Num
    , -- | @since WIP
      Num FailIfSmaller
Num FailIfSmaller =>
(FailIfSmaller -> FailIfSmaller -> FailIfSmaller)
-> (FailIfSmaller -> FailIfSmaller)
-> (Rational -> FailIfSmaller)
-> Fractional FailIfSmaller
Rational -> FailIfSmaller
FailIfSmaller -> FailIfSmaller
FailIfSmaller -> FailIfSmaller -> FailIfSmaller
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
/ :: FailIfSmaller -> FailIfSmaller -> FailIfSmaller
$crecip :: FailIfSmaller -> FailIfSmaller
recip :: FailIfSmaller -> FailIfSmaller
$cfromRational :: Rational -> FailIfSmaller
fromRational :: Rational -> FailIfSmaller
Fractional
    )
    via Double

-- | @since WIP
instance IsOption FailIfSmaller where
  defaultValue :: FailIfSmaller
defaultValue = Double -> FailIfSmaller
FailIfSmaller (Double
1.0 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
0.0)
  parseValue :: TestName -> Maybe FailIfSmaller
parseValue = (Double -> FailIfSmaller) -> Maybe Double -> Maybe FailIfSmaller
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> FailIfSmaller
FailIfSmaller (Maybe Double -> Maybe FailIfSmaller)
-> (TestName -> Maybe Double) -> TestName -> Maybe FailIfSmaller
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Maybe Double
parsePositivePercents
  optionName :: Tagged @Type FailIfSmaller TestName
optionName = TestName -> Tagged @Type FailIfSmaller TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"fail-if-smaller"
  optionHelp :: Tagged @Type FailIfSmaller TestName
optionHelp = TestName -> Tagged @Type FailIfSmaller TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"If a benchmark is unacceptably smaller than baseline (see --baseline), it will be reported as failed."

-- | @since WIP
newtype BaselinePath = BaselinePath FilePath
  deriving stock
    ( -- | @since WIP
      BaselinePath -> BaselinePath -> Bool
(BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool) -> Eq BaselinePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BaselinePath -> BaselinePath -> Bool
== :: BaselinePath -> BaselinePath -> Bool
$c/= :: BaselinePath -> BaselinePath -> Bool
/= :: BaselinePath -> BaselinePath -> Bool
Eq
    , -- | @since WIP
      Eq BaselinePath
Eq BaselinePath =>
(BaselinePath -> BaselinePath -> Ordering)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> Bool)
-> (BaselinePath -> BaselinePath -> BaselinePath)
-> (BaselinePath -> BaselinePath -> BaselinePath)
-> Ord BaselinePath
BaselinePath -> BaselinePath -> Bool
BaselinePath -> BaselinePath -> Ordering
BaselinePath -> BaselinePath -> BaselinePath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: BaselinePath -> BaselinePath -> Ordering
compare :: BaselinePath -> BaselinePath -> Ordering
$c< :: BaselinePath -> BaselinePath -> Bool
< :: BaselinePath -> BaselinePath -> Bool
$c<= :: BaselinePath -> BaselinePath -> Bool
<= :: BaselinePath -> BaselinePath -> Bool
$c> :: BaselinePath -> BaselinePath -> Bool
> :: BaselinePath -> BaselinePath -> Bool
$c>= :: BaselinePath -> BaselinePath -> Bool
>= :: BaselinePath -> BaselinePath -> Bool
$cmax :: BaselinePath -> BaselinePath -> BaselinePath
max :: BaselinePath -> BaselinePath -> BaselinePath
$cmin :: BaselinePath -> BaselinePath -> BaselinePath
min :: BaselinePath -> BaselinePath -> BaselinePath
Ord
    )

-- | @since WIP
instance IsOption (Maybe BaselinePath) where
  defaultValue :: Maybe BaselinePath
defaultValue = Maybe BaselinePath
forall a. Maybe a
Nothing
  parseValue :: TestName -> Maybe (Maybe BaselinePath)
parseValue = Maybe BaselinePath -> Maybe (Maybe BaselinePath)
forall a. a -> Maybe a
Just (Maybe BaselinePath -> Maybe (Maybe BaselinePath))
-> (TestName -> Maybe BaselinePath)
-> TestName
-> Maybe (Maybe BaselinePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BaselinePath -> Maybe BaselinePath
forall a. a -> Maybe a
Just (BaselinePath -> Maybe BaselinePath)
-> (TestName -> BaselinePath) -> TestName -> Maybe BaselinePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> BaselinePath
BaselinePath
  optionName :: Tagged @Type (Maybe BaselinePath) TestName
optionName = TestName -> Tagged @Type (Maybe BaselinePath) TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"baseline"
  optionHelp :: Tagged @Type (Maybe BaselinePath) TestName
optionHelp = TestName -> Tagged @Type (Maybe BaselinePath) TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"File with baseline results in CSV format to compare against"

-- | @since WIP
newtype CsvPath = CsvPath FilePath
  deriving stock
    ( -- | @since WIP
      CsvPath -> CsvPath -> Bool
(CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool) -> Eq CsvPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CsvPath -> CsvPath -> Bool
== :: CsvPath -> CsvPath -> Bool
$c/= :: CsvPath -> CsvPath -> Bool
/= :: CsvPath -> CsvPath -> Bool
Eq
    , -- | @since WIP
      Eq CsvPath
Eq CsvPath =>
(CsvPath -> CsvPath -> Ordering)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> Bool)
-> (CsvPath -> CsvPath -> CsvPath)
-> (CsvPath -> CsvPath -> CsvPath)
-> Ord CsvPath
CsvPath -> CsvPath -> Bool
CsvPath -> CsvPath -> Ordering
CsvPath -> CsvPath -> CsvPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CsvPath -> CsvPath -> Ordering
compare :: CsvPath -> CsvPath -> Ordering
$c< :: CsvPath -> CsvPath -> Bool
< :: CsvPath -> CsvPath -> Bool
$c<= :: CsvPath -> CsvPath -> Bool
<= :: CsvPath -> CsvPath -> Bool
$c> :: CsvPath -> CsvPath -> Bool
> :: CsvPath -> CsvPath -> Bool
$c>= :: CsvPath -> CsvPath -> Bool
>= :: CsvPath -> CsvPath -> Bool
$cmax :: CsvPath -> CsvPath -> CsvPath
max :: CsvPath -> CsvPath -> CsvPath
$cmin :: CsvPath -> CsvPath -> CsvPath
min :: CsvPath -> CsvPath -> CsvPath
Ord
    )

-- | @since WIP
instance IsOption (Maybe CsvPath) where
  defaultValue :: Maybe CsvPath
defaultValue = Maybe CsvPath
forall a. Maybe a
Nothing
  parseValue :: TestName -> Maybe (Maybe CsvPath)
parseValue = Maybe CsvPath -> Maybe (Maybe CsvPath)
forall a. a -> Maybe a
Just (Maybe CsvPath -> Maybe (Maybe CsvPath))
-> (TestName -> Maybe CsvPath) -> TestName -> Maybe (Maybe CsvPath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CsvPath -> Maybe CsvPath
forall a. a -> Maybe a
Just (CsvPath -> Maybe CsvPath)
-> (TestName -> CsvPath) -> TestName -> Maybe CsvPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> CsvPath
CsvPath
  optionName :: Tagged @Type (Maybe CsvPath) TestName
optionName = TestName -> Tagged @Type (Maybe CsvPath) TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"csv"
  optionHelp :: Tagged @Type (Maybe CsvPath) TestName
optionHelp = TestName -> Tagged @Type (Maybe CsvPath) TestName
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged TestName
"File to write results in CSV format"

-- * Internals

-- Most of this code is from `tasty-bench`

modifyConsoleReporter ::
  [OptionDescription] ->
  (OptionSet -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result)) ->
  Ingredient
modifyConsoleReporter :: [OptionDescription]
-> (OptionSet
    -> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result))
-> Ingredient
modifyConsoleReporter [OptionDescription]
desc' OptionSet
-> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result)
iof = [OptionDescription]
-> (OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
TestReporter ([OptionDescription]
desc [OptionDescription] -> [OptionDescription] -> [OptionDescription]
forall a. [a] -> [a] -> [a]
++ [OptionDescription]
desc') ((OptionSet
  -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
 -> Ingredient)
-> (OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
-> Ingredient
forall a b. (a -> b) -> a -> b
$ \OptionSet
opts TestTree
tree ->
  let nameSeqs :: IntMap (Seq TestName)
nameSeqs = [(Key, Seq TestName)] -> IntMap (Seq TestName)
forall a. [(Key, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Key, Seq TestName)] -> IntMap (Seq TestName))
-> [(Key, Seq TestName)] -> IntMap (Seq TestName)
forall a b. (a -> b) -> a -> b
$ [Key] -> [Seq TestName] -> [(Key, Seq TestName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
Item [Key]
0 ..] ([Seq TestName] -> [(Key, Seq TestName)])
-> [Seq TestName] -> [(Key, Seq TestName)]
forall a b. (a -> b) -> a -> b
$ OptionSet -> TestTree -> [Seq TestName]
testNameSeqs OptionSet
opts TestTree
tree
      namesAndDeps :: IntMap (TestName, Unique (WithLoHi Key))
namesAndDeps =
        [(Key, (TestName, Unique (WithLoHi Key)))]
-> IntMap (TestName, Unique (WithLoHi Key))
forall a. [(Key, a)] -> IntMap a
IntMap.fromDistinctAscList ([(Key, (TestName, Unique (WithLoHi Key)))]
 -> IntMap (TestName, Unique (WithLoHi Key)))
-> [(Key, (TestName, Unique (WithLoHi Key)))]
-> IntMap (TestName, Unique (WithLoHi Key))
forall a b. (a -> b) -> a -> b
$
          [Key]
-> [(TestName, Unique (WithLoHi Key))]
-> [(Key, (TestName, Unique (WithLoHi Key)))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Key
Item [Key]
0 ..] ([(TestName, Unique (WithLoHi Key))]
 -> [(Key, (TestName, Unique (WithLoHi Key)))])
-> [(TestName, Unique (WithLoHi Key))]
-> [(Key, (TestName, Unique (WithLoHi Key)))]
forall a b. (a -> b) -> a -> b
$
            IntMap (Seq TestName)
-> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi Key))]
testNamesAndDeps IntMap (Seq TestName)
nameSeqs OptionSet
opts TestTree
tree
      modifySMap :: StatusMap -> IO StatusMap
modifySMap =
        (OptionSet
-> IO (TestName -> Unique (WithLoHi Result) -> Result -> Result)
iof OptionSet
opts >>=)
          (((TestName -> Unique (WithLoHi Result) -> Result -> Result)
  -> IO StatusMap)
 -> IO StatusMap)
-> (StatusMap
    -> (TestName -> Unique (WithLoHi Result) -> Result -> Result)
    -> IO StatusMap)
-> StatusMap
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TestName -> Unique (WithLoHi Result) -> Result -> Result)
 -> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
 -> IO StatusMap)
-> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
-> (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IO StatusMap
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
-> IO StatusMap
postprocessResult
          (IntMap (TestName, Unique (WithLoHi Key), TVar Status)
 -> (TestName -> Unique (WithLoHi Result) -> Result -> Result)
 -> IO StatusMap)
-> (StatusMap
    -> IntMap (TestName, Unique (WithLoHi Key), TVar Status))
-> StatusMap
-> (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IO StatusMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TestName, Unique (WithLoHi Key))
 -> TVar Status -> (TestName, Unique (WithLoHi Key), TVar Status))
-> IntMap (TestName, Unique (WithLoHi Key))
-> StatusMap
-> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IntMap.intersectionWith (\(TestName
a, Unique (WithLoHi Key)
b) TVar Status
c -> (TestName
a, Unique (WithLoHi Key)
b, TVar Status
c)) IntMap (TestName, Unique (WithLoHi Key))
namesAndDeps
   in (StatusMap -> IO StatusMap
modifySMap >=>) ((StatusMap -> IO (Double -> IO Bool))
 -> StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
-> Maybe (StatusMap -> IO (Double -> IO Bool))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb OptionSet
opts TestTree
tree
  where
    ([OptionDescription]
desc, OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool))
cb) = case Ingredient
consoleTestReporter of
      TestReporter [OptionDescription]
d OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool))
c -> ([OptionDescription]
d, OptionSet
-> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool))
c)
      Ingredient
_ -> TestName
-> ([OptionDescription],
    OptionSet
    -> TestTree -> Maybe (StatusMap -> IO (Double -> IO Bool)))
forall a. HasCallStack => TestName -> a
error TestName
"modifyConsoleReporter: consoleTestReporter must be TestReporter"

data ExecutionBudget = ExecutionBudget Integer Integer Integer
  deriving stock (Key -> ExecutionBudget -> TestName -> TestName
[ExecutionBudget] -> TestName -> TestName
ExecutionBudget -> TestName
(Key -> ExecutionBudget -> TestName -> TestName)
-> (ExecutionBudget -> TestName)
-> ([ExecutionBudget] -> TestName -> TestName)
-> Show ExecutionBudget
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Key -> ExecutionBudget -> TestName -> TestName
showsPrec :: Key -> ExecutionBudget -> TestName -> TestName
$cshow :: ExecutionBudget -> TestName
show :: ExecutionBudget -> TestName
$cshowList :: [ExecutionBudget] -> TestName -> TestName
showList :: [ExecutionBudget] -> TestName -> TestName
Show, ReadPrec [ExecutionBudget]
ReadPrec ExecutionBudget
Key -> ReadS ExecutionBudget
ReadS [ExecutionBudget]
(Key -> ReadS ExecutionBudget)
-> ReadS [ExecutionBudget]
-> ReadPrec ExecutionBudget
-> ReadPrec [ExecutionBudget]
-> Read ExecutionBudget
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Key -> ReadS ExecutionBudget
readsPrec :: Key -> ReadS ExecutionBudget
$creadList :: ReadS [ExecutionBudget]
readList :: ReadS [ExecutionBudget]
$creadPrec :: ReadPrec ExecutionBudget
readPrec :: ReadPrec ExecutionBudget
$creadListPrec :: ReadPrec [ExecutionBudget]
readListPrec :: ReadPrec [ExecutionBudget]
Read)

data WithLoHi a
  = WithLoHi
      !a -- payload
      !(Double, Double) -- cpu
      !(Double, Double) -- mem
      !(Double, Double) -- size
  deriving stock (Key -> WithLoHi a -> TestName -> TestName
[WithLoHi a] -> TestName -> TestName
WithLoHi a -> TestName
(Key -> WithLoHi a -> TestName -> TestName)
-> (WithLoHi a -> TestName)
-> ([WithLoHi a] -> TestName -> TestName)
-> Show (WithLoHi a)
forall a. Show a => Key -> WithLoHi a -> TestName -> TestName
forall a. Show a => [WithLoHi a] -> TestName -> TestName
forall a. Show a => WithLoHi a -> TestName
forall a.
(Key -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: forall a. Show a => Key -> WithLoHi a -> TestName -> TestName
showsPrec :: Key -> WithLoHi a -> TestName -> TestName
$cshow :: forall a. Show a => WithLoHi a -> TestName
show :: WithLoHi a -> TestName
$cshowList :: forall a. Show a => [WithLoHi a] -> TestName -> TestName
showList :: [WithLoHi a] -> TestName -> TestName
Show, ReadPrec [WithLoHi a]
ReadPrec (WithLoHi a)
Key -> ReadS (WithLoHi a)
ReadS [WithLoHi a]
(Key -> ReadS (WithLoHi a))
-> ReadS [WithLoHi a]
-> ReadPrec (WithLoHi a)
-> ReadPrec [WithLoHi a]
-> Read (WithLoHi a)
forall a. Read a => ReadPrec [WithLoHi a]
forall a. Read a => ReadPrec (WithLoHi a)
forall a. Read a => Key -> ReadS (WithLoHi a)
forall a. Read a => ReadS [WithLoHi a]
forall a.
(Key -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Key -> ReadS (WithLoHi a)
readsPrec :: Key -> ReadS (WithLoHi a)
$creadList :: forall a. Read a => ReadS [WithLoHi a]
readList :: ReadS [WithLoHi a]
$creadPrec :: forall a. Read a => ReadPrec (WithLoHi a)
readPrec :: ReadPrec (WithLoHi a)
$creadListPrec :: forall a. Read a => ReadPrec [WithLoHi a]
readListPrec :: ReadPrec [WithLoHi a]
Read)

data PBenchmarkable where
  PBenchmarkable :: BenchConfig -> ClosedTerm a -> PBenchmarkable

instance IsTest PBenchmarkable where
  testOptions :: Tagged @Type PBenchmarkable [OptionDescription]
testOptions =
    [OptionDescription]
-> Tagged @Type PBenchmarkable [OptionDescription]
forall {k} (s :: k) b. b -> Tagged @k s b
Tagged
      [ Proxy @Type FailIfMoreCpu -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfMoreCpu
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfMoreCpu)
      , Proxy @Type FailIfLessCpu -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfLessCpu
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfLessCpu)
      , Proxy @Type FailIfMoreMem -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfMoreMem
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfMoreMem)
      , Proxy @Type FailIfLessMem -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfLessMem
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfLessMem)
      , Proxy @Type FailIfBigger -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfBigger
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfBigger)
      , Proxy @Type FailIfSmaller -> OptionDescription
forall v. IsOption v => Proxy @Type v -> OptionDescription
Option (Proxy @Type FailIfSmaller
forall {k} (t :: k). Proxy @k t
Proxy :: Proxy FailIfSmaller)
      ]
  run :: OptionSet -> PBenchmarkable -> (Progress -> IO ()) -> IO Result
run OptionSet
opts (PBenchmarkable BenchConfig
config ClosedTerm a
term) Progress -> IO ()
_progress =
    case Either Text Script
compiled of
      Left Text
err -> Result -> IO Result
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TestName -> Result
testFailed (TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile term: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
      Right Script
script ->
        case Script
-> (Either
      (CekEvaluationException NamedDeBruijn DefaultUni DefaultFun)
      Script,
    ExBudget, [Text])
evalScriptUnlimited Script
script of
          (Left CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err, ExBudget
_, [Text]
_) -> Result -> IO Result
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TestName -> Result
testFailed (TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to evaluate term: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
-> TestName
forall a. Show a => a -> TestName
show CekEvaluationException NamedDeBruijn DefaultUni DefaultFun
err
          (Right Script
_, ExBudget (ExCPU CostingInteger
cpu) (ExMemory CostingInteger
mem), [Text]
_) ->
            Result -> IO Result
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$
              TestName -> Result
testPassed (TestName -> Result) -> TestName -> Result
forall a b. (a -> b) -> a -> b
$
                WithLoHi ExecutionBudget -> TestName
forall a. Show a => a -> TestName
show (WithLoHi ExecutionBudget -> TestName)
-> WithLoHi ExecutionBudget -> TestName
forall a b. (a -> b) -> a -> b
$
                  ExecutionBudget
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi ExecutionBudget
forall a.
a
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi a
WithLoHi
                    (Integer -> Integer -> Integer -> ExecutionBudget
ExecutionBudget (CostingInteger -> Integer
forall a. Num a => CostingInteger -> a
fromSatInt CostingInteger
cpu) (CostingInteger -> Integer
forall a. Num a => CostingInteger -> a
fromSatInt CostingInteger
mem) (Script -> Integer
scriptSize Script
script))
                    (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ifLessCpu, Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ifMoreCpu)
                    (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ifLessMem, Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ifMoreMem)
                    (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ifSmaller, Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ifBigger)
    where
      compiled :: Either Text Script
compiled =
        case BenchConfig
config of
          BenchConfig
Optimizing -> ClosedTerm a -> Either Text Script
forall (a :: PType).
(forall (s :: S). Term s a) -> Either Text Script
compileOptimized Term s a
ClosedTerm a
term
          NonOptimizing Config
pconfig -> Config -> ClosedTerm a -> Either Text Script
forall (a :: PType). Config -> ClosedTerm a -> Either Text Script
compile Config
pconfig Term s a
ClosedTerm a
term

      FailIfLessCpu Double
ifLessCpu = OptionSet -> FailIfLessCpu
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      FailIfMoreCpu Double
ifMoreCpu = OptionSet -> FailIfMoreCpu
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      FailIfLessMem Double
ifLessMem = OptionSet -> FailIfLessMem
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      FailIfMoreMem Double
ifMoreMem = OptionSet -> FailIfMoreMem
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      FailIfBigger Double
ifBigger = OptionSet -> FailIfBigger
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts
      FailIfSmaller Double
ifSmaller = OptionSet -> FailIfSmaller
forall v. IsOption v => OptionSet -> v
lookupOption OptionSet
opts

data Unique a = None | Unique !a | NotUnique | NotProvided
  deriving stock ((forall a b. (a -> b) -> Unique a -> Unique b)
-> (forall a b. a -> Unique b -> Unique a) -> Functor Unique
forall a b. a -> Unique b -> Unique a
forall a b. (a -> b) -> Unique a -> Unique b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Unique a -> Unique b
fmap :: forall a b. (a -> b) -> Unique a -> Unique b
$c<$ :: forall a b. a -> Unique b -> Unique a
<$ :: forall a b. a -> Unique b -> Unique a
Functor)

instance Semigroup (Unique a) where
  Unique a
a <> :: Unique a -> Unique a -> Unique a
<> Unique a
NotProvided = Unique a
a
  Unique a
NotProvided <> Unique a
a = Unique a
a
  Unique a
a <> Unique a
None = Unique a
a
  Unique a
None <> Unique a
a = Unique a
a
  Unique a
_ <> Unique a
_ = Unique a
forall a. Unique a
NotUnique

instance Monoid (Unique a) where
  mempty :: Unique a
mempty = Unique a
forall a. Unique a
NotProvided
  mappend :: Unique a -> Unique a -> Unique a
mappend = Unique a -> Unique a -> Unique a
forall a. Semigroup a => a -> a -> a
(<>)

-- | Convert a test tree to a list of test names.
testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]
testNameSeqs :: OptionSet -> TestTree -> [Seq TestName]
testNameSeqs =
  TreeFold [Seq TestName] -> OptionSet -> TestTree -> [Seq TestName]
forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
foldTestTree
    TreeFold [Seq TestName]
forall b. Monoid b => TreeFold b
trivialFold
      { foldSingle = const $ const . (: []) . Seq.singleton
      , foldGroup = const $ (. concat) . map . (<|)
      }

testNamesAndDeps :: IntMap (Seq TestName) -> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi IntMap.Key))]
testNamesAndDeps :: IntMap (Seq TestName)
-> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi Key))]
testNamesAndDeps IntMap (Seq TestName)
im =
  TreeFold [(TestName, Unique (WithLoHi Key))]
-> OptionSet -> TestTree -> [(TestName, Unique (WithLoHi Key))]
forall b. Monoid b => TreeFold b -> OptionSet -> TestTree -> b
foldTestTree
    TreeFold [(TestName, Unique (WithLoHi Key))]
forall b. Monoid b => TreeFold b
trivialFold
      { foldSingle = const $ const . (: []) . (,NotProvided)
      , foldGroup = const $ (. concat) . map . first . (++) . (++ ".")
      , foldAfter = const foldDeps
      }
  where
    foldDeps :: DependencyType -> Expr -> [(a, Unique (WithLoHi IntMap.Key))] -> [(a, Unique (WithLoHi IntMap.Key))]
    foldDeps :: forall a.
DependencyType
-> Expr
-> [(a, Unique (WithLoHi Key))]
-> [(a, Unique (WithLoHi Key))]
foldDeps DependencyType
AllSucceed (And (StringLit TestName
xs) Expr
p)
      | TestName
pbcomparePrefix TestName -> TestName -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` TestName
xs
      , Just (WithLoHi () (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size) <- TestName -> Maybe (WithLoHi ())
forall a. Read a => TestName -> Maybe a
safeRead (TestName -> Maybe (WithLoHi ()))
-> TestName -> Maybe (WithLoHi ())
forall a b. (a -> b) -> a -> b
$ Key -> TestName -> TestName
forall a. Key -> [a] -> [a]
drop (TestName -> Key
forall a. [a] -> Key
forall (t :: Type -> Type) a. Foldable t => t a -> Key
length TestName
pbcomparePrefix) TestName
xs =
          ((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))]
forall a b. (a -> b) -> [a] -> [b]
map (((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
 -> [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))])
-> ((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> [(a, Unique (WithLoHi Key))]
-> [(a, Unique (WithLoHi Key))]
forall a b. (a -> b) -> a -> b
$ (Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((Unique (WithLoHi Key) -> Unique (WithLoHi Key))
 -> (a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> (Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key))
forall a b. (a -> b) -> a -> b
$ Unique (WithLoHi Key)
-> Unique (WithLoHi Key) -> Unique (WithLoHi Key)
forall a. Monoid a => a -> a -> a
mappend (Unique (WithLoHi Key)
 -> Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> Unique (WithLoHi Key)
-> Unique (WithLoHi Key)
-> Unique (WithLoHi Key)
forall a b. (a -> b) -> a -> b
$ (\Key
x -> Key
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi Key
forall a.
a
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi a
WithLoHi Key
x (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size) (Key -> WithLoHi Key) -> Unique Key -> Unique (WithLoHi Key)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> IntMap (Seq TestName) -> Expr -> Unique Key
findMatchingKeys IntMap (Seq TestName)
im Expr
p
    foldDeps DependencyType
_ Expr
_ = ((a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key)))
-> [(a, Unique (WithLoHi Key))] -> [(a, Unique (WithLoHi Key))]
forall a b. (a -> b) -> [a] -> [b]
map ((Unique (WithLoHi Key) -> Unique (WithLoHi Key))
-> (a, Unique (WithLoHi Key)) -> (a, Unique (WithLoHi Key))
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: Type -> Type -> Type) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Unique (WithLoHi Key)
-> Unique (WithLoHi Key) -> Unique (WithLoHi Key)
forall a b. a -> b -> a
const Unique (WithLoHi Key)
forall a. Unique a
NotProvided))

pbcomparePrefix :: String
pbcomparePrefix :: TestName
pbcomparePrefix = TestName
"plutarch-bench"

findMatchingKeys :: IntMap (Seq TestName) -> Expr -> Unique IntMap.Key
findMatchingKeys :: IntMap (Seq TestName) -> Expr -> Unique Key
findMatchingKeys IntMap (Seq TestName)
im Expr
p =
  ((Key, Seq TestName) -> Unique Key)
-> [(Key, Seq TestName)] -> Unique Key
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Key
k, Seq TestName
v) -> if Seq TestName -> M Bool -> Either TestName Bool
forall a. Seq TestName -> M a -> Either TestName a
withFields Seq TestName
v M Bool
pat Either TestName Bool -> Either TestName Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Either TestName Bool
forall a b. b -> Either a b
Right Bool
True then Key -> Unique Key
forall a. a -> Unique a
Unique Key
k else Unique Key
forall a. Unique a
None) ([(Key, Seq TestName)] -> Unique Key)
-> [(Key, Seq TestName)] -> Unique Key
forall a b. (a -> b) -> a -> b
$ IntMap (Seq TestName) -> [(Key, Seq TestName)]
forall a. IntMap a -> [(Key, a)]
IntMap.assocs IntMap (Seq TestName)
im
  where
    pat :: M Bool
pat = Expr -> M Value
eval Expr
p M Value -> (Value -> M Bool) -> M Bool
forall a b.
ReaderT (Seq TestName) (Either TestName) a
-> (a -> ReaderT (Seq TestName) (Either TestName) b)
-> ReaderT (Seq TestName) (Either TestName) b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> M Bool
asB

postprocessResult ::
  (TestName -> Unique (WithLoHi Result) -> Result -> Result) ->
  IntMap (TestName, Unique (WithLoHi IntMap.Key), TVar Status) ->
  IO StatusMap
postprocessResult :: (TestName -> Unique (WithLoHi Result) -> Result -> Result)
-> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
-> IO StatusMap
postprocessResult TestName -> Unique (WithLoHi Result) -> Result -> Result
f IntMap (TestName, Unique (WithLoHi Key), TVar Status)
src = do
  IntMap (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
paired <- IntMap (TestName, Unique (WithLoHi Key), TVar Status)
-> ((TestName, Unique (WithLoHi Key), TVar Status)
    -> IO (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
-> IO
     (IntMap
        (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
forall (t :: Type -> Type) (m :: Type -> Type) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM IntMap (TestName, Unique (WithLoHi Key), TVar Status)
src (((TestName, Unique (WithLoHi Key), TVar Status)
  -> IO (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
 -> IO
      (IntMap
         (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)))
-> ((TestName, Unique (WithLoHi Key), TVar Status)
    -> IO (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
-> IO
     (IntMap
        (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
forall a b. (a -> b) -> a -> b
$ \(TestName
name, Unique (WithLoHi Key)
mDepId, TVar Status
tv) -> (TestName
name,Unique (WithLoHi Key)
mDepId,TVar Status
tv,) (TVar Status
 -> (TestName, Unique (WithLoHi Key), TVar Status, TVar Status))
-> IO (TVar Status)
-> IO (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Status -> IO (TVar Status)
forall a. a -> IO (TVar a)
newTVarIO Status
NotStarted
  let doUpdate :: IO Bool
doUpdate = STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ do
        (Any Bool
anyUpdated, All Bool
allDone) <-
          Ap STM (Any, All) -> STM (Any, All)
forall (f :: Type -> Type) a. Ap f a -> f a
getApp (Ap STM (Any, All) -> STM (Any, All))
-> Ap STM (Any, All) -> STM (Any, All)
forall a b. (a -> b) -> a -> b
$ (((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
  -> Ap STM (Any, All))
 -> IntMap
      (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
 -> Ap STM (Any, All))
-> IntMap
     (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
-> ((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
    -> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
 -> Ap STM (Any, All))
-> IntMap
     (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
-> Ap STM (Any, All)
forall m a. Monoid m => (a -> m) -> IntMap a -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap IntMap (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
paired (((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
  -> Ap STM (Any, All))
 -> Ap STM (Any, All))
-> ((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
    -> Ap STM (Any, All))
-> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ \(TestName
name, Unique (WithLoHi Key)
mDepId, TVar Status
newTV, TVar Status
oldTV) -> STM (Any, All) -> Ap STM (Any, All)
forall (f :: Type -> Type) a. f a -> Ap f a
Ap (STM (Any, All) -> Ap STM (Any, All))
-> STM (Any, All) -> Ap STM (Any, All)
forall a b. (a -> b) -> a -> b
$ do
            Status
old <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
oldTV
            case Status
old of
              Done {} -> (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
True)
              Status
_ -> do
                Status
new <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
newTV
                case Status
new of
                  Done Result
res -> do
                    Unique (WithLoHi Result)
depRes <- case Unique (WithLoHi Key)
mDepId of
                      Unique (WithLoHi Key
depId (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size) -> case Key
-> IntMap (TestName, Unique (WithLoHi Key), TVar Status)
-> Maybe (TestName, Unique (WithLoHi Key), TVar Status)
forall a. Key -> IntMap a -> Maybe a
IntMap.lookup Key
depId IntMap (TestName, Unique (WithLoHi Key), TVar Status)
src of
                        Maybe (TestName, Unique (WithLoHi Key), TVar Status)
Nothing -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unique (WithLoHi Result)
forall a. Unique a
None
                        Just (TestName
_, Unique (WithLoHi Key)
_, TVar Status
depTV) -> do
                          Status
depStatus <- TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
depTV
                          case Status
depStatus of
                            Done Result
dep -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result)))
-> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a b. (a -> b) -> a -> b
$ WithLoHi Result -> Unique (WithLoHi Result)
forall a. a -> Unique a
Unique (Result
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi Result
forall a.
a
-> (Double, Double)
-> (Double, Double)
-> (Double, Double)
-> WithLoHi a
WithLoHi Result
dep (Double, Double)
cpu (Double, Double)
mem (Double, Double)
size)
                            Status
_ -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unique (WithLoHi Result)
forall a. Unique a
NotProvided
                      Unique (WithLoHi Key)
None -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unique (WithLoHi Result)
forall a. Unique a
None
                      Unique (WithLoHi Key)
NotUnique -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unique (WithLoHi Result)
forall a. Unique a
NotUnique
                      Unique (WithLoHi Key)
NotProvided -> Unique (WithLoHi Result) -> STM (Unique (WithLoHi Result))
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Unique (WithLoHi Result)
forall a. Unique a
NotProvided
                    TVar Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Result -> Status
Done (TestName -> Unique (WithLoHi Result) -> Result -> Result
f TestName
name Unique (WithLoHi Result)
depRes Result
res))
                    (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
True, Bool -> All
All Bool
True)
                  Executing Progress
newProgr -> do
                    let updated :: Bool
updated = case Status
old of
                          Executing Progress
oldProgr -> Progress
oldProgr Progress -> Progress -> Bool
forall a. Eq a => a -> a -> Bool
/= Progress
newProgr
                          Status
_ -> Bool
True
                    Bool -> STM () -> STM ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
when Bool
updated (STM () -> STM ()) -> STM () -> STM ()
forall a b. (a -> b) -> a -> b
$
                      TVar Status -> Status -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Status
oldTV (Progress -> Status
Executing Progress
newProgr)
                    (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
updated, Bool -> All
All Bool
False)
                  Status
NotStarted -> (Any, All) -> STM (Any, All)
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Bool -> Any
Any Bool
False, Bool -> All
All Bool
False)
        if Bool
anyUpdated Bool -> Bool -> Bool
|| Bool
allDone then Bool -> STM Bool
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
allDone else STM Bool
forall a. STM a
retry
      adNauseam :: IO ()
adNauseam = IO Bool
doUpdate IO Bool -> (Bool -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Bool -> IO () -> IO ()
forall (f :: Type -> Type). Applicative f => Bool -> f () -> f ()
`unless` IO ()
adNauseam)
  ThreadId
_ <- IO () -> IO ThreadId
forkIO IO ()
adNauseam
  StatusMap -> IO StatusMap
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (StatusMap -> IO StatusMap) -> StatusMap -> IO StatusMap
forall a b. (a -> b) -> a -> b
$ ((TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
 -> TVar Status)
-> IntMap
     (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
-> StatusMap
forall a b. (a -> b) -> IntMap a -> IntMap b
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(TestName
_, Unique (WithLoHi Key)
_, TVar Status
_, TVar Status
a) -> TVar Status
a) IntMap (TestName, Unique (WithLoHi Key), TVar Status, TVar Status)
paired

parsePositivePercents :: String -> Maybe Double
parsePositivePercents :: TestName -> Maybe Double
parsePositivePercents TestName
xs = do
  Double
x <- TestName -> Maybe Double
forall a. Read a => TestName -> Maybe a
safeRead TestName
xs
  Bool -> Maybe ()
forall (f :: Type -> Type). Alternative f => Bool -> f ()
guard (Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
0)
  Double -> Maybe Double
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)

joinQuotedFields :: [String] -> [String]
joinQuotedFields :: [TestName] -> [TestName]
joinQuotedFields [] = []
joinQuotedFields (TestName
x : [TestName]
xs)
  | TestName -> Bool
areQuotesBalanced TestName
x = TestName
x TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: [TestName] -> [TestName]
joinQuotedFields [TestName]
xs
  | Bool
otherwise = case (TestName -> Bool) -> [TestName] -> ([TestName], [TestName])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span TestName -> Bool
areQuotesBalanced [TestName]
xs of
      ([TestName]
_, []) -> [] -- malformed CSV
      ([TestName]
ys, TestName
z : [TestName]
zs) -> [TestName] -> TestName
unlines (TestName
x TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: [TestName]
ys [TestName] -> [TestName] -> [TestName]
forall a. [a] -> [a] -> [a]
++ [TestName
Item [TestName]
z]) TestName -> [TestName] -> [TestName]
forall a. a -> [a] -> [a]
: [TestName] -> [TestName]
joinQuotedFields [TestName]
zs
  where
    areQuotesBalanced :: TestName -> Bool
areQuotesBalanced = Key -> Bool
forall a. Integral a => a -> Bool
even (Key -> Bool) -> (TestName -> Key) -> TestName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Key
forall a. [a] -> Key
forall (t :: Type -> Type) a. Foldable t => t a -> Key
length (TestName -> Key) -> (TestName -> TestName) -> TestName -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> TestName -> TestName
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'"')

forceFail :: Result -> Result
forceFail :: Result -> Result
forceFail Result
r = Result
r {resultOutcome = Failure TestFailed, resultShortDescription = "FAIL"}

formatSlowDown :: Double -> String
formatSlowDown :: Double -> TestName
formatSlowDown Double
ratio = case Int64
percents Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Int64
0 of
  Ordering
LT -> TestName -> Int64 -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%2i%% less than baseline" (-Int64
percents)
  Ordering
EQ -> TestName
"same as baseline"
  Ordering
GT -> TestName -> Int64 -> TestName
forall r. PrintfType r => TestName -> r
printf TestName
"%2i%% more than baseline" Int64
percents
  where
    percents :: Int64
    percents :: Int64
percents = Double -> Int64
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate ((Double
ratio Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
100)

compareVsBaseline :: Set String -> TestName -> ExecutionBudget -> Maybe (Double, Double, Double)
compareVsBaseline :: Set TestName
-> TestName -> ExecutionBudget -> Maybe (Double, Double, Double)
compareVsBaseline Set TestName
baseline TestName
name (ExecutionBudget Integer
cpu Integer
mem Integer
size) = case Maybe (Integer, Integer, Integer)
mOld of
  Maybe (Integer, Integer, Integer)
Nothing -> Maybe (Double, Double, Double)
forall a. Maybe a
Nothing
  Just (Integer
oldCpu, Integer
oldMem, Integer
oldSize) ->
    (Double, Double, Double) -> Maybe (Double, Double, Double)
forall a. a -> Maybe a
Just
      (Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
cpu Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oldCpu, Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
mem Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oldMem, Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
oldSize)
  where
    mOld :: Maybe (Integer, Integer, Integer)
    mOld :: Maybe (Integer, Integer, Integer)
mOld = do
      let prefix :: TestName
prefix = TestName -> TestName
encodeCsv TestName
name TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
","
      (TestName
line, Set TestName
furtherLines) <- Set TestName -> Maybe (TestName, Set TestName)
forall a. Set a -> Maybe (a, Set a)
Set.minView (Set TestName -> Maybe (TestName, Set TestName))
-> Set TestName -> Maybe (TestName, Set TestName)
forall a b. (a -> b) -> a -> b
$ (Set TestName, Set TestName) -> Set TestName
forall a b. (a, b) -> b
snd ((Set TestName, Set TestName) -> Set TestName)
-> (Set TestName, Set TestName) -> Set TestName
forall a b. (a -> b) -> a -> b
$ TestName -> Set TestName -> (Set TestName, Set TestName)
forall a. Ord a => a -> Set a -> (Set a, Set a)
Set.split TestName
prefix Set TestName
baseline

      case Set TestName -> Maybe (TestName, Set TestName)
forall a. Set a -> Maybe (a, Set a)
Set.minView Set TestName
furtherLines of
        Maybe (TestName, Set TestName)
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
        Just (TestName
nextLine, Set TestName
_) -> case TestName -> TestName -> Maybe TestName
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix TestName
prefix TestName
nextLine of
          Maybe TestName
Nothing -> () -> Maybe ()
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
          -- If there are several lines matching prefix, skip them all.
          -- Should not normally happen, 'csvReporter' prohibits repeating test names.
          Just {} -> Maybe ()
forall a. Maybe a
Nothing

      (TestName
cpuCell, Char
',' : TestName
rest) <- (Char -> Bool) -> TestName -> (TestName, TestName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') (TestName -> (TestName, TestName))
-> Maybe TestName -> Maybe (TestName, TestName)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> TestName -> Maybe TestName
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix TestName
prefix TestName
line
      (TestName
memCell, Char
',' : TestName
rest') <- (TestName, TestName) -> Maybe (TestName, TestName)
forall a. a -> Maybe a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((TestName, TestName) -> Maybe (TestName, TestName))
-> (TestName, TestName) -> Maybe (TestName, TestName)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> TestName -> (TestName, TestName)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') TestName
rest
      let sizeCell :: TestName
sizeCell = (Char -> Bool) -> TestName -> TestName
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
',') TestName
rest'
      (,,) (Integer -> Integer -> Integer -> (Integer, Integer, Integer))
-> Maybe Integer
-> Maybe (Integer -> Integer -> (Integer, Integer, Integer))
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> TestName -> Maybe Integer
forall a. Read a => TestName -> Maybe a
safeRead TestName
cpuCell Maybe (Integer -> Integer -> (Integer, Integer, Integer))
-> Maybe Integer -> Maybe (Integer -> (Integer, Integer, Integer))
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> TestName -> Maybe Integer
forall a. Read a => TestName -> Maybe a
safeRead TestName
memCell Maybe (Integer -> (Integer, Integer, Integer))
-> Maybe Integer -> Maybe (Integer, Integer, Integer)
forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
forall (f :: Type -> Type) a b.
Applicative f =>
f (a -> b) -> f a -> f b
<*> TestName -> Maybe Integer
forall a. Read a => TestName -> Maybe a
safeRead TestName
sizeCell

encodeCsv :: String -> String
encodeCsv :: TestName -> TestName
encodeCsv TestName
xs
  | forall (t :: Type -> Type) a.
Foldable t =>
(a -> Bool) -> t a -> Bool
any @[] @Char (Char -> TestName -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: Type -> Type) a.
(Foldable t, Eq a) =>
a -> t a -> Bool
`elem` TestName
xs) TestName
",\"\n\r" =
      Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
xs -- opening quote
  | Bool
otherwise = TestName
xs
  where
    go :: TestName -> TestName
go [] = TestName
"\"" -- closing quote
    go (Char
'"' : TestName
ys) = Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: Char
'"' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
ys
    go (Char
y : TestName
ys) = Char
y Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName -> TestName
go TestName
ys

scriptSize :: Script -> Integer
scriptSize :: Script -> Integer
scriptSize = Key -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Key -> Integer) -> (Script -> Key) -> Script -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Key
Short.length (ShortByteString -> Key)
-> (Script -> ShortByteString) -> Script -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program DeBruijn DefaultUni DefaultFun () -> ShortByteString
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> ShortByteString)
-> (Script -> Program DeBruijn DefaultUni DefaultFun ())
-> Script
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Program DeBruijn DefaultUni DefaultFun ()
unScript

toTableAligned :: [[String]] -> String
toTableAligned :: [[TestName]] -> TestName
toTableAligned [[TestName]]
xss' = [TestName] -> TestName
unlines ([TestName] -> TestName) -> [TestName] -> TestName
forall a b. (a -> b) -> a -> b
$ ([TestName] -> TestName) -> [[TestName]] -> [TestName]
forall a b. (a -> b) -> [a] -> [b]
map (TestName -> [TestName] -> TestName
forall a. [a] -> [[a]] -> [a]
intercalate TestName
" | " ([TestName] -> TestName)
-> ([TestName] -> [TestName]) -> [TestName] -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key -> TestName -> TestName) -> [Key] -> [TestName] -> [TestName]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (Key -> TestName -> TestName
pad (Key -> TestName -> TestName)
-> (Key -> Key) -> Key -> TestName -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Key
padColumn) [Key
Item [Key]
0 ..]) [[TestName]]
xss
  where
    [[TestName]]
xss :: [[String]] = ([TestName] -> [TestName]) -> [[TestName]] -> [[TestName]]
forall a b. (a -> b) -> [a] -> [b]
map ((TestName -> Bool) -> [TestName] -> [TestName]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (TestName -> Bool) -> TestName -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Bool
forall a. [a] -> Bool
forall (t :: Type -> Type) a. Foldable t => t a -> Bool
null)) [[TestName]]
xss'
    pad :: Key -> TestName -> TestName
pad Key
n TestName
xs = TestName
xs TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Key -> Char -> TestName
forall a. Key -> a -> [a]
replicate (Key
n Key -> Key -> Key
forall a. Num a => a -> a -> a
- TestName -> Key
forall a. [a] -> Key
forall (t :: Type -> Type) a. Foldable t => t a -> Key
length TestName
xs) Char
' '
    padColumn :: Key -> Key
padColumn Key
idx = [Key] -> Key
forall a. Ord a => [a] -> a
forall (t :: Type -> Type) a. (Foldable t, Ord a) => t a -> a
maximum ([Key] -> Key) -> [Key] -> Key
forall a b. (a -> b) -> a -> b
$ ([TestName] -> Key) -> [[TestName]] -> [Key]
forall a b. (a -> b) -> [a] -> [b]
map (TestName -> Key
forall a. [a] -> Key
forall (t :: Type -> Type) a. Foldable t => t a -> Key
length (TestName -> Key) -> ([TestName] -> TestName) -> [TestName] -> Key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([TestName] -> Key -> TestName
forall a. HasCallStack => [a] -> Key -> a
!! Key
idx)) [[TestName]]
xss

findNonUniqueElement :: Ord a => [a] -> Maybe a
findNonUniqueElement :: forall a. Ord a => [a] -> Maybe a
findNonUniqueElement = Set a -> [a] -> Maybe a
forall {a}. Ord a => Set a -> [a] -> Maybe a
go Set a
forall a. Set a
Set.empty
  where
    go :: Set a -> [a] -> Maybe a
go Set a
_ [] = Maybe a
forall a. Maybe a
Nothing
    go Set a
acc (a
x : [a]
xs)
      | a
x a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set a
acc = a -> Maybe a
forall a. a -> Maybe a
Just a
x
      | Bool
otherwise = Set a -> [a] -> Maybe a
go (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
x Set a
acc) [a]
xs

csvOutput :: Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput :: Handle -> IntMap (TestName, TVar Status) -> IO ()
csvOutput Handle
h = ((TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status) -> IO ()
forall (t :: Type -> Type) (f :: Type -> Type) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (((TestName, TVar Status) -> IO ())
 -> IntMap (TestName, TVar Status) -> IO ())
-> ((TestName, TVar Status) -> IO ())
-> IntMap (TestName, TVar Status)
-> IO ()
forall a b. (a -> b) -> a -> b
$ \(TestName
name, TVar Status
tv) -> do
  Result
r <- STM Result -> IO Result
forall a. STM a -> IO a
atomically (STM Result -> IO Result) -> STM Result -> IO Result
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Result) -> STM Result
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Done Result
r -> Result -> STM Result
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Result
r; Status
_ -> STM Result
forall a. STM a
retry
  case TestName -> Maybe (WithLoHi ExecutionBudget)
forall a. Read a => TestName -> Maybe a
safeRead (Result -> TestName
resultDescription Result
r) of
    Maybe (WithLoHi ExecutionBudget)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
    Just (WithLoHi ExecutionBudget
est (Double, Double)
_ (Double, Double)
_ (Double, Double)
_) -> do
      TestName
msg <- TestName -> IO TestName
formatMessage (TestName -> IO TestName) -> TestName -> IO TestName
forall a b. (a -> b) -> a -> b
$ ExecutionBudget -> TestName
csvEstimate ExecutionBudget
est
      Handle -> TestName -> IO ()
hPutStrLn Handle
h (TestName -> TestName
encodeCsv TestName
name TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Char
',' Char -> TestName -> TestName
forall a. a -> [a] -> [a]
: TestName
msg)

csvEstimate :: ExecutionBudget -> String
csvEstimate :: ExecutionBudget -> TestName
csvEstimate (ExecutionBudget Integer
cpu Integer
mem Integer
size) = Integer -> TestName
forall a. Show a => a -> TestName
show Integer
cpu TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"," TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Integer -> TestName
forall a. Show a => a -> TestName
show Integer
mem TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
"," TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ Integer -> TestName
forall a. Show a => a -> TestName
show Integer
size

isSuccessful :: StatusMap -> IO Bool
isSuccessful :: StatusMap -> IO Bool
isSuccessful = [TVar Status] -> IO Bool
go ([TVar Status] -> IO Bool)
-> (StatusMap -> [TVar Status]) -> StatusMap -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusMap -> [TVar Status]
forall a. IntMap a -> [a]
IntMap.elems
  where
    go :: [TVar Status] -> IO Bool
go [] = Bool -> IO Bool
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
True
    go (TVar Status
tv : [TVar Status]
tvs) = do
      Bool
b <- STM Bool -> IO Bool
forall a. STM a -> IO a
atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ TVar Status -> STM Status
forall a. TVar a -> STM a
readTVar TVar Status
tv STM Status -> (Status -> STM Bool) -> STM Bool
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: Type -> Type) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case Done Result
r -> Bool -> STM Bool
forall a. a -> STM a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Result -> Bool
resultSuccessful Result
r); Status
_ -> STM Bool
forall a. STM a
retry
      if Bool
b then [TVar Status] -> IO Bool
go [TVar Status]
tvs else Bool -> IO Bool
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Bool
False