    {-# OPTIONS_GHC -fno-warn-deprecations #-}
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    -- |
    -- Stability: provisional
    module Test.Hspec.Core.Runner (
    -- * Simple interface
      hspec
    , hspecWith
    , hspecResult
    , hspecWithResult

    -- ** Summary
    , Summary (..)
    , isSuccess
    , evaluateSummary

    -- * Running a spec
    {- |
    To run a spec `hspec` performs a sequence of steps:

    1. Evaluate a `Spec` to a forest of `SpecTree`s
    1. Read config values from the command-line, config files and the process environment
    1. Execute each spec item of the forest and report results to `stdout`
    1. Exit with `exitFailure` if at least on spec item fails

    The four primitives `evalSpec`, `readConfig`, `runSpecForest` and
    `evaluateResult` each perform one of these steps respectively.

    `hspec` is defined in terms of these primitives. Loosely speaking, a definition
    for @hspec@ is:

    @
    hspec = `evalSpec` `defaultConfig` >=> \\ (config, spec) ->
          `getArgs`
      >>= `readConfig` config
      >>= `withArgs` [] . `runSpecForest` spec
      >>= `evaluateResult`
    @

    Loosely speaking in the sense that this definition of @hspec@ ignores
    @--rerun-all-on-success@.

    Using these primitives individually gives you more control over how a spec is
    run.  However, if you need support for @--rerun-all-on-success@ then you should
    try hard to solve your use case with one of `hspec`, `hspecWith`, `hspecResult`
    or `hspecWithResult`.

    -}
    , evalSpec
    , runSpecForest
    , evaluateResult

    -- ** Result

    -- *** Spec Result
    , Test.Hspec.Core.Runner.Result.SpecResult
    , Test.Hspec.Core.Runner.Result.specResultItems
    , Test.Hspec.Core.Runner.Result.specResultSuccess
    , toSummary

    -- *** Result Item
    , Test.Hspec.Core.Runner.Result.ResultItem
    , Test.Hspec.Core.Runner.Result.resultItemPath
    , Test.Hspec.Core.Runner.Result.resultItemStatus
    , Test.Hspec.Core.Runner.Result.resultItemIsFailure

    -- *** Result Item Status
    , Test.Hspec.Core.Runner.Result.ResultItemStatus(..)

    -- * Config
    , Config (..)
    , ColorMode (..)
    , UnicodeMode(..)
    , Path
    , defaultConfig
    , registerFormatter
    , registerDefaultFormatter
    , configAddFilter
    , readConfig

    -- * Legacy
    , runSpec

    -- * Re-exports
    , Spec
    , SpecWith

    #ifdef TEST
    , UseColor(..)
    , ProgressReporting(..)
    , rerunAll
    , specToEvalForest
    , colorOutputSupported
    , unicodeOutputSupported
    #endif
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat hiding (unicodeOutputSupported)
    import qualified Test.Hspec.Core.Compat as Compat

    import           Data.List.NonEmpty (nonEmpty)
    import           System.IO
    import           System.Environment (getArgs, withArgs)
    import           System.Exit (exitFailure)
    import           System.Random
    import           Control.Monad.ST
    import           Data.STRef

    import           System.Console.ANSI (hSupportsANSI, hHideCursor, hShowCursor)
    import qualified Test.QuickCheck as QC

    import           Test.Hspec.Core.Util (Path)
    import           Test.Hspec.Core.Clock
    import           Test.Hspec.Core.Spec hiding (pruneTree, pruneForest)
    import           Test.Hspec.Core.Tree (formatDefaultDescription)
    import           Test.Hspec.Core.Config
    import           Test.Hspec.Core.Config.Definition as Config (getSeed)

    #ifdef ENABLE_LEGACY_V1_FORMATTERS
    import           Test.Hspec.Core.Config.Definition as Config (getFormatter)
    #endif

    import           Test.Hspec.Core.Extension.Config.Type as Extension (applySpecTransformation)
    import           Test.Hspec.Core.Format (Format, FormatConfig(..))
    import qualified Test.Hspec.Core.Formatters.V2 as V2
    import           Test.Hspec.Core.FailureReport
    import           Test.Hspec.Core.QuickCheck.Util
    import           Test.Hspec.Core.Shuffle

    import           Test.Hspec.Core.Runner.PrintSlowSpecItems
    import           Test.Hspec.Core.Runner.Eval hiding (ColorMode(..), Tree(..))
    import qualified Test.Hspec.Core.Runner.Eval as Eval
    import           Test.Hspec.Core.Runner.Result

    -- |
    -- Make a formatter available for use with @--format@.
    --
    -- @since 2.10.5
    registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
    {-# DEPRECATED registerFormatter "Use [@registerFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html#v:registerFormatter) instead." #-}
    registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
    registerFormatter (String, FormatConfig -> IO Format)
    formatter Config
    config = Config
    config { configAvailableFormatters = formatter : configAvailableFormatters config }

    -- |
    -- Make a formatter available for use with @--format@ and use it by default.
    --
    -- @since 2.10.5
    registerDefaultFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
    {-# DEPRECATED registerDefaultFormatter "Use [@useFormatter@](https://hackage.haskell.org/package/hspec-api/docs/Test-Hspec-Api-Format-V2.html#v:useFormatter) instead." #-}
    registerDefaultFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
    registerDefaultFormatter formatter :: (String, FormatConfig -> IO Format)
    formatter@(String
    _, FormatConfig -> IO Format
    format) Config
    config = ((String, FormatConfig -> IO Format) -> Config -> Config
    registerFormatter (String, FormatConfig -> IO Format)
    formatter Config
    config) { configFormat = Just format }

    applyFilterPredicates :: Config -> [Tree c EvalItem] -> [Tree c EvalItem]
    applyFilterPredicates :: forall c. Config -> [Tree c EvalItem] -> [Tree c EvalItem]
    applyFilterPredicates Config
    c = ([String] -> EvalItem -> Bool)
    -> [Tree c EvalItem] -> [Tree c EvalItem]
    forall a c. ([String] -> a -> Bool) -> [Tree c a] -> [Tree c a]
    filterForestWithLabels [String] -> EvalItem -> Bool
    p
      where
        include :: Path -> Bool
        include :: Path -> Bool
    include = (Path -> Bool) -> Maybe (Path -> Bool) -> Path -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe (Bool -> Path -> Bool
    forall a b. a -> b -> a
    const Bool
    True) (Config -> Maybe (Path -> Bool)
    configFilterPredicate Config
    c)

        skip :: Path -> Bool
        skip :: Path -> Bool
    skip = (Path -> Bool) -> Maybe (Path -> Bool) -> Path -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe (Bool -> Path -> Bool
    forall a b. a -> b -> a
    const Bool
    False) (Config -> Maybe (Path -> Bool)
    configSkipPredicate Config
    c)

        p :: [String] -> EvalItem -> Bool
        p :: [String] -> EvalItem -> Bool
    p [String]
    groups EvalItem
    item = Path -> Bool
    include Path
    path Bool -> Bool -> Bool
    && Bool -> Bool
    not (Path -> Bool
    skip Path
    path)
          where
            path :: Path
    path = ([String]
    groups, EvalItem -> String
    evalItemDescription EvalItem
    item)

    applyDryRun :: Config -> [EvalItemTree] -> [EvalItemTree]
    applyDryRun :: Config -> [EvalItemTree] -> [EvalItemTree]
    applyDryRun Config
    c
      | Config -> Bool
    configDryRun Config
    c = (IO () -> IO ())
    -> (EvalItem -> EvalItem) -> [EvalItemTree] -> [EvalItemTree]
    forall a b c d. (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
    bimapForest IO () -> IO ()
    removeCleanup EvalItem -> EvalItem
    markSuccess
      | Bool
    otherwise = [EvalItemTree] -> [EvalItemTree]
    forall a. a -> a
    id
      where
        removeCleanup :: IO () -> IO ()
        removeCleanup :: IO () -> IO ()
    removeCleanup IO ()
    _ = IO ()
    forall (m :: * -> *). Applicative m => m ()
    pass

        markSuccess :: EvalItem -> EvalItem
        markSuccess :: EvalItem -> EvalItem
    markSuccess EvalItem
    item = EvalItem
    item {evalItemAction = \ ProgressCallback
    _ -> (Seconds, Result) -> IO (Seconds, Result)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Seconds
    0, String -> ResultStatus -> Result
    Result String
    "" ResultStatus
    Success)}

    -- | Run a given spec and write a report to `stdout`.
    -- Exit with `exitFailure` if at least one spec item fails.
    --
    -- /Note/: `hspec` handles command-line options and reads config files.  This
    -- is not always desirable.  Use `evalSpec` and `runSpecForest` if you need
    -- more control over these aspects.
    hspec :: Spec -> IO ()
    hspec :: Spec -> IO ()
    hspec = Config -> Spec -> IO ()
    hspecWith Config
    defaultConfig

    -- |
    -- Evaluate a `Spec` to a forest of `SpecTree`s.  This does not execute any
    -- spec items, but it does run any IO that is used during spec construction
    -- time (see `runIO`).
    --
    -- A `Spec` may modify a `Config` through `modifyConfig`.  These modifications
    -- are applied to the given config (the first argument).
    --
    -- @since 2.10.0
    evalSpec :: Config -> SpecWith a -> IO (Config, [SpecTree a])
    evalSpec :: forall a. Config -> SpecWith a -> IO (Config, [SpecTree a])
    evalSpec Config
    config SpecWith a
    spec = do
      (Endo f, forest) <- SpecWith a -> IO (Endo Config, [SpecTree a])
    forall a. SpecWith a -> IO (Endo Config, [SpecTree a])
    runSpecM SpecWith a
    spec
      return (f config, forest)

    -- Add a seed to given config if there is none.  That way the same seed is used
    -- for all properties.  This helps with --seed and --rerun.
    ensureSeed :: Config -> IO (Config, Integer)
    ensureSeed :: Config -> IO (Config, Integer)
    ensureSeed Config
    config = do
      seed <- case Config -> Maybe Integer
    Config.getSeed Config
    config of
        Maybe Integer
    Nothing -> Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int -> Integer) -> IO Int -> IO Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Int
    newSeed
        Just Integer
    seed -> Integer -> IO Integer
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer
    seed
      return (config { configSeed = Just seed }, seed)

    -- | Run given spec with custom options.
    -- This is similar to `hspec`, but more flexible.
    hspecWith :: Config -> Spec -> IO ()
    hspecWith :: Config -> Spec -> IO ()
    hspecWith Config
    defaults = Config -> Spec -> IO SpecResult
    hspecWithSpecResult Config
    defaults (Spec -> IO SpecResult) -> (SpecResult -> IO ()) -> Spec -> IO ()
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> SpecResult -> IO ()
    evaluateResult

    -- | Exit with `exitFailure` if the given `Summary` indicates that there was at
    -- least one failure.
    evaluateSummary :: Summary -> IO ()
    evaluateSummary :: Summary -> IO ()
    evaluateSummary Summary
    summary = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Summary -> Bool
    isSuccess Summary
    summary) IO ()
    forall a. IO a
    exitFailure

    evaluateResult :: SpecResult -> IO ()
    evaluateResult :: SpecResult -> IO ()
    evaluateResult SpecResult
    result = Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (SpecResult -> Bool
    specResultSuccess SpecResult
    result) IO ()
    forall a. IO a
    exitFailure

    -- | Run given spec and returns a summary of the test run.
    --
    -- /Note/: `hspecResult` does not exit with `exitFailure` on failing spec
    -- items.  If you need this, you have to check the `Summary` yourself and act
    -- accordingly.
    hspecResult :: Spec -> IO Summary
    hspecResult :: Spec -> IO Summary
    hspecResult = Config -> Spec -> IO Summary
    hspecWithResult Config
    defaultConfig

    -- | Run given spec with custom options and returns a summary of the test run.
    --
    -- /Note/: `hspecWithResult` does not exit with `exitFailure` on failing spec
    -- items.  If you need this, you have to check the `Summary` yourself and act
    -- accordingly.
    hspecWithResult :: Config -> Spec -> IO Summary
    hspecWithResult :: Config -> Spec -> IO Summary
    hspecWithResult Config
    config = (SpecResult -> Summary) -> IO SpecResult -> IO Summary
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SpecResult -> Summary
    toSummary (IO SpecResult -> IO Summary)
    -> (Spec -> IO SpecResult) -> Spec -> IO Summary
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Config -> Spec -> IO SpecResult
    hspecWithSpecResult Config
    config

    hspecWithSpecResult :: Config -> Spec -> IO SpecResult
    hspecWithSpecResult :: Config -> Spec -> IO SpecResult
    hspecWithSpecResult Config
    defaults Spec
    spec = do
      (c, forest) <- Config -> Spec -> IO (Config, [SpecTree ()])
    forall a. Config -> SpecWith a -> IO (Config, [SpecTree a])
    evalSpec Config
    defaults Spec
    spec
      config <- getArgs >>= readConfig c
      oldFailureReport <- readFailureReportOnRerun config

      let
        normalMode :: IO SpecResult
        normalMode = IO SpecResult -> IO SpecResult
    forall a. IO a -> IO a
    doNotLeakCommandLineArgumentsToExamples (IO SpecResult -> IO SpecResult) -> IO SpecResult -> IO SpecResult
    forall a b. (a -> b) -> a -> b
    $ Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest_ Maybe FailureReport
    oldFailureReport [SpecTree ()]
    forest Config
    config

        rerunAllMode :: IO SpecResult
        rerunAllMode = do
          result <- IO SpecResult
    normalMode
          if rerunAll config oldFailureReport result then
            hspecWithSpecResult defaults spec
          else
            return result

      -- With --rerun-all we may run the spec twice. For that reason GHC can not
      -- optimize away the spec tree. That means that the whole spec tree has to
      -- be constructed in memory and we loose constant space behavior.
      --
      -- By separating between rerunAllMode and normalMode here, we retain
      -- constant space behavior in normalMode.
      --
      -- see: https://github.com/hspec/hspec/issues/169
      if configRerunAllOnSuccess config then do
        rerunAllMode
      else do
        normalMode

    -- |
    -- /Note/: `runSpec` is deprecated. It ignores any modifications applied
    -- through `modifyConfig`.  Use `evalSpec` and `runSpecForest` instead.
    runSpec :: Spec -> Config -> IO Summary
    runSpec :: Spec -> Config -> IO Summary
    runSpec Spec
    spec Config
    config = Config -> Spec -> IO (Config, [SpecTree ()])
    forall a. Config -> SpecWith a -> IO (Config, [SpecTree a])
    evalSpec Config
    defaultConfig Spec
    spec IO (Config, [SpecTree ()])
    -> ((Config, [SpecTree ()]) -> IO Summary) -> IO Summary
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= (SpecResult -> Summary) -> IO SpecResult -> IO Summary
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap SpecResult -> Summary
    toSummary (IO SpecResult -> IO Summary)
    -> ((Config, [SpecTree ()]) -> IO SpecResult)
    -> (Config, [SpecTree ()])
    -> IO Summary
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([SpecTree ()] -> Config -> IO SpecResult)
    -> Config -> [SpecTree ()] -> IO SpecResult
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest Config
    config ([SpecTree ()] -> IO SpecResult)
    -> ((Config, [SpecTree ()]) -> [SpecTree ()])
    -> (Config, [SpecTree ()])
    -> IO SpecResult
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Config, [SpecTree ()]) -> [SpecTree ()]
    forall a b. (a, b) -> b
    snd

    -- |
    -- `runSpecForest` is the most basic primitive to run a spec. `hspec` is
    -- defined in terms of @runSpecForest@:
    --
    -- @
    -- hspec = `evalSpec` `defaultConfig` >=> \\ (config, spec) ->
    --       `getArgs`
    --   >>= `readConfig` config
    --   >>= `withArgs` [] . runSpecForest spec
    --   >>= `evaluateResult`
    -- @
    --
    -- @since 2.10.0
    runSpecForest :: [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest :: [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest [SpecTree ()]
    spec Config
    config = do
      oldFailureReport <- Config -> IO (Maybe FailureReport)
    readFailureReportOnRerun Config
    config
      runSpecForest_ oldFailureReport spec config

    mapItem :: (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
    mapItem :: forall a b. (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
    mapItem Item a -> Item b
    f = (SpecTree a -> SpecTree b) -> [SpecTree a] -> [SpecTree b]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Item a -> Item b) -> SpecTree a -> SpecTree b
    forall a b. (a -> b) -> Tree (IO ()) a -> Tree (IO ()) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Item a -> Item b
    f)

    mapItemIf :: (Item a -> Bool) -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    mapItemIf :: forall a.
    (Item a -> Bool)
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    mapItemIf Item a -> Bool
    p Item a -> Item a
    f = (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a b. (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
    mapItem ((Item a -> Item a) -> [SpecTree a] -> [SpecTree a])
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a b. (a -> b) -> a -> b
    $ \ Item a
    item -> if Item a -> Bool
    p Item a
    item then Item a -> Item a
    f Item a
    item else Item a
    item

    addDefaultDescriptions :: [SpecTree a] -> [SpecTree a]
    addDefaultDescriptions :: forall a. [SpecTree a] -> [SpecTree a]
    addDefaultDescriptions = (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a b. (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
    mapItem Item a -> Item a
    forall a. Item a -> Item a
    addDefaultDescription
      where
        addDefaultDescription :: Item a -> Item a
        addDefaultDescription :: forall a. Item a -> Item a
    addDefaultDescription Item a
    item
          | String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Item a -> String
    forall a. Item a -> String
    itemRequirement Item a
    item) = Item a
    item { itemRequirement = defaultRequirement }
          | Bool
    otherwise = Item a
    item
          where
            defaultRequirement :: String
    defaultRequirement = String -> (Location -> String) -> Maybe Location -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "(unspecified behavior)" Location -> String
    formatDefaultDescription (Item a -> Maybe Location
    forall a. Item a -> Maybe Location
    itemLocation Item a
    item)

    failItemsWithEmptyDescription :: Config -> [SpecTree a] -> [SpecTree a]
    failItemsWithEmptyDescription :: forall a. Config -> [SpecTree a] -> [SpecTree a]
    failItemsWithEmptyDescription Config
    config
      | Config -> Bool
    configFailOnEmptyDescription Config
    config = (Item a -> Bool)
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a.
    (Item a -> Bool)
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    mapItemIf Item a -> Bool
    forall {a}. Item a -> Bool
    condition (String -> Item a -> Item a
    forall a. String -> Item a -> Item a
    failWith String
    failure)
      | Bool
    otherwise = [SpecTree a] -> [SpecTree a]
    forall a. a -> a
    id
      where
        condition :: Item a -> Bool
    condition = String -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (String -> Bool) -> (Item a -> String) -> Item a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Item a -> String
    forall a. Item a -> String
    itemRequirement
        failure :: String
    failure = String
    "item has no description; failing due to --fail-on=empty-description"

    failFocusedItems :: Config -> [SpecTree a] -> [SpecTree a]
    failFocusedItems :: forall a. Config -> [SpecTree a] -> [SpecTree a]
    failFocusedItems Config
    config
      | Config -> Bool
    configFailOnFocused Config
    config = (Item a -> Bool)
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a.
    (Item a -> Bool)
    -> (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    mapItemIf Item a -> Bool
    forall {a}. Item a -> Bool
    condition (String -> Item a -> Item a
    forall a. String -> Item a -> Item a
    failWith String
    failure)
      | Bool
    otherwise = [SpecTree a] -> [SpecTree a]
    forall a. a -> a
    id
      where
        condition :: Item a -> Bool
    condition = Item a -> Bool
    forall {a}. Item a -> Bool
    itemIsFocused
        failure :: String
    failure = String
    "item is focused; failing due to --fail-on=focused"

    failWith :: forall a. String -> Item a -> Item a
    failWith :: forall a. String -> Item a -> Item a
    failWith String
    reason Item a
    item = Item a
    item {itemExample = example}
      where
        failure :: ResultStatus
        failure :: ResultStatus
    failure = Maybe Location -> FailureReason -> ResultStatus
    Failure Maybe Location
    forall a. Maybe a
    Nothing (String -> FailureReason
    Reason String
    reason)

        example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
        example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
    example Params
    params ActionWith a -> IO ()
    hook ProgressCallback
    p = do
          Result info status <- Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    forall a.
    Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    itemExample Item a
    item Params
    params ActionWith a -> IO ()
    hook ProgressCallback
    p
          return $ Result info $ case status of
            ResultStatus
    Success -> ResultStatus
    failure
            Pending Maybe Location
    _ Maybe String
    _ -> ResultStatus
    failure
            Failure{} -> ResultStatus
    status

    failPendingItems :: Config -> [SpecTree a] -> [SpecTree a]
    failPendingItems :: forall a. Config -> [SpecTree a] -> [SpecTree a]
    failPendingItems Config
    config
      | Config -> Bool
    configFailOnPending Config
    config = (Item a -> Item a) -> [SpecTree a] -> [SpecTree a]
    forall a b. (Item a -> Item b) -> [SpecTree a] -> [SpecTree b]
    mapItem Item a -> Item a
    forall a. Item a -> Item a
    failPending
      | Bool
    otherwise = [SpecTree a] -> [SpecTree a]
    forall a. a -> a
    id

    failPending :: forall a. Item a -> Item a
    failPending :: forall a. Item a -> Item a
    failPending Item a
    item = Item a
    item {itemExample = example}
      where
        example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
        example :: Params -> (ActionWith a -> IO ()) -> ProgressCallback -> IO Result
    example Params
    params ActionWith a -> IO ()
    hook ProgressCallback
    p = do
          Result info status <- Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    forall a.
    Item a
    -> Params
    -> (ActionWith a -> IO ())
    -> ProgressCallback
    -> IO Result
    itemExample Item a
    item Params
    params ActionWith a -> IO ()
    hook ProgressCallback
    p
          return $ Result info $ case status of
            Pending Maybe Location
    loc Maybe String
    _ -> Maybe Location -> FailureReason -> ResultStatus
    Failure Maybe Location
    loc (String -> FailureReason
    Reason String
    "item is pending; failing due to --fail-on=pending")
            ResultStatus
    _ -> ResultStatus
    status

    focusSpec :: Config -> [SpecTree a] -> [SpecTree a]
    focusSpec :: forall a. Config -> [SpecTree a] -> [SpecTree a]
    focusSpec Config
    config [SpecTree a]
    spec
      | Config -> Bool
    configFocusedOnly Config
    config = [SpecTree a]
    spec
      | Bool
    otherwise = [SpecTree a] -> [SpecTree a]
    forall a. [SpecTree a] -> [SpecTree a]
    focusForest [SpecTree a]
    spec

    runSpecForest_ :: Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest_ :: Maybe FailureReport -> [SpecTree ()] -> Config -> IO SpecResult
    runSpecForest_ Maybe FailureReport
    oldFailureReport [SpecTree ()]
    spec Config
    c_ = do

      (config, seed) <- Config -> IO (Config, Integer)
    ensureSeed (Maybe FailureReport -> Config -> Config
    applyFailureReport Maybe FailureReport
    oldFailureReport Config
    c_)

      colorMode <- colorOutputSupported (configColorMode config) (hSupportsANSI stdout)
      outputUnicode <- unicodeOutputSupported (configUnicodeMode config) stdout

      let
        filteredSpec = Integer -> Config -> [SpecTree ()] -> [EvalTree]
    specToEvalForest Integer
    seed Config
    config [SpecTree ()]
    spec
        qcArgs = Config -> Args
    configQuickCheckArgs Config
    config
        !numberOfItems = [EvalTree] -> Int
    forall c a. [Tree c a] -> Int
    countEvalItems [EvalTree]
    filteredSpec

      when (configFailOnEmpty config && numberOfItems == 0) $ do
        when (countSpecItems spec /= 0) $ do
          die "all spec items have been filtered; failing due to --fail-on=empty"

      concurrentJobs <- maybe getDefaultConcurrentJobs return $ configConcurrentJobs config

      results <- fmap toSpecResult . withHiddenCursor (progressReporting colorMode) stdout $ do
        let
          formatConfig = FormatConfig {
            formatConfigUseColor :: Bool
    formatConfigUseColor = UseColor -> Bool
    shouldUseColor UseColor
    colorMode
          , formatConfigReportProgress :: Bool
    formatConfigReportProgress = UseColor -> ProgressReporting
    progressReporting UseColor
    colorMode ProgressReporting -> ProgressReporting -> Bool
    forall a. Eq a => a -> a -> Bool
    == ProgressReporting
    ProgressReportingEnabled
          , formatConfigOutputUnicode :: Bool
    formatConfigOutputUnicode = Bool
    outputUnicode
          , formatConfigUseDiff :: Bool
    formatConfigUseDiff = Config -> Bool
    configDiff Config
    config
          , formatConfigDiffContext :: Maybe Int
    formatConfigDiffContext = Config -> Maybe Int
    configDiffContext Config
    config
          , formatConfigExternalDiff :: Maybe (String -> String -> IO ())
    formatConfigExternalDiff = if Config -> Bool
    configDiff Config
    config then ((Maybe Int -> String -> String -> IO ())
    -> Maybe Int -> String -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Config -> Maybe Int
    configDiffContext Config
    config) ((Maybe Int -> String -> String -> IO ())
     -> String -> String -> IO ())
    -> Maybe (Maybe Int -> String -> String -> IO ())
    -> Maybe (String -> String -> IO ())
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Config -> Maybe (Maybe Int -> String -> String -> IO ())
    configExternalDiff Config
    config else Maybe (String -> String -> IO ())
    forall a. Maybe a
    Nothing
          , formatConfigPrettyPrint :: Bool
    formatConfigPrettyPrint = Config -> Bool
    configPrettyPrint Config
    config
          , formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
    formatConfigPrettyPrintFunction = if Config -> Bool
    configPrettyPrint Config
    config then (String -> String -> (String, String))
    -> Maybe (String -> String -> (String, String))
    forall a. a -> Maybe a
    Just (Config -> Bool -> String -> String -> (String, String)
    configPrettyPrintFunction Config
    config Bool
    outputUnicode) else Maybe (String -> String -> (String, String))
    forall a. Maybe a
    Nothing
          , formatConfigFormatException :: SomeException -> String
    formatConfigFormatException = Config -> SomeException -> String
    configFormatException Config
    config
          , formatConfigPrintTimes :: Bool
    formatConfigPrintTimes = Config -> Bool
    configTimes Config
    config
          , formatConfigHtmlOutput :: Bool
    formatConfigHtmlOutput = Config -> Bool
    configHtmlOutput Config
    config
          , formatConfigPrintCpuTime :: Bool
    formatConfigPrintCpuTime = Config -> Bool
    configPrintCpuTime Config
    config
          , formatConfigUsedSeed :: Integer
    formatConfigUsedSeed = Integer
    seed
          , formatConfigExpectedTotalCount :: Int
    formatConfigExpectedTotalCount = Int
    numberOfItems
          , formatConfigExpertMode :: Bool
    formatConfigExpertMode = Config -> Bool
    configExpertMode Config
    config
          }

          formatter :: FormatConfig -> IO Format
    #ifdef ENABLE_LEGACY_V1_FORMATTERS
          formatter = (FormatConfig -> IO Format)
    -> Maybe (FormatConfig -> IO Format) -> FormatConfig -> IO Format
    forall a. a -> Maybe a -> a
    fromMaybe (Formatter -> FormatConfig -> IO Format
    V2.formatterToFormat Formatter
    V2.checks) (Config -> Maybe (FormatConfig -> IO Format)
    Config.getFormatter Config
    config)
    #else
          formatter = V2.formatterToFormat V2.checks
    #endif

        format <- maybe id printSlowSpecItems (configPrintSlowItems config) <$> formatter formatConfig

        let
          evalConfig = EvalConfig {
            evalConfigFormat :: Format
    evalConfigFormat = Format
    format
          , evalConfigConcurrentJobs :: Int
    evalConfigConcurrentJobs = Int
    concurrentJobs
          , evalConfigFailFast :: Bool
    evalConfigFailFast = Config -> Bool
    configFailFast Config
    config
          , evalConfigColorMode :: ColorMode
    evalConfigColorMode = ColorMode -> ColorMode -> Bool -> ColorMode
    forall a. a -> a -> Bool -> a
    bool ColorMode
    Eval.ColorDisabled ColorMode
    Eval.ColorEnabled (UseColor -> Bool
    shouldUseColor UseColor
    colorMode)
          }
        runFormatter evalConfig filteredSpec

      let
        failures :: [Path]
        failures = (ResultItem -> Path) -> [ResultItem] -> [Path]
    forall a b. (a -> b) -> [a] -> [b]
    map ResultItem -> Path
    resultItemPath ([ResultItem] -> [Path]) -> [ResultItem] -> [Path]
    forall a b. (a -> b) -> a -> b
    $ (ResultItem -> Bool) -> [ResultItem] -> [ResultItem]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ResultItem -> Bool
    resultItemIsFailure ([ResultItem] -> [ResultItem]) -> [ResultItem] -> [ResultItem]
    forall a b. (a -> b) -> a -> b
    $ SpecResult -> [ResultItem]
    specResultItems SpecResult
    results

      dumpFailureReport config seed qcArgs failures

      return results

    specToEvalForest :: Integer -> Config -> [SpecTree ()] -> [EvalTree]
    specToEvalForest :: Integer -> Config -> [SpecTree ()] -> [EvalTree]
    specToEvalForest Integer
    seed Config
    config =
          Config -> [SpecTree ()] -> [SpecTree ()]
    forall a. Config -> [SpecTree a] -> [SpecTree a]
    failItemsWithEmptyDescription Config
    config
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> [SpecTree ()] -> [SpecTree ()]
    forall a. [SpecTree a] -> [SpecTree a]
    addDefaultDescriptions
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [SpecTree ()] -> [SpecTree ()]
    forall a. Config -> [SpecTree a] -> [SpecTree a]
    failFocusedItems Config
    config
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [SpecTree ()] -> [SpecTree ()]
    forall a. Config -> [SpecTree a] -> [SpecTree a]
    failPendingItems Config
    config
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [SpecTree ()] -> [SpecTree ()]
    Extension.applySpecTransformation Config
    config
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [SpecTree ()] -> [SpecTree ()]
    forall a. Config -> [SpecTree a] -> [SpecTree a]
    focusSpec Config
    config
      ([SpecTree ()] -> [SpecTree ()])
    -> ([SpecTree ()] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Params -> [SpecTree ()] -> [EvalItemTree]
    toEvalItemForest Params
    params
      ([SpecTree ()] -> [EvalItemTree])
    -> ([EvalItemTree] -> [EvalTree]) -> [SpecTree ()] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [EvalItemTree] -> [EvalItemTree]
    applyDryRun Config
    config
      ([EvalItemTree] -> [EvalItemTree])
    -> ([EvalItemTree] -> [EvalTree]) -> [EvalItemTree] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> Config -> [EvalItemTree] -> [EvalItemTree]
    forall c. Config -> [Tree c EvalItem] -> [Tree c EvalItem]
    applyFilterPredicates Config
    config
      ([EvalItemTree] -> [EvalItemTree])
    -> ([EvalItemTree] -> [EvalTree]) -> [EvalItemTree] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> [EvalItemTree] -> [EvalItemTree]
    forall c a. [Tree c a] -> [Tree c a]
    randomize
      ([EvalItemTree] -> [EvalItemTree])
    -> ([EvalItemTree] -> [EvalTree]) -> [EvalItemTree] -> [EvalTree]
    forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
    Category cat =>
    cat a b -> cat b c -> cat a c
    >>> [EvalItemTree] -> [EvalTree]
    forall c a. [Tree c a] -> [Tree c a]
    pruneForest
      where
        params :: Params
        params :: Params
    params = Args -> Maybe Int -> Params
    Params (Config -> Args
    configQuickCheckArgs Config
    config) (Config -> Maybe Int
    configSmallCheckDepth Config
    config)

        randomize :: [Tree c a] -> [Tree c a]
        randomize :: forall c a. [Tree c a] -> [Tree c a]
    randomize
          | Config -> Bool
    configRandomize Config
    config = Integer -> [Tree c a] -> [Tree c a]
    forall c a. Integer -> [Tree c a] -> [Tree c a]
    randomizeForest Integer
    seed
          | Bool
    otherwise = [Tree c a] -> [Tree c a]
    forall a. a -> a
    id

    pruneForest :: [Tree c a] -> [Eval.Tree c a]
    pruneForest :: forall c a. [Tree c a] -> [Tree c a]
    pruneForest = (Tree c a -> Maybe (Tree c a)) -> [Tree c a] -> [Tree c a]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Tree c a -> Maybe (Tree c a)
    forall c a. Tree c a -> Maybe (Tree c a)
    pruneTree

    pruneTree :: Tree c a -> Maybe (Eval.Tree c a)
    pruneTree :: forall c a. Tree c a -> Maybe (Tree c a)
    pruneTree Tree c a
    node = case Tree c a
    node of
      Node String
    group [Tree c a]
    xs -> String -> NonEmpty (Tree c a) -> Tree c a
    forall c a. String -> NonEmpty (Tree c a) -> Tree c a
    Eval.Node String
    group (NonEmpty (Tree c a) -> Tree c a)
    -> Maybe (NonEmpty (Tree c a)) -> Maybe (Tree c a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Tree c a] -> Maybe (NonEmpty (Tree c a))
    forall {c} {a}. [Tree c a] -> Maybe (NonEmpty (Tree c a))
    prune [Tree c a]
    xs
      NodeWithCleanup Maybe (String, Location)
    loc c
    action [Tree c a]
    xs -> Maybe (String, Location) -> c -> NonEmpty (Tree c a) -> Tree c a
    forall c a.
    Maybe (String, Location) -> c -> NonEmpty (Tree c a) -> Tree c a
    Eval.NodeWithCleanup Maybe (String, Location)
    loc c
    action (NonEmpty (Tree c a) -> Tree c a)
    -> Maybe (NonEmpty (Tree c a)) -> Maybe (Tree c a)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Tree c a] -> Maybe (NonEmpty (Tree c a))
    forall {c} {a}. [Tree c a] -> Maybe (NonEmpty (Tree c a))
    prune [Tree c a]
    xs
      Leaf a
    item -> Tree c a -> Maybe (Tree c a)
    forall a. a -> Maybe a
    Just (a -> Tree c a
    forall c a. a -> Tree c a
    Eval.Leaf a
    item)
      where
        prune :: [Tree c a] -> Maybe (NonEmpty (Tree c a))
    prune = [Tree c a] -> Maybe (NonEmpty (Tree c a))
    forall a. [a] -> Maybe (NonEmpty a)
    nonEmpty ([Tree c a] -> Maybe (NonEmpty (Tree c a)))
    -> ([Tree c a] -> [Tree c a])
    -> [Tree c a]
    -> Maybe (NonEmpty (Tree c a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Tree c a] -> [Tree c a]
    forall c a. [Tree c a] -> [Tree c a]
    pruneForest

    type EvalItemTree = Tree (IO ()) EvalItem

    toEvalItemForest :: Params -> [SpecTree ()] -> [EvalItemTree]
    toEvalItemForest :: Params -> [SpecTree ()] -> [EvalItemTree]
    toEvalItemForest Params
    params = (IO () -> IO ())
    -> (Item () -> EvalItem) -> [SpecTree ()] -> [EvalItemTree]
    forall a b c d. (a -> b) -> (c -> d) -> [Tree a c] -> [Tree b d]
    bimapForest IO () -> IO ()
    forall a. a -> a
    id Item () -> EvalItem
    toEvalItem ([SpecTree ()] -> [EvalItemTree])
    -> ([SpecTree ()] -> [SpecTree ()])
    -> [SpecTree ()]
    -> [EvalItemTree]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Item () -> Bool) -> [SpecTree ()] -> [SpecTree ()]
    forall a c. (a -> Bool) -> [Tree c a] -> [Tree c a]
    filterForest Item () -> Bool
    forall {a}. Item a -> Bool
    itemIsFocused
      where
        toEvalItem :: Item () -> EvalItem
        toEvalItem :: Item () -> EvalItem
    toEvalItem (Item String
    requirement Maybe Location
    loc Maybe Bool
    isParallelizable Bool
    _isFocused Annotations
    _annotations Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
    e) = EvalItem {
          evalItemDescription :: String
    evalItemDescription = String
    requirement
        , evalItemLocation :: Maybe Location
    evalItemLocation = Maybe Location
    loc
        , evalItemConcurrency :: Concurrency
    evalItemConcurrency = if Maybe Bool
    isParallelizable Maybe Bool -> Maybe Bool -> Bool
    forall a. Eq a => a -> a -> Bool
    == Bool -> Maybe Bool
    forall a. a -> Maybe a
    Just Bool
    True then Concurrency
    Concurrent else Concurrency
    Sequential
        , evalItemAction :: ProgressCallback -> IO (Seconds, Result)
    evalItemAction = \ ProgressCallback
    progress -> IO Result -> IO (Seconds, Result)
    forall a. IO a -> IO (Seconds, a)
    measure (IO Result -> IO (Seconds, Result))
    -> IO Result -> IO (Seconds, Result)
    forall a b. (a -> b) -> a -> b
    $ Params -> (ActionWith () -> IO ()) -> ProgressCallback -> IO Result
    e Params
    params ActionWith () -> IO ()
    withUnit ProgressCallback
    progress
        }

        withUnit :: ActionWith () -> IO ()
        withUnit :: ActionWith () -> IO ()
    withUnit ActionWith ()
    action = ActionWith ()
    action ()

    dumpFailureReport :: Config -> Integer -> QC.Args -> [Path] -> IO ()
    dumpFailureReport :: Config -> Integer -> Args -> [Path] -> IO ()
    dumpFailureReport Config
    config Integer
    seed Args
    qcArgs [Path]
    xs = do
      Config -> FailureReport -> IO ()
    writeFailureReport Config
    config FailureReport {
          failureReportSeed :: Integer
    failureReportSeed = Integer
    seed
        , failureReportMaxSuccess :: Int
    failureReportMaxSuccess = Args -> Int
    QC.maxSuccess Args
    qcArgs
        , failureReportMaxSize :: Int
    failureReportMaxSize = Args -> Int
    QC.maxSize Args
    qcArgs
        , failureReportMaxDiscardRatio :: Int
    failureReportMaxDiscardRatio = Args -> Int
    QC.maxDiscardRatio Args
    qcArgs
        , failureReportPaths :: [Path]
    failureReportPaths = [Path]
    xs
        }

    doNotLeakCommandLineArgumentsToExamples :: IO a -> IO a
    doNotLeakCommandLineArgumentsToExamples :: forall a. IO a -> IO a
    doNotLeakCommandLineArgumentsToExamples = [String] -> IO a -> IO a
    forall a. [String] -> IO a -> IO a
    withArgs []

    withHiddenCursor :: ProgressReporting -> Handle -> IO a -> IO a
    withHiddenCursor :: forall a. ProgressReporting -> Handle -> IO a -> IO a
    withHiddenCursor ProgressReporting
    progress Handle
    h = case ProgressReporting
    progress of
      ProgressReporting
    ProgressReportingDisabled -> IO a -> IO a
    forall a. a -> a
    id
      ProgressReporting
    ProgressReportingEnabled -> IO () -> IO () -> IO a -> IO a
    forall a b c. IO a -> IO b -> IO c -> IO c
    bracket_ (Handle -> IO ()
    hHideCursor Handle
    h) (Handle -> IO ()
    hShowCursor Handle
    h)

    data UseColor = ColorDisabled | ColorEnabled ProgressReporting
      deriving (UseColor -> UseColor -> Bool
    (UseColor -> UseColor -> Bool)
    -> (UseColor -> UseColor -> Bool) -> Eq UseColor
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: UseColor -> UseColor -> Bool
    == :: UseColor -> UseColor -> Bool
    $c/= :: UseColor -> UseColor -> Bool
    /= :: UseColor -> UseColor -> Bool
    Eq, Int -> UseColor -> ShowS
    [UseColor] -> ShowS
    UseColor -> String
    (Int -> UseColor -> ShowS)
    -> (UseColor -> String) -> ([UseColor] -> ShowS) -> Show UseColor
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> UseColor -> ShowS
    showsPrec :: Int -> UseColor -> ShowS
    $cshow :: UseColor -> String
    show :: UseColor -> String
    $cshowList :: [UseColor] -> ShowS
    showList :: [UseColor] -> ShowS
    Show)

    data ProgressReporting = ProgressReportingDisabled | ProgressReportingEnabled
      deriving (ProgressReporting -> ProgressReporting -> Bool
    (ProgressReporting -> ProgressReporting -> Bool)
    -> (ProgressReporting -> ProgressReporting -> Bool)
    -> Eq ProgressReporting
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ProgressReporting -> ProgressReporting -> Bool
    == :: ProgressReporting -> ProgressReporting -> Bool
    $c/= :: ProgressReporting -> ProgressReporting -> Bool
    /= :: ProgressReporting -> ProgressReporting -> Bool
    Eq, Int -> ProgressReporting -> ShowS
    [ProgressReporting] -> ShowS
    ProgressReporting -> String
    (Int -> ProgressReporting -> ShowS)
    -> (ProgressReporting -> String)
    -> ([ProgressReporting] -> ShowS)
    -> Show ProgressReporting
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ProgressReporting -> ShowS
    showsPrec :: Int -> ProgressReporting -> ShowS
    $cshow :: ProgressReporting -> String
    show :: ProgressReporting -> String
    $cshowList :: [ProgressReporting] -> ShowS
    showList :: [ProgressReporting] -> ShowS
    Show)

    shouldUseColor :: UseColor -> Bool
    shouldUseColor :: UseColor -> Bool
    shouldUseColor UseColor
    c = case UseColor
    c of
      UseColor
    ColorDisabled -> Bool
    False
      ColorEnabled ProgressReporting
    _ -> Bool
    True

    progressReporting :: UseColor -> ProgressReporting
    progressReporting :: UseColor -> ProgressReporting
    progressReporting UseColor
    c = case UseColor
    c of
      UseColor
    ColorDisabled -> ProgressReporting
    ProgressReportingDisabled
      ColorEnabled ProgressReporting
    r -> ProgressReporting
    r

    colorOutputSupported :: ColorMode -> IO Bool -> IO UseColor
    colorOutputSupported :: ColorMode -> IO Bool -> IO UseColor
    colorOutputSupported ColorMode
    mode IO Bool
    isTerminalDevice = do
      github <- IO Bool
    githubActions
      buildkite <- lookupEnv "BUILDKITE" <&> (== Just "true")
      let
        progress :: ProgressReporting
        progress
          | Bool
    github Bool -> Bool -> Bool
    || Bool
    buildkite = ProgressReporting
    ProgressReportingDisabled
          | Bool
    otherwise = ProgressReporting
    ProgressReportingEnabled

        colorEnabled :: UseColor
        colorEnabled = ProgressReporting -> UseColor
    ColorEnabled ProgressReporting
    progress
      case mode of
        ColorMode
    ColorAuto -> UseColor -> UseColor -> Bool -> UseColor
    forall a. a -> a -> Bool -> a
    bool UseColor
    ColorDisabled UseColor
    colorEnabled (Bool -> UseColor) -> (Bool -> Bool) -> Bool -> UseColor
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Bool
    github Bool -> Bool -> Bool
    ||) (Bool -> UseColor) -> IO Bool -> IO UseColor
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Bool
    colorTerminal
        ColorMode
    ColorNever -> UseColor -> IO UseColor
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UseColor
    ColorDisabled
        ColorMode
    ColorAlways -> UseColor -> IO UseColor
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return UseColor
    colorEnabled
      where
        githubActions :: IO Bool
        githubActions :: IO Bool
    githubActions = String -> IO (Maybe String)
    lookupEnv String
    "GITHUB_ACTIONS" IO (Maybe String) -> (Maybe String -> Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String -> Maybe String
    forall a. a -> Maybe a
    Just String
    "true")

        colorTerminal :: IO Bool
        colorTerminal :: IO Bool
    colorTerminal = Bool -> Bool -> Bool
    (&&) (Bool -> Bool -> Bool) -> IO Bool -> IO (Bool -> Bool)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Bool -> Bool
    not (Bool -> Bool) -> IO Bool -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO Bool
    noColor) IO (Bool -> Bool) -> IO Bool -> IO Bool
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> IO Bool
    isTerminalDevice

        noColor :: IO Bool
        noColor :: IO Bool
    noColor = String -> IO (Maybe String)
    lookupEnv String
    "NO_COLOR" IO (Maybe String) -> (Maybe String -> Bool) -> IO Bool
    forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
    <&> (Maybe String -> Maybe String -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Maybe String
    forall a. Maybe a
    Nothing)

    unicodeOutputSupported :: UnicodeMode -> Handle -> IO Bool
    unicodeOutputSupported :: UnicodeMode -> Handle -> IO Bool
    unicodeOutputSupported UnicodeMode
    mode Handle
    h = case UnicodeMode
    mode of
      UnicodeMode
    UnicodeAuto -> Handle -> IO Bool
    Compat.unicodeOutputSupported Handle
    h
      UnicodeMode
    UnicodeNever -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
      UnicodeMode
    UnicodeAlways -> Bool -> IO Bool
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True

    rerunAll :: Config -> Maybe FailureReport -> SpecResult -> Bool
    rerunAll :: Config -> Maybe FailureReport -> SpecResult -> Bool
    rerunAll Config
    config Maybe FailureReport
    mOldFailureReport SpecResult
    result = case Maybe FailureReport
    mOldFailureReport of
      Maybe FailureReport
    Nothing -> Bool
    False
      Just FailureReport
    oldFailureReport ->
           Config -> Bool
    configRerunAllOnSuccess Config
    config
        Bool -> Bool -> Bool
    && Config -> Bool
    configRerun Config
    config
        Bool -> Bool -> Bool
    && SpecResult -> Bool
    specResultSuccess SpecResult
    result
        Bool -> Bool -> Bool
    && (Bool -> Bool
    not (Bool -> Bool) -> ([Path] -> Bool) -> [Path] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Path] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null) (FailureReport -> [Path]
    failureReportPaths FailureReport
    oldFailureReport)

    randomizeForest :: Integer -> [Tree c a] -> [Tree c a]
    randomizeForest :: forall c a. Integer -> [Tree c a] -> [Tree c a]
    randomizeForest Integer
    seed [Tree c a]
    t = (forall s. ST s [Tree c a]) -> [Tree c a]
    forall a. (forall s. ST s a) -> a
    runST ((forall s. ST s [Tree c a]) -> [Tree c a])
    -> (forall s. ST s [Tree c a]) -> [Tree c a]
    forall a b. (a -> b) -> a -> b
    $ do
      ref <- StdGen -> ST s (STRef s StdGen)
    forall a s. a -> ST s (STRef s a)
    newSTRef (Int -> StdGen
    mkStdGen (Int -> StdGen) -> Int -> StdGen
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    seed)
      shuffleForest ref t

    countEvalItems :: [Eval.Tree c a] -> Int
    countEvalItems :: forall c a. [Tree c a] -> Int
    countEvalItems = Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int) -> ([Tree c a] -> Sum Int) -> [Tree c a] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree c a -> Sum Int) -> [Tree c a] -> Sum Int
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((a -> Sum Int) -> Tree c a -> Sum Int
    forall m a. Monoid m => (a -> m) -> Tree c a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((a -> Sum Int) -> Tree c a -> Sum Int)
    -> (Sum Int -> a -> Sum Int) -> Sum Int -> Tree c a -> Sum Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Int -> a -> Sum Int
    forall a b. a -> b -> a
    const (Sum Int -> Tree c a -> Sum Int) -> Sum Int -> Tree c a -> Sum Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Sum Int
    forall a. a -> Sum a
    Sum Int
    1)

    countSpecItems :: [Tree c a] -> Int
    countSpecItems :: forall c a. [Tree c a] -> Int
    countSpecItems = Sum Int -> Int
    forall a. Sum a -> a
    getSum (Sum Int -> Int) -> ([Tree c a] -> Sum Int) -> [Tree c a] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree c a -> Sum Int) -> [Tree c a] -> Sum Int
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((a -> Sum Int) -> Tree c a -> Sum Int
    forall m a. Monoid m => (a -> m) -> Tree c a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ((a -> Sum Int) -> Tree c a -> Sum Int)
    -> (Sum Int -> a -> Sum Int) -> Sum Int -> Tree c a -> Sum Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Sum Int -> a -> Sum Int
    forall a b. a -> b -> a
    const (Sum Int -> Tree c a -> Sum Int) -> Sum Int -> Tree c a -> Sum Int
    forall a b. (a -> b) -> a -> b
    $ Int -> Sum Int
    forall a. a -> Sum a
    Sum Int
    1)