    {-# 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
    (RunnerConfig -> RunnerConfig -> Bool)
    -> (RunnerConfig -> RunnerConfig -> Bool) -> Eq RunnerConfig
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: RunnerConfig -> RunnerConfig -> Bool
    == :: RunnerConfig -> RunnerConfig -> Bool
    $c/= :: RunnerConfig -> RunnerConfig -> Bool
    /= :: RunnerConfig -> RunnerConfig -> Bool
    Eq, Eq RunnerConfig
    Eq RunnerConfig =>
    (RunnerConfig -> RunnerConfig -> Ordering)
    -> (RunnerConfig -> RunnerConfig -> Bool)
    -> (RunnerConfig -> RunnerConfig -> Bool)
    -> (RunnerConfig -> RunnerConfig -> Bool)
    -> (RunnerConfig -> RunnerConfig -> Bool)
    -> (RunnerConfig -> RunnerConfig -> RunnerConfig)
    -> (RunnerConfig -> RunnerConfig -> RunnerConfig)
    -> Ord 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
    $ccompare :: RunnerConfig -> RunnerConfig -> Ordering
    compare :: RunnerConfig -> RunnerConfig -> Ordering
    $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
    >= :: RunnerConfig -> RunnerConfig -> Bool
    $cmax :: RunnerConfig -> RunnerConfig -> RunnerConfig
    max :: RunnerConfig -> RunnerConfig -> RunnerConfig
    $cmin :: RunnerConfig -> RunnerConfig -> RunnerConfig
    min :: RunnerConfig -> RunnerConfig -> RunnerConfig
    Ord, Int -> RunnerConfig -> ShowS
    [RunnerConfig] -> ShowS
    RunnerConfig -> String
    (Int -> RunnerConfig -> ShowS)
    -> (RunnerConfig -> String)
    -> ([RunnerConfig] -> ShowS)
    -> Show RunnerConfig
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> RunnerConfig -> ShowS
    showsPrec :: Int -> RunnerConfig -> ShowS
    $cshow :: RunnerConfig -> String
    show :: RunnerConfig -> String
    $cshowList :: [RunnerConfig] -> ShowS
    showList :: [RunnerConfig] -> ShowS
    Show, (forall (m :: * -> *). Quote m => RunnerConfig -> m Exp)
    -> (forall (m :: * -> *).
        Quote m =>
        RunnerConfig -> Code m RunnerConfig)
    -> Lift RunnerConfig
    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
    $clift :: forall (m :: * -> *). Quote m => RunnerConfig -> m Exp
    lift :: forall (m :: * -> *). Quote m => RunnerConfig -> m Exp
    $cliftTyped :: forall (m :: * -> *).
    Quote m =>
    RunnerConfig -> Code m RunnerConfig
    liftTyped :: forall (m :: * -> *).
    Quote m =>
    RunnerConfig -> Code m RunnerConfig
    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
        [] ->
          b -> m b
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    def
        a
    x0 : [a]
    xs ->
          a -> m (Maybe b)
    p a
    x0 m (Maybe b) -> (Maybe b -> m b) -> m b
    forall a b. m a -> (a -> m b) -> m b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Maybe b
    m ->
            case Maybe b
    m of
              Maybe b
    Nothing ->
                [a] -> b -> (a -> m (Maybe b)) -> m b
    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 ->
                b -> m b
    forall a. a -> m a
    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 (Bool -> Bool)
    -> (NodeT m (Maybe (Either x a, b)) -> Bool)
    -> NodeT m (Maybe (Either x a, b))
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NodeT m (Maybe (Either x a, b)) -> Bool
    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
      o <- TreeT m (Maybe (Either x a, b))
    -> m (NodeT m (Maybe (Either x a, b)))
    forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
    runTreeT TreeT m (Maybe (Either x a, b))
    m
      if n > 0 && isSuccess o then
        runTreeN (n - 1) m
      else
        pure 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))]
    _ ->
            Result -> m Result
    forall a. a -> m a
    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 ([Int] -> ShrinkPath) -> [Int] -> ShrinkPath
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [Int]
    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 Maybe (Coverage CoverCount)
    forall a. Maybe a
    Nothing Maybe Span
    loc String
    err Maybe Diff
    mdiff ([Log] -> [Log]
    forall a. [a] -> [a]
    reverse [Log]
    logs)

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

                if ShrinkCount
    shrinks ShrinkCount -> ShrinkCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= ShrinkLimit -> ShrinkCount
    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
                  Result -> m Result
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Result -> m Result) -> Result -> m Result
    forall a b. (a -> b) -> a -> b
    $ FailureReport -> Result
    Failed FailureReport
    failure
                else
                  [(Int, TreeT m (Maybe (Either Failure (), Journal)))]
    -> Result
    -> ((Int, TreeT m (Maybe (Either Failure (), Journal)))
        -> m (Maybe Result))
    -> m Result
    forall (m :: * -> *) a b.
    Monad m =>
    [a] -> b -> (a -> m (Maybe b)) -> m b
    findM ([Int]
    -> [TreeT m (Maybe (Either Failure (), Journal))]
    -> [(Int, TreeT m (Maybe (Either Failure (), Journal)))]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] [TreeT m (Maybe (Either Failure (), Journal))]
    xs) (FailureReport -> Result
    Failed FailureReport
    failure) (((Int, TreeT m (Maybe (Either Failure (), Journal)))
      -> m (Maybe Result))
     -> m Result)
    -> ((Int, TreeT m (Maybe (Either Failure (), Journal)))
        -> m (Maybe Result))
    -> m Result
    forall a b. (a -> b) -> a -> b
    $ \(Int
    n, TreeT m (Maybe (Either Failure (), Journal))
    m) -> do
                    o <- ShrinkRetries
    -> TreeT m (Maybe (Either Failure (), Journal))
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    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 isFailure o then
                      Just <$> loop (shrinks + 1) (n : revShrinkPath) o
                    else
                      return Nothing

              Right () ->
                Result -> m Result
    forall a. a -> m a
    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 ([Int] -> [Int]
    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))]
    _ ->
            Result -> m Result
    forall a. a -> m a
    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) Maybe (Coverage CoverCount)
    forall a. Maybe a
    Nothing Maybe Span
    loc String
    err Maybe Diff
    mdiff ([Log] -> [Log]
    forall a. [a] -> [a]
    reverse [Log]
    logs)

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

              Right () ->
                Result -> m Result
    forall a. a -> m a
    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 Int
    -> [TreeT m (Maybe (Either Failure (), Journal))]
    -> [TreeT m (Maybe (Either Failure (), Journal))]
    forall a. Int -> [a] -> [a]
    drop Int
    s0 [TreeT m (Maybe (Either Failure (), Journal))]
    xs of
              [] ->
                Result -> m Result
    forall a. a -> m a
    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
                o <- TreeT m (Maybe (Either Failure (), Journal))
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
    runTreeT TreeT m (Maybe (Either Failure (), Journal))
    x
                loop (shrinks + 1) ss 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 <- IO Skip -> m Skip
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Skip -> m Skip) -> IO Skip -> m Skip
    forall a b. (a -> b) -> a -> b
    $ Maybe Skip -> IO Skip
    forall (m :: * -> *). MonadIO m => Maybe Skip -> m Skip
    resolveSkip (Maybe Skip -> IO Skip) -> Maybe Skip -> IO Skip
    forall a b. (a -> b) -> a -> b
    $ PropertyConfig -> Maybe Skip
    propertySkip PropertyConfig
    cfg

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

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

        terminationCriteria =
          PropertyConfig -> TerminationCriteria
    propertyTerminationCriteria PropertyConfig
    cfg

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

        successVerified TestCount
    count Coverage CoverCount
    coverage =
          TestCount
    count TestCount -> TestCount -> TestCount
    forall a. Integral a => a -> a -> a
    `mod` TestCount
    100 TestCount -> TestCount -> Bool
    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
          Bool -> (Confidence -> Bool) -> Maybe Confidence -> Bool
    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
    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 TestCount -> TestCount -> TestCount
    forall a. Integral a => a -> a -> a
    `mod` TestCount
    100 TestCount -> TestCount -> Bool
    forall a. Eq a => a -> a -> Bool
    == TestCount
    0 Bool -> Bool -> Bool
    &&
          Bool -> (Confidence -> Bool) -> Maybe Confidence -> 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
    tests !DiscardCount
    discards !Size
    size !Seed
    seed !Coverage CoverCount
    coverage0 = do
          Report Progress -> m ()
    updateUI (Report Progress -> m ()) -> Report Progress -> m ()
    forall a b. (a -> b) -> a -> b
    $ TestCount
    -> DiscardCount
    -> Coverage CoverCount
    -> Seed
    -> Progress
    -> Report Progress
    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 TestCount -> TestCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= TestLimit -> TestCount
    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 TestCount -> TestCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= TestLimit -> TestCount
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral TestLimit
    minTests
                NoConfidenceTermination TestLimit
    _ ->
                  TestCount
    tests TestCount -> TestCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= TestLimit -> TestCount
    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 =
              TestCount
    -> DiscardCount
    -> Coverage CoverCount
    -> Seed
    -> Result
    -> Report Result
    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 =
              TestCount
    -> DiscardCount
    -> Coverage CoverCount
    -> Seed
    -> Result
    -> Report Result
    forall a.
    TestCount
    -> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
    Report TestCount
    tests DiscardCount
    discards Coverage CoverCount
    coverage0 Seed
    seed0 (Result -> Report Result)
    -> (FailureReport -> Result) -> FailureReport -> Report Result
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . FailureReport -> Result
    Failed (FailureReport -> Report Result) -> FailureReport -> Report Result
    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 [])
                (Coverage CoverCount -> Maybe (Coverage CoverCount)
    forall a. a -> Maybe a
    Just Coverage CoverCount
    coverage0)
                Maybe Span
    forall a. Maybe a
    Nothing
                String
    message
                Maybe Diff
    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 (String -> Report Result) -> String -> Report Result
    forall a b. (a -> b) -> a -> b
    $
                  String
    "Test coverage cannot be reached after " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TestCount -> String
    forall a. Show a => a -> String
    show TestCount
    tests String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " tests"

          if Size
    size Size -> Size -> Bool
    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 Maybe (TestCount, DiscardCount) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (TestCount, DiscardCount)
    mSkipToTest then
              Report Result -> m (Report Result)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Report Result
    successReport
            else
              Report Result -> m (Report Result)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Report Result -> m (Report Result))
    -> Report Result -> m (Report Result)
    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 (String -> Report Result) -> String -> Report Result
    forall a b. (a -> b) -> a -> b
    $
                      String
    "Labels not sufficiently covered after " String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> TestCount -> String
    forall a. Show a => a -> String
    show TestCount
    tests String -> ShowS
    forall a. Semigroup a => a -> a -> a
    <> String
    " tests"

          else if DiscardCount
    discards DiscardCount -> DiscardCount -> Bool
    forall a. Ord a => a -> a -> Bool
    >= DiscardLimit -> DiscardCount
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (PropertyConfig -> DiscardLimit
    propertyDiscardLimit PropertyConfig
    cfg) then
            -- we've hit the discard limit, give up
            Report Result -> m (Report Result)
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Report Result -> m (Report Result))
    -> Report Result -> m (Report Result)
    forall a b. (a -> b) -> a -> b
    $ TestCount
    -> DiscardCount
    -> Coverage CoverCount
    -> Seed
    -> Result
    -> Report Result
    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 TestCount -> TestCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > TestCount
    tests TestCount -> TestCount -> TestCount
    forall a. Num a => a -> a -> a
    + TestCount
    1 ->
                    TestCount
    -> DiscardCount
    -> Size
    -> Seed
    -> Coverage CoverCount
    -> m (Report Result)
    loop (TestCount
    tests TestCount -> TestCount -> TestCount
    forall a. Num a => a -> a -> a
    + TestCount
    1) DiscardCount
    discards (Size
    size Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Size
    1) Seed
    s1 Coverage CoverCount
    coverage0
                  | DiscardCount
    d DiscardCount -> DiscardCount -> Bool
    forall a. Ord a => a -> a -> Bool
    > DiscardCount
    discards ->
                    TestCount
    -> DiscardCount
    -> Size
    -> Seed
    -> Coverage CoverCount
    -> m (Report Result)
    loop TestCount
    tests (DiscardCount
    discards DiscardCount -> DiscardCount -> DiscardCount
    forall a. Num a => a -> a -> a
    + DiscardCount
    1) (Size
    size Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Size
    1) Seed
    s1 Coverage CoverCount
    coverage0
                (Just (TestCount, DiscardCount)
    _, Just ShrinkPath
    shrinkPath) -> do
                  node <-
                    TreeT m (Maybe (Either Failure (), Journal))
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
    runTreeT (TreeT m (Maybe (Either Failure (), Journal))
     -> m (NodeT m (Maybe (Either Failure (), Journal))))
    -> (TestT (GenT m) ()
        -> TreeT m (Maybe (Either Failure (), Journal)))
    -> TestT (GenT m) ()
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Size
    -> Seed
    -> GenT m (Either Failure (), Journal)
    -> TreeT m (Maybe (Either Failure (), Journal))
    forall (m :: * -> *) a.
    Monad m =>
    Size -> Seed -> GenT m a -> TreeT m (Maybe a)
    evalGenT Size
    size Seed
    s0 (GenT m (Either Failure (), Journal)
     -> TreeT m (Maybe (Either Failure (), Journal)))
    -> (TestT (GenT m) () -> GenT m (Either Failure (), Journal))
    -> TestT (GenT m) ()
    -> TreeT m (Maybe (Either Failure (), Journal))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestT (GenT m) () -> GenT m (Either Failure (), Journal)
    forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
    runTestT (TestT (GenT m) ()
     -> m (NodeT m (Maybe (Either Failure (), Journal))))
    -> TestT (GenT m) ()
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall a b. (a -> b) -> a -> b
    $ PropertyT m () -> TestT (GenT m) ()
    forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
    unPropertyT PropertyT m ()
    test
                  let
                    mkReport =
                      TestCount
    -> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
    forall a.
    TestCount
    -> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
    Report (TestCount
    tests TestCount -> TestCount -> TestCount
    forall a. Num a => a -> a -> a
    + TestCount
    1) DiscardCount
    discards Coverage CoverCount
    coverage0 Seed
    seed0
                  mkReport <$> skipToShrink shrinkPath (updateUI . mkReport) node
                (Maybe (TestCount, DiscardCount), Maybe ShrinkPath)
    _ -> do
                  node@(NodeT x _) <-
                    TreeT m (Maybe (Either Failure (), Journal))
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall (m :: * -> *) a. TreeT m a -> m (NodeT m a)
    runTreeT (TreeT m (Maybe (Either Failure (), Journal))
     -> m (NodeT m (Maybe (Either Failure (), Journal))))
    -> (TestT (GenT m) ()
        -> TreeT m (Maybe (Either Failure (), Journal)))
    -> TestT (GenT m) ()
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Size
    -> Seed
    -> GenT m (Either Failure (), Journal)
    -> TreeT m (Maybe (Either Failure (), Journal))
    forall (m :: * -> *) a.
    Monad m =>
    Size -> Seed -> GenT m a -> TreeT m (Maybe a)
    evalGenT Size
    size Seed
    s0 (GenT m (Either Failure (), Journal)
     -> TreeT m (Maybe (Either Failure (), Journal)))
    -> (TestT (GenT m) () -> GenT m (Either Failure (), Journal))
    -> TestT (GenT m) ()
    -> TreeT m (Maybe (Either Failure (), Journal))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestT (GenT m) () -> GenT m (Either Failure (), Journal)
    forall (m :: * -> *) a. TestT m a -> m (Either Failure a, Journal)
    runTestT (TestT (GenT m) ()
     -> m (NodeT m (Maybe (Either Failure (), Journal))))
    -> TestT (GenT m) ()
    -> m (NodeT m (Maybe (Either Failure (), Journal)))
    forall a b. (a -> b) -> a -> b
    $ PropertyT m () -> TestT (GenT m) ()
    forall (m :: * -> *) a. PropertyT m a -> TestT (GenT m) a
    unPropertyT PropertyT m ()
    test
                  case x of
                    Maybe (Either Failure (), Journal)
    Nothing ->
                      TestCount
    -> DiscardCount
    -> Size
    -> Seed
    -> Coverage CoverCount
    -> m (Report Result)
    loop TestCount
    tests (DiscardCount
    discards DiscardCount -> DiscardCount -> DiscardCount
    forall a. Num a => a -> a -> a
    + DiscardCount
    1) (Size
    size Size -> 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 =
                          TestCount
    -> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
    forall a.
    TestCount
    -> DiscardCount -> Coverage CoverCount -> Seed -> a -> Report a
    Report (TestCount
    tests TestCount -> TestCount -> TestCount
    forall a. Num a => a -> a -> a
    + TestCount
    1) DiscardCount
    discards Coverage CoverCount
    coverage0 Seed
    seed0
                      in
                        (Result -> Report Result) -> m Result -> m (Report Result)
    forall a b. (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Result -> Report Result
    forall {a}. a -> Report a
    mkReport (m Result -> m (Report Result)) -> m Result -> m (Report Result)
    forall a b. (a -> b) -> a -> b
    $
                          ShrinkCount
    -> ShrinkPath
    -> ShrinkLimit
    -> ShrinkRetries
    -> (Progress -> m ())
    -> NodeT m (Maybe (Either Failure (), Journal))
    -> m Result
    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 (Report Progress -> m ())
    -> (Progress -> Report Progress) -> Progress -> m ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Progress -> Report Progress
    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 Coverage CoverCount -> Coverage CoverCount -> Coverage CoverCount
    forall a. Semigroup a => a -> a -> a
    <> Coverage CoverCount
    coverage0
                      in
                        TestCount
    -> DiscardCount
    -> Size
    -> Seed
    -> Coverage CoverCount
    -> m (Report Result)
    loop (TestCount
    tests TestCount -> TestCount -> TestCount
    forall a. Num a => a -> a -> a
    + TestCount
    1) DiscardCount
    discards (Size
    size Size -> Size -> Size
    forall a. Num a => a -> a -> a
    + Size
    1) Seed
    s1 Coverage CoverCount
    coverage

      loop 0 0 size0 seed0 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 =
      IO (Report Result) -> m (Report Result)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Report Result) -> m (Report Result))
    -> IO (Report Result) -> m (Report Result)
    forall a b. (a -> b) -> a -> b
    $ do
        result <-
          PropertyConfig
    -> Size
    -> Seed
    -> PropertyT IO ()
    -> (Report Progress -> IO ())
    -> IO (Report 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) ((Report Progress -> IO ()) -> IO (Report Result))
    -> (Report Progress -> IO ()) -> IO (Report Result)
    forall a b. (a -> b) -> a -> b
    $ \Report Progress
    progress -> do
            ppprogress <- UseColor -> Maybe PropertyName -> Report Progress -> IO String
    forall (m :: * -> *).
    MonadIO m =>
    UseColor -> Maybe PropertyName -> Report Progress -> m String
    renderProgress UseColor
    color Maybe PropertyName
    name Report Progress
    progress
            case reportStatus progress of
              Progress
    Running ->
                Region -> String -> IO ()
    forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
    setRegion Region
    region String
    ppprogress
              Shrinking FailureReport
    _ ->
                Region -> String -> IO ()
    forall (m :: * -> *). LiftRegion m => Region -> String -> m ()
    openRegion Region
    region String
    ppprogress

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

        pure 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 <- Maybe Seed -> m Seed
    forall (m :: * -> *). MonadIO m => Maybe Seed -> m Seed
    resolveSeed Maybe Seed
    mseed
      checkRegion region color name 0 seed prop

    -- | Check a property.
    --
    check :: MonadIO m => Property -> m Bool
    check :: forall (m :: * -> *). MonadIO m => Property -> m Bool
    check Property
    prop = do
      color <- m UseColor
    forall (m :: * -> *). MonadIO m => m UseColor
    detectColor
      liftIO . displayRegion $ \Region
    region ->
        (Result -> Result -> Bool
    forall a. Eq a => a -> a -> Bool
    == Result
    OK) (Result -> Bool)
    -> (Report Result -> Result) -> Report Result -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Report Result -> Result
    forall a. Report a -> a
    reportStatus (Report Result -> Bool) -> IO (Report Result) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Region
    -> UseColor
    -> Maybe PropertyName
    -> Maybe Seed
    -> Property
    -> IO (Report Result)
    forall (m :: * -> *).
    MonadIO m =>
    Region
    -> UseColor
    -> Maybe PropertyName
    -> Maybe Seed
    -> Property
    -> m (Report Result)
    checkNamed Region
    region UseColor
    color Maybe PropertyName
    forall a. Maybe a
    Nothing Maybe Seed
    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
      color <- m UseColor
    forall (m :: * -> *). MonadIO m => m UseColor
    detectColor
      let prop = TestLimit -> Property -> Property
    withTests TestLimit
    1 Property
    prop0
      _ <- liftIO . displayRegion $ \Region
    region ->
        Region
    -> UseColor
    -> Maybe PropertyName
    -> Size
    -> Seed
    -> Property
    -> IO (Report Result)
    forall (m :: * -> *).
    MonadIO m =>
    Region
    -> UseColor
    -> Maybe PropertyName
    -> Size
    -> Seed
    -> Property
    -> m (Report Result)
    checkRegion Region
    region UseColor
    color Maybe PropertyName
    forall a. Maybe a
    Nothing Size
    size Seed
    seed Property
    prop
      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
      color <- m UseColor
    forall (m :: * -> *). MonadIO m => m UseColor
    detectColor
      let prop = Skip -> Property -> Property
    withSkip Skip
    skip Property
    prop0
      _ <- liftIO . displayRegion $ \Region
    region ->
        Region
    -> UseColor
    -> Maybe PropertyName
    -> Size
    -> Seed
    -> Property
    -> IO (Report Result)
    forall (m :: * -> *).
    MonadIO m =>
    Region
    -> UseColor
    -> Maybe PropertyName
    -> Size
    -> Seed
    -> Property
    -> m (Report Result)
    checkRegion Region
    region UseColor
    color Maybe PropertyName
    forall a. Maybe a
    Nothing Size
    0 Seed
    seed Property
    prop
      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) =
      IO Bool -> m Bool
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
    forall a b. (a -> b) -> a -> b
    $ do
        n <- Maybe WorkerCount -> IO WorkerCount
    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.
        updateNumCapabilities (n + 2)

    #if mingw32_HOST_OS
        hSetEncoding stdout utf8
        hSetEncoding stderr utf8
    #endif

        putStrLn $ "━━━ " ++ unGroupName group ++ " ━━━"

        seed <- resolveSeed (runnerSeed config)
        verbosity <- resolveVerbosity (runnerVerbosity config)
        color <- resolveColor (runnerColor config)
        summary <- checkGroupWith n verbosity color seed props

        pure $
          summaryFailed summary == 0 &&
          summaryGaveUp summary == 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 <- STM Summary -> IO Summary
    forall a. STM a -> IO a
    atomically (TVar Summary -> (Summary -> Summary) -> STM ()
    forall a. TVar a -> (a -> a) -> STM ()
    TVar.modifyTVar' TVar Summary
    svar Summary -> Summary
    f STM () -> STM Summary -> STM Summary
    forall a b. STM a -> STM b -> STM b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> TVar Summary -> STM Summary
    forall a. TVar a -> STM a
    TVar.readTVar TVar Summary
    svar)
      setRegion sregion =<< renderSummary color 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 =
      (Region -> IO Summary) -> IO Summary
    forall (m :: * -> *) a.
    (MonadIO m, MonadMask m, LiftRegion m) =>
    (Region -> m a) -> m a
    displayRegion ((Region -> IO Summary) -> IO Summary)
    -> (Region -> IO Summary) -> IO Summary
    forall a b. (a -> b) -> a -> b
    $ \Region
    sregion -> do
        svar <- STM (TVar Summary) -> IO (TVar Summary)
    forall a. STM a -> IO a
    atomically (STM (TVar Summary) -> IO (TVar Summary))
    -> (Summary -> STM (TVar Summary)) -> Summary -> IO (TVar Summary)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Summary -> STM (TVar Summary)
    forall a. a -> STM (TVar a)
    TVar.newTVar (Summary -> IO (TVar Summary)) -> Summary -> IO (TVar Summary)
    forall a b. (a -> b) -> a -> b
    $ Summary
    forall a. Monoid a => a
    mempty { summaryWaiting = PropertyCount (length props) }

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

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

                moveToBottom sregion

                pure (name, prop, region)

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

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

        summary <-
          fmap (mconcat . fmap (fromResult . reportStatus)) $
            runTasks n props start finish finalize $ \(PropertyName
    name, Property
    prop, Region
    region) -> do
              result <- Region
    -> UseColor
    -> Maybe PropertyName
    -> Maybe Seed
    -> Property
    -> IO (Report Result)
    forall (m :: * -> *).
    MonadIO m =>
    Region
    -> UseColor
    -> Maybe PropertyName
    -> Maybe Seed
    -> Property
    -> m (Report Result)
    checkNamed Region
    region UseColor
    color (PropertyName -> Maybe PropertyName
    forall a. a -> Maybe a
    Just PropertyName
    name) (Seed -> Maybe Seed
    forall a. a -> Maybe a
    Just Seed
    seed) Property
    prop
              updateSummary sregion svar color
                (<> fromResult (reportStatus result))
              pure result

        updateSummary sregion svar color (const summary)
        pure 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 =
      RunnerConfig -> Group -> m Bool
    forall (m :: * -> *). MonadIO m => RunnerConfig -> Group -> m Bool
    checkGroup
        RunnerConfig {
            runnerWorkers :: Maybe WorkerCount
    runnerWorkers =
              WorkerCount -> Maybe WorkerCount
    forall a. a -> Maybe a
    Just WorkerCount
    1
          , runnerColor :: Maybe UseColor
    runnerColor =
              Maybe UseColor
    forall a. Maybe a
    Nothing
          , runnerSeed :: Maybe Seed
    runnerSeed =
              Maybe Seed
    forall a. Maybe a
    Nothing
          , runnerVerbosity :: Maybe Verbosity
    runnerVerbosity =
              Maybe Verbosity
    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 =
      RunnerConfig -> Group -> m Bool
    forall (m :: * -> *). MonadIO m => RunnerConfig -> Group -> m Bool
    checkGroup
        RunnerConfig {
            runnerWorkers :: Maybe WorkerCount
    runnerWorkers =
              Maybe WorkerCount
    forall a. Maybe a
    Nothing
          , runnerColor :: Maybe UseColor
    runnerColor =
              Maybe UseColor
    forall a. Maybe a
    Nothing
          , runnerSeed :: Maybe Seed
    runnerSeed =
              Maybe Seed
    forall a. Maybe a
    Nothing
          , runnerVerbosity :: Maybe Verbosity
    runnerVerbosity =
              Maybe Verbosity
    forall a. Maybe a
    Nothing
          }