{-# OPTIONS_HADDOCK not-home #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}

module Hedgehog.Internal.Runner (
  -- * Running Individual Properties
    check
  , recheck
  , recheckAt

  -- * Running Groups of Properties
  , RunnerConfig(..)
  , checkParallel
  , checkSequential
  , checkGroup

  -- * Internal
  , checkReport
  , checkRegion
  , checkNamed
  ) where

import           Control.Concurrent.STM (TVar, atomically)
import qualified Control.Concurrent.STM.TVar as TVar
import           Control.Exception.Safe (MonadCatch, catchAny)
import           Control.Monad.IO.Class (MonadIO(..))
import           Data.Maybe (isJust)

import           Hedgehog.Internal.Config
import           Hedgehog.Internal.Gen (evalGenT)
import           Hedgehog.Internal.Prelude
import           Hedgehog.Internal.Property (DiscardCount(..), ShrinkCount(..))
import           Hedgehog.Internal.Property (Group(..), GroupName(..))
import           Hedgehog.Internal.Property (Journal(..), Coverage(..), CoverCount(..))
import           Hedgehog.Internal.Property (Property(..), PropertyConfig(..), PropertyName(..))
import           Hedgehog.Internal.Property (PropertyT(..), Failure(..), runTestT)
import           Hedgehog.Internal.Property (ShrinkLimit, ShrinkRetries, withTests, withSkip)
import           Hedgehog.Internal.Property (TerminationCriteria(..))
import           Hedgehog.Internal.Property (TestCount(..), PropertyCount(..))
import           Hedgehog.Internal.Property (confidenceSuccess, confidenceFailure)
import           Hedgehog.Internal.Property (coverageSuccess, journalCoverage)
import           Hedgehog.Internal.Property (defaultMinTests)
import           Hedgehog.Internal.Property (ShrinkPath(..))
import           Hedgehog.Internal.Queue
import           Hedgehog.Internal.Region
import           Hedgehog.Internal.Report
import qualified Hedgehog.Internal.Seed as Seed
import           Hedgehog.Internal.Tree (TreeT(..), NodeT(..))
import           Hedgehog.Range (Size)

import           Language.Haskell.TH.Syntax (Lift)

#if mingw32_HOST_OS
import           System.IO (hSetEncoding, stdout, stderr, utf8)
#endif

-- | Configuration for a property test run.
--
data RunnerConfig =
  RunnerConfig {
      -- | The number of property tests to run concurrently. 'Nothing' means
      --   use one worker per processor.
      RunnerConfig -> Maybe WorkerCount
runnerWorkers :: !(Maybe WorkerCount)

      -- | Whether to use colored output or not. 'Nothing' means detect from
      --   the environment.
    , RunnerConfig -> Maybe UseColor
runnerColor :: !(Maybe UseColor)

      -- | The seed to use. 'Nothing' means detect from the environment.
    , RunnerConfig -> Maybe Seed
runnerSeed :: !(Maybe Seed)

      -- | How verbose to be in the runner output. 'Nothing' means detect from
      --   the environment.
    , RunnerConfig -> Maybe Verbosity
runnerVerbosity :: !(Maybe Verbosity)
    } deriving (RunnerConfig -> RunnerConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunnerConfig -> RunnerConfig -> Bool
$c/= :: RunnerConfig -> RunnerConfig -> Bool
== :: RunnerConfig -> RunnerConfig -> Bool
$c== :: RunnerConfig -> RunnerConfig -> Bool
Eq, Eq RunnerConfig
RunnerConfig -> RunnerConfig -> Bool
RunnerConfig -> RunnerConfig -> Ordering
RunnerConfig -> RunnerConfig -> RunnerConfig
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
min :: RunnerConfig -> RunnerConfig -> RunnerConfig
$cmin :: RunnerConfig -> RunnerConfig -> RunnerConfig
max :: RunnerConfig -> RunnerConfig -> RunnerConfig
$cmax :: RunnerConfig -> RunnerConfig -> RunnerConfig
>= :: RunnerConfig -> RunnerConfig -> Bool
$c>= :: RunnerConfig -> RunnerConfig -> Bool
> :: RunnerConfig -> RunnerConfig -> Bool
$c> :: RunnerConfig -> RunnerConfig -> Bool
<= :: RunnerConfig -> RunnerConfig -> Bool
$c<= :: RunnerConfig -> RunnerConfig -> Bool
< :: RunnerConfig -> RunnerConfig -> Bool
$c< :: RunnerConfig -> RunnerConfig -> Bool
compare :: RunnerConfig -> RunnerConfig -> Ordering
$ccompare :: RunnerConfig -> RunnerConfig -> Ordering
Ord, Int -> RunnerConfig -> ShowS
[RunnerConfig] -> ShowS
RunnerConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunnerConfig] -> ShowS
$cshowList :: [RunnerConfig] -> ShowS
show :: RunnerConfig -> String
$cshow :: RunnerConfig -> String
showsPrec :: Int -> RunnerConfig -> ShowS
$cshowsPrec :: Int -> RunnerConfig -> ShowS
Show, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => RunnerConfig -> m Exp
forall (m :: * -> *).
Quote m =>
RunnerConfig -> Code m RunnerConfig
liftTyped :: forall (m :: * -> *).
Quote m =>
RunnerConfig -> Code m RunnerConfig
$cliftTyped :: forall (m :: * -> *).
Quote m =>
RunnerConfig -> Code m RunnerConfig
lift :: forall (m :: * -> *). Quote m => RunnerConfig -> m Exp
$clift :: forall (m :: * -> *). Quote m => RunnerConfig -> m Exp
Lift)

findM :: Monad m => [a] -> b -> (a -> m (Maybe b)) -> m b
findM :: forall (m :: * -> *) a b.
Monad m =>
[a] -> b -> (a -> m (Maybe b)) -> m b
findM [a]
xs0 b
def a -> m (Maybe b)
p =
  case [a]
xs0 of
    [] ->
      forall (m :: * -> *) a. Monad m => a -> m a
return b
def
    a
x0 : [a]
xs ->
      a -> m (Maybe b)
p a
x0 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Maybe b
m ->
        case Maybe b
m of
          Maybe b
Nothing ->
            forall (m :: * -> *) a b.
Monad m =>
[a] -> b -> (a -> m (Maybe b)) -> m b
findM [a]
xs b
def a -> m (Maybe b)
p
          Just b
x ->
            forall (m :: * -> *) a. Monad m => a -> m a
return b
x

isFailure :: NodeT m (Maybe (Either x a, b)) -> Bool
isFailure :: forall (m :: * -> *) x a b. NodeT m (Maybe (Either x a, b)) -> Bool
isFailure = \case
  NodeT (Just (Left x
_, b
_)) [TreeT m (Maybe (Either x a, b))]
_ ->
    Bool
True
  NodeT m (Maybe (Either x a, b))
_ ->
    Bool
False

isSuccess :: NodeT m (Maybe (Either x a, b)) -> Bool
isSuccess :: forall (m :: * -> *) x a b. NodeT m (Maybe (Either x a, b)) -> Bool
isSuccess =
  Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a b. NodeT m (Maybe (Either x a, b)) -> Bool
isFailure

runTreeN ::
     Monad m
  => ShrinkRetries
  -> TreeT m (Maybe (Either x a, b))
  -> m (NodeT m (Maybe (Either x a, b)))
runTreeN :: forall (m :: * -> *) x a b.
Monad m =>
ShrinkRetries
-> TreeT m (Maybe (Either x a, b))
-> m (NodeT m (Maybe (Either x a, b)))
runTreeN ShrinkRetries
n TreeT m (Maybe (Either x a, b))
m = do
  NodeT m (Maybe (Either x a, b))
o <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m (Maybe (Either x a, b))
m
  if ShrinkRetries
n forall a. Ord a => a -> a -> Bool
> ShrinkRetries
0 Bool -> Bool -> Bool
&& forall (m :: * -> *) x a b. NodeT m (Maybe (Either x a, b)) -> Bool
isSuccess NodeT m (Maybe (Either x a, b))
o then
    forall (m :: * -> *) x a b.
Monad m =>
ShrinkRetries
-> TreeT m (Maybe (Either x a, b))
-> m (NodeT m (Maybe (Either x a, b)))
runTreeN (ShrinkRetries
n forall a. Num a => a -> a -> a
- ShrinkRetries
1) TreeT m (Maybe (Either x a, b))
m
  else
    forall (f :: * -> *) a. Applicative f => a -> f a
pure NodeT m (Maybe (Either x a, b))
o

takeSmallest ::
     MonadIO m
  => ShrinkCount
  -> ShrinkPath
  -> ShrinkLimit
  -> ShrinkRetries
  -> (Progress -> m ())
  -> NodeT m (Maybe (Either Failure (), Journal))
  -> m Result
takeSmallest :: forall (m :: * -> *).
MonadIO m =>
ShrinkCount
-> ShrinkPath
-> ShrinkLimit
-> ShrinkRetries
-> (Progress -> m ())
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
takeSmallest ShrinkCount
shrinks0 (ShrinkPath [Int]
shrinkPath0) ShrinkLimit
slimit ShrinkRetries
retries Progress -> m ()
updateUI =
  let
    loop :: ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop ShrinkCount
shrinks [Int]
revShrinkPath = \case
      NodeT Maybe (Either Failure (), Journal)
Nothing [TreeT m (Maybe (Either Failure (), Journal))]
_ ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
GaveUp

      NodeT (Just (Either Failure ()
x, (Journal [Log]
logs))) [TreeT m (Maybe (Either Failure (), Journal))]
xs ->
        case Either Failure ()
x of
          Left (Failure Maybe Span
loc String
err Maybe Diff
mdiff) -> do
            let
              shrinkPath :: ShrinkPath
shrinkPath =
                [Int] -> ShrinkPath
ShrinkPath forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse [Int]
revShrinkPath
              failure :: FailureReport
failure =
                ShrinkCount
-> ShrinkPath
-> Maybe (Coverage CoverCount)
-> Maybe Span
-> String
-> Maybe Diff
-> [Log]
-> FailureReport
mkFailure ShrinkCount
shrinks ShrinkPath
shrinkPath forall a. Maybe a
Nothing Maybe Span
loc String
err Maybe Diff
mdiff (forall a. [a] -> [a]
reverse [Log]
logs)

            Progress -> m ()
updateUI forall a b. (a -> b) -> a -> b
$ FailureReport -> Progress
Shrinking FailureReport
failure

            if ShrinkCount
shrinks forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral ShrinkLimit
slimit then
              -- if we've hit the shrink limit, don't shrink any further
              forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FailureReport -> Result
Failed FailureReport
failure
            else
              forall (m :: * -> *) a b.
Monad m =>
[a] -> b -> (a -> m (Maybe b)) -> m b
findM (forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] [TreeT m (Maybe (Either Failure (), Journal))]
xs) (FailureReport -> Result
Failed FailureReport
failure) forall a b. (a -> b) -> a -> b
$ \(Int
n, TreeT m (Maybe (Either Failure (), Journal))
m) -> do
                NodeT m (Maybe (Either Failure (), Journal))
o <- forall (m :: * -> *) x a b.
Monad m =>
ShrinkRetries
-> TreeT m (Maybe (Either x a, b))
-> m (NodeT m (Maybe (Either x a, b)))
runTreeN ShrinkRetries
retries TreeT m (Maybe (Either Failure (), Journal))
m
                if forall (m :: * -> *) x a b. NodeT m (Maybe (Either x a, b)) -> Bool
isFailure NodeT m (Maybe (Either Failure (), Journal))
o then
                  forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop (ShrinkCount
shrinks forall a. Num a => a -> a -> a
+ ShrinkCount
1) (Int
n forall a. a -> [a] -> [a]
: [Int]
revShrinkPath) NodeT m (Maybe (Either Failure (), Journal))
o
                else
                  forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

          Right () ->
            forall (m :: * -> *) a. Monad m => a -> m a
return Result
OK
  in
    ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop ShrinkCount
shrinks0 (forall a. [a] -> [a]
reverse [Int]
shrinkPath0)

-- | Follow a given shrink path, instead of searching exhaustively. Assume that
-- the end of the path is minimal, and don't try to shrink any further than
-- that.
--
-- This evaluates the test for all the shrinks on the path, but not ones
-- off-path. Because the generator is mixed with the test code, it's probably
-- not possible to avoid this.
skipToShrink ::
     MonadIO m
  => ShrinkPath
  -> (Progress -> m ())
  -> NodeT m (Maybe (Either Failure (), Journal))
  -> m Result
skipToShrink :: forall (m :: * -> *).
MonadIO m =>
ShrinkPath
-> (Progress -> m ())
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
skipToShrink (ShrinkPath [Int]
shrinkPath) Progress -> m ()
updateUI =
  let
    loop :: ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop ShrinkCount
shrinks [] = \case
      NodeT Maybe (Either Failure (), Journal)
Nothing [TreeT m (Maybe (Either Failure (), Journal))]
_ ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
GaveUp

      NodeT (Just (Either Failure ()
x, (Journal [Log]
logs))) [TreeT m (Maybe (Either Failure (), Journal))]
_ ->
        case Either Failure ()
x of
          Left (Failure Maybe Span
loc String
err Maybe Diff
mdiff) -> do
            let
              failure :: FailureReport
failure =
                ShrinkCount
-> ShrinkPath
-> Maybe (Coverage CoverCount)
-> Maybe Span
-> String
-> Maybe Diff
-> [Log]
-> FailureReport
mkFailure ShrinkCount
shrinks ([Int] -> ShrinkPath
ShrinkPath [Int]
shrinkPath) forall a. Maybe a
Nothing Maybe Span
loc String
err Maybe Diff
mdiff (forall a. [a] -> [a]
reverse [Log]
logs)

            Progress -> m ()
updateUI forall a b. (a -> b) -> a -> b
$ FailureReport -> Progress
Shrinking FailureReport
failure
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ FailureReport -> Result
Failed FailureReport
failure

          Right () ->
            forall (m :: * -> *) a. Monad m => a -> m a
return Result
OK

    loop ShrinkCount
shrinks (Int
s0:[Int]
ss) = \case
      NodeT Maybe (Either Failure (), Journal)
_ [TreeT m (Maybe (Either Failure (), Journal))]
xs ->
        case forall a. Int -> [a] -> [a]
drop Int
s0 [TreeT m (Maybe (Either Failure (), Journal))]
xs of
          [] ->
            forall (f :: * -> *) a. Applicative f => a -> f a
pure Result
GaveUp
          (TreeT m (Maybe (Either Failure (), Journal))
x:[TreeT m (Maybe (Either Failure (), Journal))]
_) -> do
            NodeT m (Maybe (Either Failure (), Journal))
o <- forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT TreeT m (Maybe (Either Failure (), Journal))
x
            ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop (ShrinkCount
shrinks forall a. Num a => a -> a -> a
+ ShrinkCount
1) [Int]
ss NodeT m (Maybe (Either Failure (), Journal))
o
  in
    ShrinkCount
-> [Int]
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
loop ShrinkCount
0 [Int]
shrinkPath

checkReport ::
     forall m.
     MonadIO m
  => MonadCatch m
  => PropertyConfig
  -> Size
  -> Seed
  -> PropertyT m ()
  -> (Report Progress -> m ())
  -> m (Report Result)
checkReport :: forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
PropertyConfig
-> Size
-> Seed
-> PropertyT m ()
-> (Report Progress -> m ())
-> m (Report Result)
checkReport PropertyConfig
cfg Size
size0 Seed
seed0 PropertyT m ()
test0 Report Progress -> m ()
updateUI = do
  Skip
skip <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => Maybe Skip -> m Skip
resolveSkip forall a b. (a -> b) -> a -> b
$ PropertyConfig -> Maybe Skip
propertySkip PropertyConfig
cfg

  let
    (Maybe (TestCount, DiscardCount)
mSkipToTest, Maybe ShrinkPath
mSkipToShrink) =
      case Skip
skip of
        Skip
SkipNothing ->
          (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing)
        SkipToTest TestCount
t DiscardCount
d ->
          (forall a. a -> Maybe a
Just (TestCount
t, DiscardCount
d), forall a. Maybe a
Nothing)
        SkipToShrink TestCount
t DiscardCount
d ShrinkPath
s ->
          (forall a. a -> Maybe a
Just (TestCount
t, DiscardCount
d), forall a. a -> Maybe a
Just ShrinkPath
s)

    test :: PropertyT m ()
test =
      forall (m :: * -> *) a.
MonadCatch m =>
m a -> (SomeException -> m a) -> m a
catchAny PropertyT m ()
test0 (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show)

    terminationCriteria :: TerminationCriteria
terminationCriteria =
      PropertyConfig -> TerminationCriteria
propertyTerminationCriteria PropertyConfig
cfg

    (Maybe Confidence
confidence, TestLimit
minTests) =
      case TerminationCriteria
terminationCriteria of
        EarlyTermination Confidence
c TestLimit
t -> (forall a. a -> Maybe a
Just Confidence
c, TestLimit
t)
        NoEarlyTermination Confidence
c TestLimit
t -> (forall a. a -> Maybe a
Just Confidence
c, TestLimit
t)
        NoConfidenceTermination TestLimit
t -> (forall a. Maybe a
Nothing, TestLimit
t)

    successVerified :: TestCount -> Coverage CoverCount -> Bool
successVerified TestCount
count Coverage CoverCount
coverage =
      TestCount
count forall a. Integral a => a -> a -> a
`mod` TestCount
100 forall a. Eq a => a -> a -> Bool
== TestCount
0 Bool -> Bool -> Bool
&&
      -- If the user wants a statistically significant result, this function
      -- will run a confidence check. Otherwise, it will default to checking
      -- the percentage of encountered labels
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Confidence
c -> TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceSuccess TestCount
count Confidence
c Coverage CoverCount
coverage) Maybe Confidence
confidence

    failureVerified :: TestCount -> Coverage CoverCount -> Bool
failureVerified TestCount
count Coverage CoverCount
coverage =
      -- Will be true if we can statistically verify that our coverage was
      -- inadequate.
      -- Testing only on 100s to minimise repeated measurement statistical
      -- errors.
      TestCount
count forall a. Integral a => a -> a -> a
`mod` TestCount
100 forall a. Eq a => a -> a -> Bool
== TestCount
0 Bool -> Bool -> Bool
&&
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Confidence
c -> TestCount -> Confidence -> Coverage CoverCount -> Bool
confidenceFailure TestCount
count Confidence
c Coverage CoverCount
coverage) Maybe Confidence
confidence

    loop ::
         TestCount
      -> DiscardCount
      -> Size
      -> Seed
      -> Coverage CoverCount
      -> m (Report Result)
    loop :: TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop !TestCount
tests !DiscardCount
discards !Size
size !Seed
seed !Coverage CoverCount
coverage0 = do
      Report Progress -> m ()
updateUI forall a b. (a -> b) -> a -> b
$ forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0 Progress
Running

      let
        coverageReached :: Bool
coverageReached =
          TestCount -> Coverage CoverCount -> Bool
successVerified TestCount
tests Coverage CoverCount
coverage0

        coverageUnreachable :: Bool
coverageUnreachable =
          TestCount -> Coverage CoverCount -> Bool
failureVerified TestCount
tests Coverage CoverCount
coverage0

        enoughTestsRun :: Bool
enoughTestsRun =
          case TerminationCriteria
terminationCriteria of
            EarlyTermination Confidence
_ TestLimit
_ ->
              TestCount
tests forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral TestLimit
defaultMinTests Bool -> Bool -> Bool
&&
                (Bool
coverageReached Bool -> Bool -> Bool
|| Bool
coverageUnreachable)
            NoEarlyTermination Confidence
_ TestLimit
_ ->
              TestCount
tests forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral TestLimit
minTests
            NoConfidenceTermination TestLimit
_ ->
              TestCount
tests forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral TestLimit
minTests

        labelsCovered :: Bool
labelsCovered =
          TestCount -> Coverage CoverCount -> Bool
coverageSuccess TestCount
tests Coverage CoverCount
coverage0

        successReport :: Report Result
successReport =
          forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0 Result
OK

        failureReport :: String -> Report Result
failureReport String
message =
          forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. FailureReport -> Result
Failed forall a b. (a -> b) -> a -> b
$ ShrinkCount
-> ShrinkPath
-> Maybe (Coverage CoverCount)
-> Maybe Span
-> String
-> Maybe Diff
-> [Log]
-> FailureReport
mkFailure
            ShrinkCount
0
            ([Int] -> ShrinkPath
ShrinkPath [])
            (forall a. a -> Maybe a
Just Coverage CoverCount
coverage0)
            forall a. Maybe a
Nothing
            String
message
            forall a. Maybe a
Nothing
            []

        confidenceReport :: Report Result
confidenceReport =
          if Bool
coverageReached Bool -> Bool -> Bool
&& Bool
labelsCovered then
            Report Result
successReport
          else
            String -> Report Result
failureReport forall a b. (a -> b) -> a -> b
$
              String
"Test coverage cannot be reached after " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TestCount
tests forall a. Semigroup a => a -> a -> a
<> String
" tests"

      if Size
size forall a. Ord a => a -> a -> Bool
> Size
99 then
        -- size has reached limit, reset to 0
        TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop TestCount
tests DiscardCount
discards Size
0 Seed
seed Coverage CoverCount
coverage0

      else if Bool
enoughTestsRun then
        -- at this point, we know that enough tests have been run in order to
        -- make a decision on if this was a successful run or not
        --
        -- If we have early termination, then we need to check coverageReached /
        -- coverageUnreachable. If we skip tests, we ignore coverage.
        if forall a. Maybe a -> Bool
isJust Maybe (TestCount, DiscardCount)
mSkipToTest then
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Report Result
successReport
        else
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ case TerminationCriteria
terminationCriteria of
            EarlyTermination Confidence
_ TestLimit
_ -> Report Result
confidenceReport
            NoEarlyTermination Confidence
_ TestLimit
_ -> Report Result
confidenceReport
            NoConfidenceTermination TestLimit
_ ->
              if Bool
labelsCovered then
                Report Result
successReport
              else
                String -> Report Result
failureReport forall a b. (a -> b) -> a -> b
$
                  String
"Labels not sufficently covered after " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show TestCount
tests forall a. Semigroup a => a -> a -> a
<> String
" tests"

      else if DiscardCount
discards forall a. Ord a => a -> a -> Bool
>= forall a b. (Integral a, Num b) => a -> b
fromIntegral (PropertyConfig -> DiscardLimit
propertyDiscardLimit PropertyConfig
cfg) then
        -- we've hit the discard limit, give up
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report TestCount
tests DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0 Result
GaveUp

      else
        case Seed -> (Seed, Seed)
Seed.split Seed
seed of
          (Seed
s0, Seed
s1) -> case (Maybe (TestCount, DiscardCount)
mSkipToTest, Maybe ShrinkPath
mSkipToShrink) of
            -- If the report says failed "after 32 tests", the test number that
            -- failed was 31, but we want the user to be able to skip to 32 and
            -- start with the one that failed.
            (Just (TestCount
n, DiscardCount
d), Maybe ShrinkPath
_)
              | TestCount
n forall a. Ord a => a -> a -> Bool
> TestCount
tests forall a. Num a => a -> a -> a
+ TestCount
1 ->
                TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop (TestCount
tests forall a. Num a => a -> a -> a
+ TestCount
1) DiscardCount
discards (Size
size forall a. Num a => a -> a -> a
+ Size
1) Seed
s1 Coverage CoverCount
coverage0
              | DiscardCount
d forall a. Ord a => a -> a -> Bool
> DiscardCount
discards ->
                TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop TestCount
tests (DiscardCount
discards forall a. Num a => a -> a -> a
+ DiscardCount
1) (Size
size forall a. Num a => a -> a -> a
+ Size
1) Seed
s1 Coverage CoverCount
coverage0
            (Just (TestCount, DiscardCount)
_, Just ShrinkPath
shrinkPath) -> do
              NodeT m (Maybe (Either Failure (), Journal))
node <-
                forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
Size -> Seed -> GenT m a -> TreeT m (Maybe a)
evalGenT Size
size Seed
s0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
unPropertyT PropertyT m ()
test
              let
                mkReport :: a -> Report a
mkReport =
                  forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report (TestCount
tests forall a. Num a => a -> a -> a
+ TestCount
1) DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0
              forall {a}. a -> Report a
mkReport forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
ShrinkPath
-> (Progress -> m ())
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
skipToShrink ShrinkPath
shrinkPath (Report Progress -> m ()
updateUI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> Report a
mkReport) NodeT m (Maybe (Either Failure (), Journal))
node
            (Maybe (TestCount, DiscardCount), Maybe ShrinkPath)
_ -> do
              node :: NodeT m (Maybe (Either Failure (), Journal))
node@(NodeT Maybe (Either Failure (), Journal)
x [TreeT m (Maybe (Either Failure (), Journal))]
_) <-
                forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
runTreeT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
Monad m =>
Size -> Seed -> GenT m a -> TreeT m (Maybe a)
evalGenT Size
size Seed
s0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
runTestT forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
unPropertyT PropertyT m ()
test
              case Maybe (Either Failure (), Journal)
x of
                Maybe (Either Failure (), Journal)
Nothing ->
                  TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop TestCount
tests (DiscardCount
discards forall a. Num a => a -> a -> a
+ DiscardCount
1) (Size
size forall a. Num a => a -> a -> a
+ Size
1) Seed
s1 Coverage CoverCount
coverage0

                Just (Left Failure
_, Journal
_) ->
                  let
                    mkReport :: a -> Report a
mkReport =
                      forall a.
TestCount
-> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
Report (TestCount
tests forall a. Num a => a -> a -> a
+ TestCount
1) DiscardCount
discards Coverage CoverCount
coverage0 Seed
seed0
                  in
                    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {a}. a -> Report a
mkReport forall a b. (a -> b) -> a -> b
$
                      forall (m :: * -> *).
MonadIO m =>
ShrinkCount
-> ShrinkPath
-> ShrinkLimit
-> ShrinkRetries
-> (Progress -> m ())
-> NodeT m (Maybe (Either Failure (), Journal))
-> m Result
takeSmallest
                        ShrinkCount
0
                        ([Int] -> ShrinkPath
ShrinkPath [])
                        (PropertyConfig -> ShrinkLimit
propertyShrinkLimit PropertyConfig
cfg)
                        (PropertyConfig -> ShrinkRetries
propertyShrinkRetries PropertyConfig
cfg)
                        (Report Progress -> m ()
updateUI forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. a -> Report a
mkReport)
                        NodeT m (Maybe (Either Failure (), Journal))
node

                Just (Right (), Journal
journal) ->
                  let
                    coverage :: Coverage CoverCount
coverage =
                      Journal -> Coverage CoverCount
journalCoverage Journal
journal forall a. Semigroup a => a -> a -> a
<> Coverage CoverCount
coverage0
                  in
                    TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop (TestCount
tests forall a. Num a => a -> a -> a
+ TestCount
1) DiscardCount
discards (Size
size forall a. Num a => a -> a -> a
+ Size
1) Seed
s1 Coverage CoverCount
coverage

  TestCount
-> DiscardCount
-> Size
-> Seed
-> Coverage CoverCount
-> m (Report Result)
loop TestCount
0 DiscardCount
0 Size
size0 Seed
seed0 forall a. Monoid a => a
mempty

checkRegion ::
     MonadIO m
  => Region
  -> UseColor
  -> Maybe PropertyName
  -> Size
  -> Seed
  -> Property
  -> m (Report Result)
checkRegion :: forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Size
-> Seed
-> Property
-> m (Report Result)
checkRegion Region
region UseColor
color Maybe PropertyName
name Size
size Seed
seed Property
prop =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Report Result
result <-
      forall (m :: * -> *).
(MonadIO m, MonadCatch m) =>
PropertyConfig
-> Size
-> Seed
-> PropertyT m ()
-> (Report Progress -> m ())
-> m (Report Result)
checkReport (Property -> PropertyConfig
propertyConfig Property
prop) Size
size Seed
seed (Property -> PropertyT IO ()
propertyTest Property
prop) forall a b. (a -> b) -> a -> b
$ \Report Progress
progress -> do
        String
ppprogress <- forall (m :: * -> *).
MonadIO m =>
UseColor -> Maybe PropertyName -> Report Progress -> m String
renderProgress UseColor
color Maybe PropertyName
name Report Progress
progress
        case forall a. Report a -> a
reportStatus Report Progress
progress of
          Progress
Running ->
            forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
setRegion Region
region String
ppprogress
          Shrinking FailureReport
_ ->
            forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
openRegion Region
region String
ppprogress

    String
ppresult <- forall (m :: * -> *).
MonadIO m =>
UseColor -> Maybe PropertyName -> Report Result -> m String
renderResult UseColor
color Maybe PropertyName
name Report Result
result
    case forall a. Report a -> a
reportStatus Report Result
result of
      Failed FailureReport
_ ->
        forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
openRegion Region
region String
ppresult
      Result
GaveUp ->
        forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
openRegion Region
region String
ppresult
      Result
OK ->
        forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
setRegion Region
region String
ppresult

    forall (f :: * -> *) a. Applicative f => a -> f a
pure Report Result
result

checkNamed ::
     MonadIO m
  => Region
  -> UseColor
  -> Maybe PropertyName
  -> Maybe Seed
  -> Property
  -> m (Report Result)
checkNamed :: forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Maybe Seed
-> Property
-> m (Report Result)
checkNamed Region
region UseColor
color Maybe PropertyName
name Maybe Seed
mseed Property
prop = do
  Seed
seed <- forall (m :: * -> *). MonadIO m => Maybe Seed -> m Seed
resolveSeed Maybe Seed
mseed
  forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Size
-> Seed
-> Property
-> m (Report Result)
checkRegion Region
region UseColor
color Maybe PropertyName
name Size
0 Seed
seed Property
prop

-- | Check a property.
--
check :: MonadIO m => Property -> m Bool
check :: forall (m :: * -> *). MonadIO m => Property -> m Bool
check Property
prop = do
  UseColor
color <- forall (m :: * -> *). MonadIO m => m UseColor
detectColor
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m, LiftRegion m) =>
(Region -> m a) -> m a
displayRegion forall a b. (a -> b) -> a -> b
$ \Region
region ->
    (forall a. Eq a => a -> a -> Bool
== Result
OK) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Report a -> a
reportStatus forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Maybe Seed
-> Property
-> m (Report Result)
checkNamed Region
region UseColor
color forall a. Maybe a
Nothing forall a. Maybe a
Nothing Property
prop

-- | Check a property using a specific size and seed.
--
recheck :: MonadIO m => Size -> Seed -> Property -> m ()
recheck :: forall (m :: * -> *). MonadIO m => Size -> Seed -> Property -> m ()
recheck Size
size Seed
seed Property
prop0 = do
  UseColor
color <- forall (m :: * -> *). MonadIO m => m UseColor
detectColor
  let prop :: Property
prop = TestLimit -> Property -> Property
withTests TestLimit
1 Property
prop0
  Report Result
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m, LiftRegion m) =>
(Region -> m a) -> m a
displayRegion forall a b. (a -> b) -> a -> b
$ \Region
region ->
    forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Size
-> Seed
-> Property
-> m (Report Result)
checkRegion Region
region UseColor
color forall a. Maybe a
Nothing Size
size Seed
seed Property
prop
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

recheckAt :: MonadIO m => Seed -> Skip -> Property -> m ()
recheckAt :: forall (m :: * -> *). MonadIO m => Seed -> Skip -> Property -> m ()
recheckAt Seed
seed Skip
skip Property
prop0 = do
  UseColor
color <- forall (m :: * -> *). MonadIO m => m UseColor
detectColor
  let prop :: Property
prop = Skip -> Property -> Property
withSkip Skip
skip Property
prop0
  Report Result
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a.
(MonadIO m, MonadMask m, LiftRegion m) =>
(Region -> m a) -> m a
displayRegion forall a b. (a -> b) -> a -> b
$ \Region
region ->
    forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Size
-> Seed
-> Property
-> m (Report Result)
checkRegion Region
region UseColor
color forall a. Maybe a
Nothing Size
0 Seed
seed Property
prop
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Check a group of properties using the specified runner config.
--
checkGroup :: MonadIO m => RunnerConfig -> Group -> m Bool
checkGroup :: forall (m :: * -> *). MonadIO m => RunnerConfig -> Group -> m Bool
checkGroup RunnerConfig
config (Group GroupName
group [(PropertyName, Property)]
props) =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    WorkerCount
n <- forall (m :: * -> *).
MonadIO m =>
Maybe WorkerCount -> m WorkerCount
resolveWorkers (RunnerConfig -> Maybe WorkerCount
runnerWorkers RunnerConfig
config)

    -- ensure few spare capabilities for concurrent-output, it's likely that
    -- our tests will saturate all the capabilities they're given.
    WorkerCount -> IO ()
updateNumCapabilities (WorkerCount
n forall a. Num a => a -> a -> a
+ WorkerCount
2)

#if mingw32_HOST_OS
    hSetEncoding stdout utf8
    hSetEncoding stderr utf8
#endif

    String -> IO ()
putStrLn forall a b. (a -> b) -> a -> b
$ String
"━━━ " forall a. [a] -> [a] -> [a]
++ GroupName -> String
unGroupName GroupName
group forall a. [a] -> [a] -> [a]
++ String
" ━━━"

    Seed
seed <- forall (m :: * -> *). MonadIO m => Maybe Seed -> m Seed
resolveSeed (RunnerConfig -> Maybe Seed
runnerSeed RunnerConfig
config)
    Verbosity
verbosity <- forall (m :: * -> *). MonadIO m => Maybe Verbosity -> m Verbosity
resolveVerbosity (RunnerConfig -> Maybe Verbosity
runnerVerbosity RunnerConfig
config)
    UseColor
color <- forall (m :: * -> *). MonadIO m => Maybe UseColor -> m UseColor
resolveColor (RunnerConfig -> Maybe UseColor
runnerColor RunnerConfig
config)
    Summary
summary <- WorkerCount
-> Verbosity
-> UseColor
-> Seed
-> [(PropertyName, Property)]
-> IO Summary
checkGroupWith WorkerCount
n Verbosity
verbosity UseColor
color Seed
seed [(PropertyName, Property)]
props

    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
      Summary -> PropertyCount
summaryFailed Summary
summary forall a. Eq a => a -> a -> Bool
== PropertyCount
0 Bool -> Bool -> Bool
&&
      Summary -> PropertyCount
summaryGaveUp Summary
summary forall a. Eq a => a -> a -> Bool
== PropertyCount
0

updateSummary :: Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary :: Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary Region
sregion TVar Summary
svar UseColor
color Summary -> Summary
f = do
  Summary
summary <- forall a. STM a -> IO a
atomically (forall a. TVar a -> (a -> a) -> STM ()
TVar.modifyTVar' TVar Summary
svar Summary -> Summary
f forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. TVar a -> STM a
TVar.readTVar TVar Summary
svar)
  forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
setRegion Region
sregion forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). MonadIO m => UseColor -> Summary -> m String
renderSummary UseColor
color Summary
summary

checkGroupWith ::
     WorkerCount
  -> Verbosity
  -> UseColor
  -> Seed
  -> [(PropertyName, Property)]
  -> IO Summary
checkGroupWith :: WorkerCount
-> Verbosity
-> UseColor
-> Seed
-> [(PropertyName, Property)]
-> IO Summary
checkGroupWith WorkerCount
n Verbosity
verbosity UseColor
color Seed
seed [(PropertyName, Property)]
props =
  forall (m :: * -> *) a.
(MonadIO m, MonadMask m, LiftRegion m) =>
(Region -> m a) -> m a
displayRegion forall a b. (a -> b) -> a -> b
$ \Region
sregion -> do
    TVar Summary
svar <- forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> STM (TVar a)
TVar.newTVar forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty { summaryWaiting :: PropertyCount
summaryWaiting = Int -> PropertyCount
PropertyCount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [(PropertyName, Property)]
props) }

    let
      start :: TasksRemaining -> p -> (a, b) -> m (a, b, Region)
start (TasksRemaining Int
tasks) p
_ix (a
name, b
prop) =
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
          Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary Region
sregion TVar Summary
svar UseColor
color forall a b. (a -> b) -> a -> b
$ \Summary
x -> Summary
x {
              summaryWaiting :: PropertyCount
summaryWaiting =
                Int -> PropertyCount
PropertyCount Int
tasks
            , summaryRunning :: PropertyCount
summaryRunning =
                Summary -> PropertyCount
summaryRunning Summary
x forall a. Num a => a -> a -> a
+ PropertyCount
1
            }

          forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
            Region
region <-
              case Verbosity
verbosity of
                Verbosity
Quiet ->
                  forall (m :: * -> *). LiftRegion m => m Region
newEmptyRegion
                Verbosity
Normal ->
                  forall (m :: * -> *). LiftRegion m => m Region
newOpenRegion

            Region -> STM ()
moveToBottom Region
sregion

            forall (f :: * -> *) a. Applicative f => a -> f a
pure (a
name, b
prop, Region
region)

      finish :: (a, b, c) -> IO ()
finish (a
_name, b
_prop, c
_region) =
        Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary Region
sregion TVar Summary
svar UseColor
color forall a b. (a -> b) -> a -> b
$ \Summary
x -> Summary
x {
            summaryRunning :: PropertyCount
summaryRunning =
              Summary -> PropertyCount
summaryRunning Summary
x forall a. Num a => a -> a -> a
- PropertyCount
1
          }

      finalize :: (a, b, Region) -> m ()
finalize (a
_name, b
_prop, Region
region) =
        forall (m :: * -> *). LiftRegion m => Region -> m ()
finishRegion Region
region

    Summary
summary <-
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Result -> Summary
fromResult forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Report a -> a
reportStatus)) forall a b. (a -> b) -> a -> b
$
        forall a b c.
WorkerCount
-> [a]
-> (TasksRemaining -> TaskIndex -> a -> IO b)
-> (b -> IO ())
-> (b -> IO ())
-> (b -> IO c)
-> IO [c]
runTasks WorkerCount
n [(PropertyName, Property)]
props forall {m :: * -> *} {p} {a} {b}.
MonadIO m =>
TasksRemaining -> p -> (a, b) -> m (a, b, Region)
start forall {a} {b} {c}. (a, b, c) -> IO ()
finish forall {m :: * -> *} {a} {b}.
LiftRegion m =>
(a, b, Region) -> m ()
finalize forall a b. (a -> b) -> a -> b
$ \(PropertyName
name, Property
prop, Region
region) -> do
          Report Result
result <- forall (m :: * -> *).
MonadIO m =>
Region
-> UseColor
-> Maybe PropertyName
-> Maybe Seed
-> Property
-> m (Report Result)
checkNamed Region
region UseColor
color (forall a. a -> Maybe a
Just PropertyName
name) (forall a. a -> Maybe a
Just Seed
seed) Property
prop
          Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary Region
sregion TVar Summary
svar UseColor
color
            (forall a. Semigroup a => a -> a -> a
<> Result -> Summary
fromResult (forall a. Report a -> a
reportStatus Report Result
result))
          forall (f :: * -> *) a. Applicative f => a -> f a
pure Report Result
result

    Region -> TVar Summary -> UseColor -> (Summary -> Summary) -> IO ()
updateSummary Region
sregion TVar Summary
svar UseColor
color (forall a b. a -> b -> a
const Summary
summary)
    forall (f :: * -> *) a. Applicative f => a -> f a
pure Summary
summary

-- | Check a group of properties sequentially.
--
--   Using Template Haskell for property discovery:
--
-- > tests :: IO Bool
-- > tests =
-- >   checkSequential $$(discover)
--
--   With manually specified properties:
--
-- > tests :: IO Bool
-- > tests =
-- >   checkSequential $ Group "Test.Example" [
-- >       ("prop_reverse", prop_reverse)
-- >     ]
--
--
checkSequential :: MonadIO m => Group -> m Bool
checkSequential :: forall (m :: * -> *). MonadIO m => Group -> m Bool
checkSequential =
  forall (m :: * -> *). MonadIO m => RunnerConfig -> Group -> m Bool
checkGroup
    RunnerConfig {
        runnerWorkers :: Maybe WorkerCount
runnerWorkers =
          forall a. a -> Maybe a
Just WorkerCount
1
      , runnerColor :: Maybe UseColor
runnerColor =
          forall a. Maybe a
Nothing
      , runnerSeed :: Maybe Seed
runnerSeed =
          forall a. Maybe a
Nothing
      , runnerVerbosity :: Maybe Verbosity
runnerVerbosity =
          forall a. Maybe a
Nothing
      }

-- | Check a group of properties in parallel.
--
--   /Warning: although this check function runs tests faster than/
--   /'checkSequential', it should be noted that it may cause problems with/
--   /properties that are not self-contained. For example, if you have a group/
--   /of tests which all use the same database table, you may find that they/
--   /interfere with each other when being run in parallel./
--
--   Using Template Haskell for property discovery:
--
-- > tests :: IO Bool
-- > tests =
-- >   checkParallel $$(discover)
--
--   With manually specified properties:
--
-- > tests :: IO Bool
-- > tests =
-- >   checkParallel $ Group "Test.Example" [
-- >       ("prop_reverse", prop_reverse)
-- >     ]
--
checkParallel :: MonadIO m => Group -> m Bool
checkParallel :: forall (m :: * -> *). MonadIO m => Group -> m Bool
checkParallel =
  forall (m :: * -> *). MonadIO m => RunnerConfig -> Group -> m Bool
checkGroup
    RunnerConfig {
        runnerWorkers :: Maybe WorkerCount
runnerWorkers =
          forall a. Maybe a
Nothing
      , runnerColor :: Maybe UseColor
runnerColor =
          forall a. Maybe a
Nothing
      , runnerSeed :: Maybe Seed
runnerSeed =
          forall a. Maybe a
Nothing
      , runnerVerbosity :: Maybe Verbosity
runnerVerbosity =
          forall a. Maybe a
Nothing
      }