    -- | Running tests
    {-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, RankNTypes,
                 FlexibleContexts, CPP, DeriveDataTypeable, LambdaCase,
                 RecordWildCards, NamedFieldPuns #-}
    module Test.Tasty.Run
      ( Status(..)
      , StatusMap
      , launchTestTree
      , applyTopLevelPlusTestOptions
      , DependencyException(..)
      ) where

    import qualified Data.IntMap.Strict as IntMap
    import qualified Data.Sequence as Seq
    import qualified Data.Foldable as F
    import Data.Int (Int64)
    import Data.Maybe
    import Data.List (intercalate)
    import Data.Graph (SCC(..), stronglyConnComp)
    import Data.Sequence (Seq, (|>), (<|), (><))
    import Data.Typeable
    import Control.Monad (forever, guard, join, liftM)
    import Control.Monad.IO.Class (liftIO)
    import Control.Monad.Trans.Reader (ReaderT(..), local, ask)
    import Control.Monad.Trans.Writer (execWriterT, tell)
    import Control.Concurrent
    import Control.Concurrent.STM
    import Control.Concurrent.Async
    import Control.Exception as E
    import Control.Applicative
    import Control.Arrow
    import Data.Monoid (First(..))
    import GHC.Conc (labelThread)
    import Prelude  -- Silence AMP and FTP import warnings

    #if MIN_VERSION_base(4,18,0)
    import Data.Traversable (mapAccumM)
    #endif

    #ifdef MIN_VERSION_unbounded_delays
    import Control.Concurrent.Timeout (timeout)
    #else
    import System.Timeout (timeout)
    #endif

    import Test.Tasty.Core
    import Test.Tasty.Parallel
    import Test.Tasty.Patterns
    import Test.Tasty.Patterns.Types
    import Test.Tasty.Options
    import Test.Tasty.Options.Core
    import Test.Tasty.Runners.Reducers
    import Test.Tasty.Runners.Utils (timed, forceElements)
    import Test.Tasty.Providers.ConsoleFormat (noResultDetails)

    -- | Current status of a test.
    --
    -- @since 0.1
    data Status
      = NotStarted
        -- ^ test has not started running yet
      | Executing Progress
        -- ^ test is being run
      | Done Result
        -- ^ test finished with a given result
      deriving
      ( Int -> Status -> ShowS
    [Status] -> ShowS
    Status -> String
    (Int -> Status -> ShowS)
    -> (Status -> String) -> ([Status] -> ShowS) -> Show Status
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Status -> ShowS
    showsPrec :: Int -> Status -> ShowS
    $cshow :: Status -> String
    show :: Status -> String
    $cshowList :: [Status] -> ShowS
    showList :: [Status] -> ShowS
    Show -- ^ @since 1.2
      )

    -- | Mapping from test numbers (starting from 0) to their status variables.
    --
    -- This is what an ingredient uses to analyse and display progress, and to
    -- detect when tests finish.
    --
    -- @since 0.1
    type StatusMap = IntMap.IntMap (TVar Status)

    data Resource r
      = NotCreated
      | BeingCreated
      | FailedToCreate SomeException
      | Created r
      | BeingDestroyed
      | Destroyed

    instance Show (Resource r) where
      show :: Resource r -> String
    show Resource r
    r = case Resource r
    r of
        Resource r
    NotCreated -> String
    "NotCreated"
        Resource r
    BeingCreated -> String
    "BeingCreated"
        FailedToCreate SomeException
    exn -> String
    "FailedToCreate " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    exn
        Created {} -> String
    "Created"
        Resource r
    BeingDestroyed -> String
    "BeingDestroyed"
        Resource r
    Destroyed -> String
    "Destroyed"

    data Initializer
      = forall res . Initializer
          (IO res)
          (TVar (Resource res))
    data Finalizer
      = forall res . Finalizer
          (res -> IO ())
          (TVar (Resource res))
          (TVar Int)

    -- | Execute a test taking care of resources
    executeTest
      :: ((Progress -> IO ()) -> IO Result)
        -- ^ the action to execute the test, which takes a progress callback as
        -- a parameter
      -> TVar Status -- ^ variable to write status to
      -> Timeout -- ^ optional timeout to apply
      -> HideProgress -- ^ hide progress option
      -> Seq Initializer -- ^ initializers (to be executed in this order)
      -> Seq Finalizer -- ^ finalizers (to be executed in this order)
      -> IO ()
    executeTest :: ((Progress -> IO ()) -> IO Result)
    -> TVar Status
    -> Timeout
    -> HideProgress
    -> Seq Initializer
    -> Seq Finalizer
    -> IO ()
    executeTest (Progress -> IO ()) -> IO Result
    action TVar Status
    statusVar Timeout
    timeoutOpt HideProgress
    hideProgressOpt Seq Initializer
    inits Seq Finalizer
    fins = ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    mask (((forall a. IO a -> IO a) -> IO ()) -> IO ())
    -> ((forall a. IO a -> IO a) -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> do
      resultOrExn <- IO (Time, Result) -> IO (Either SomeException (Time, Result))
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO (Time, Result) -> IO (Either SomeException (Time, Result)))
    -> (IO (Time, Result) -> IO (Time, Result))
    -> IO (Time, Result)
    -> IO (Either SomeException (Time, Result))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO (Time, Result) -> IO (Time, Result)
    forall a. IO a -> IO a
    restore (IO (Time, Result) -> IO (Either SomeException (Time, Result)))
    -> IO (Time, Result) -> IO (Either SomeException (Time, Result))
    forall a b. (a -> b) -> a -> b
    $ do
        -- N.B. this can (re-)throw an exception. It's okay. By design, the
        -- actual test will not be run, then. We still run all the
        -- finalizers.
        --
        -- There's no point to transform these exceptions to something like
        -- EitherT, because an async exception (cancellation) can strike
        -- anyway.
        IO ()
    initResources

        let
          cursorMischiefManaged :: IO Result
    cursorMischiefManaged = do
            STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TVar Status -> Status -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Status
    statusVar (Progress -> Status
    Executing Progress
    emptyProgress)
            (Progress -> IO ()) -> IO Result
    action Progress -> IO ()
    forall {f :: * -> *}. MonadIO f => Progress -> f ()
    yieldProgress

        -- If all initializers ran successfully, actually run the test.
        -- We run it in a separate thread, so that the test's exception
        -- handler doesn't interfere with our timeout.
        IO Result
    -> (Async Result -> IO (Time, Result)) -> IO (Time, Result)
    forall a b. IO a -> (Async a -> IO b) -> IO b
    withAsync IO Result
    cursorMischiefManaged ((Async Result -> IO (Time, Result)) -> IO (Time, Result))
    -> (Async Result -> IO (Time, Result)) -> IO (Time, Result)
    forall a b. (a -> b) -> a -> b
    $ \Async Result
    asy -> do
          ThreadId -> String -> IO ()
    labelThread (Async Result -> ThreadId
    forall a. Async a -> ThreadId
    asyncThreadId Async Result
    asy) String
    "tasty_test_execution_thread"
          IO Result -> IO (Time, Result)
    forall a. IO a -> IO (Time, a)
    timed (IO Result -> IO (Time, Result)) -> IO Result -> IO (Time, Result)
    forall a b. (a -> b) -> a -> b
    $ Timeout -> IO Result -> IO Result
    applyTimeout Timeout
    timeoutOpt (IO Result -> IO Result) -> IO Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ do
            r <- Async Result -> IO Result
    forall a. Async a -> IO a
    wait Async Result
    asy
            -- Not only wait for the result to be returned, but make sure to
            -- evalute it inside applyTimeout; see #280.
            evaluate $
              resultOutcome r `seq`
              forceElements (resultDescription r) `seq`
              forceElements (resultShortDescription r)
            return r

      -- no matter what, try to run each finalizer
      mbExn <- destroyResources restore

      atomically . writeTVar statusVar . Done $
        case resultOrExn <* maybe (Right ()) Left mbExn of
          Left SomeException
    ex -> SomeException -> Result
    exceptionResult SomeException
    ex
          Right (Time
    t,Result
    r) -> Result
    r { resultTime = t }

      where
        initResources :: IO ()
        initResources :: IO ()
    initResources =
          Seq Initializer -> (Initializer -> IO ()) -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    F.forM_ Seq Initializer
    inits ((Initializer -> IO ()) -> IO ())
    -> (Initializer -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Initializer IO res
    doInit TVar (Resource res)
    initVar) -> do
            IO (IO ()) -> IO ()
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO ()) -> IO ()) -> IO (IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ STM (IO ()) -> IO (IO ())
    forall a. STM a -> IO a
    atomically (STM (IO ()) -> IO (IO ())) -> STM (IO ()) -> IO (IO ())
    forall a b. (a -> b) -> a -> b
    $ do
              resStatus <- TVar (Resource res) -> STM (Resource res)
    forall a. TVar a -> STM a
    readTVar TVar (Resource res)
    initVar
              case resStatus of
                Resource res
    NotCreated -> do
                  -- signal to others that we're taking care of the resource
                  -- initialization
                  TVar (Resource res) -> Resource res -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Resource res)
    initVar Resource res
    forall r. Resource r
    BeingCreated
                  IO () -> STM (IO ())
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
    forall a b. (a -> b) -> a -> b
    $
                    (do
                      res <- IO res
    doInit
                      atomically $ writeTVar initVar $ Created res
                     ) IO () -> (SomeException -> IO ()) -> IO ()
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` \SomeException
    exn -> do
                      STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ TVar (Resource res) -> Resource res -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Resource res)
    initVar (Resource res -> STM ()) -> Resource res -> STM ()
    forall a b. (a -> b) -> a -> b
    $ SomeException -> Resource res
    forall r. SomeException -> Resource r
    FailedToCreate SomeException
    exn
                      SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    exn
                Resource res
    BeingCreated -> STM (IO ())
    forall a. STM a
    retry
                Created {} -> IO () -> STM (IO ())
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
    forall a b. (a -> b) -> a -> b
    $ () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
                FailedToCreate SomeException
    exn -> IO () -> STM (IO ())
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
    forall a b. (a -> b) -> a -> b
    $ SomeException -> IO ()
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    exn
                -- If the resource is destroyed or being destroyed
                -- while we're starting a test, the test suite is probably
                -- shutting down. We are about to be killed.
                -- (In fact we are probably killed already, so these cases are
                -- unlikely to occur.)
                -- In any case, the most sensible thing to do is to go to
                -- sleep, awaiting our fate.
                Resource res
    Destroyed      -> IO () -> STM (IO ())
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
    forall a b. (a -> b) -> a -> b
    $ IO ()
    sleepIndefinitely
                Resource res
    BeingDestroyed -> IO () -> STM (IO ())
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO () -> STM (IO ())) -> IO () -> STM (IO ())
    forall a b. (a -> b) -> a -> b
    $ IO ()
    sleepIndefinitely

        applyTimeout :: Timeout -> IO Result -> IO Result
        applyTimeout :: Timeout -> IO Result -> IO Result
    applyTimeout Timeout
    NoTimeout IO Result
    a = IO Result
    a
        applyTimeout (Timeout Integer
    t String
    tstr) IO Result
    a = do
          let
            timeoutResult :: Result
    timeoutResult =
              Result
                { resultOutcome :: Outcome
    resultOutcome = FailureReason -> Outcome
    Failure (FailureReason -> Outcome) -> FailureReason -> Outcome
    forall a b. (a -> b) -> a -> b
    $ Integer -> FailureReason
    TestTimedOut Integer
    t
                , resultDescription :: String
    resultDescription =
                    String
    "Timed out after " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    tstr
                , resultShortDescription :: String
    resultShortDescription = String
    "TIMEOUT"
                , resultTime :: Time
    resultTime = Integer -> Time
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    t
                , resultDetailsPrinter :: ResultDetailsPrinter
    resultDetailsPrinter = ResultDetailsPrinter
    noResultDetails
                }
          -- If compiled with unbounded-delays then t' :: Integer, otherwise t' :: Int
          let t' :: Int
    t' = Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger (Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    min (Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    max Integer
    0 Integer
    t) (Int64 -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int64
    forall a. Bounded a => a
    maxBound :: Int64)))
          Result -> Maybe Result -> Result
    forall a. a -> Maybe a -> a
    fromMaybe Result
    timeoutResult (Maybe Result -> Result) -> IO (Maybe Result) -> IO Result
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> IO Result -> IO (Maybe Result)
    forall a. Int -> IO a -> IO (Maybe a)
    timeout Int
    t' IO Result
    a

        -- destroyResources should not be interrupted by an exception
        -- Here's how we ensure this:
        --
        -- * the finalizer is wrapped in 'try'
        -- * async exceptions are masked by the caller
        -- * we don't use any interruptible operations here (outside of 'try')
        destroyResources :: (forall a . IO a -> IO a) -> IO (Maybe SomeException)
        destroyResources :: (forall a. IO a -> IO a) -> IO (Maybe SomeException)
    destroyResources forall a. IO a -> IO a
    restore = do
          -- remember the first exception that occurred
          (First SomeException -> Maybe SomeException)
    -> IO (First SomeException) -> IO (Maybe SomeException)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM First SomeException -> Maybe SomeException
    forall a. First a -> Maybe a
    getFirst (IO (First SomeException) -> IO (Maybe SomeException))
    -> (Traversal (WriterT (First SomeException) IO)
        -> IO (First SomeException))
    -> Traversal (WriterT (First SomeException) IO)
    -> IO (Maybe SomeException)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . WriterT (First SomeException) IO () -> IO (First SomeException)
    forall (m :: * -> *) w a. Monad m => WriterT w m a -> m w
    execWriterT (WriterT (First SomeException) IO () -> IO (First SomeException))
    -> (Traversal (WriterT (First SomeException) IO)
        -> WriterT (First SomeException) IO ())
    -> Traversal (WriterT (First SomeException) IO)
    -> IO (First SomeException)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Traversal (WriterT (First SomeException) IO)
    -> WriterT (First SomeException) IO ()
    forall (f :: * -> *). Traversal f -> f ()
    getTraversal (Traversal (WriterT (First SomeException) IO)
     -> IO (Maybe SomeException))
    -> Traversal (WriterT (First SomeException) IO)
    -> IO (Maybe SomeException)
    forall a b. (a -> b) -> a -> b
    $
            ((Finalizer -> Traversal (WriterT (First SomeException) IO))
     -> Seq Finalizer -> Traversal (WriterT (First SomeException) IO))
    -> Seq Finalizer
    -> (Finalizer -> Traversal (WriterT (First SomeException) IO))
    -> Traversal (WriterT (First SomeException) IO)
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (Finalizer -> Traversal (WriterT (First SomeException) IO))
    -> Seq Finalizer -> Traversal (WriterT (First SomeException) IO)
    forall m a. Monoid m => (a -> m) -> Seq a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    F.foldMap Seq Finalizer
    fins ((Finalizer -> Traversal (WriterT (First SomeException) IO))
     -> Traversal (WriterT (First SomeException) IO))
    -> (Finalizer -> Traversal (WriterT (First SomeException) IO))
    -> Traversal (WriterT (First SomeException) IO)
    forall a b. (a -> b) -> a -> b
    $ \fin :: Finalizer
    fin@(Finalizer res -> IO ()
    _ TVar (Resource res)
    _ TVar Int
    finishVar) ->
              WriterT (First SomeException) IO ()
    -> Traversal (WriterT (First SomeException) IO)
    forall (f :: * -> *). f () -> Traversal f
    Traversal (WriterT (First SomeException) IO ()
     -> Traversal (WriterT (First SomeException) IO))
    -> WriterT (First SomeException) IO ()
    -> Traversal (WriterT (First SomeException) IO)
    forall a b. (a -> b) -> a -> b
    $ do
                iAmLast <- IO Bool -> WriterT (First SomeException) IO Bool
    forall a. IO a -> WriterT (First SomeException) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Bool -> WriterT (First SomeException) IO Bool)
    -> IO Bool -> WriterT (First SomeException) IO Bool
    forall a b. (a -> b) -> a -> b
    $ STM Bool -> IO Bool
    forall a. STM a -> IO a
    atomically (STM Bool -> IO Bool) -> STM Bool -> IO Bool
    forall a b. (a -> b) -> a -> b
    $ do
                  nUsers <- TVar Int -> STM Int
    forall a. TVar a -> STM a
    readTVar TVar Int
    finishVar
                  let nUsers' = Int
    nUsers Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1
                  writeTVar finishVar nUsers'
                  return $ nUsers' == 0

                mbExcn <- liftIO $
                  if iAmLast
                  then destroyResource restore fin
                  else return Nothing

                tell $ First mbExcn

        yieldProgress :: Progress -> f ()
    yieldProgress Progress
    _newP | HideProgress -> Bool
    getHideProgress HideProgress
    hideProgressOpt =
          () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        yieldProgress Progress
    newP | Progress
    newP Progress -> Progress -> Bool
    forall a. Eq a => a -> a -> Bool
    == Progress
    emptyProgress =
          -- This could be changed to `Maybe Progress` to lets more easily indicate
          -- when progress should try to be printed ?
          () -> f ()
    forall a. a -> f a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
        yieldProgress Progress
    newP = IO () -> f ()
    forall a. IO a -> f a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO
          (IO () -> f ()) -> (Status -> IO ()) -> Status -> f ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM () -> IO ()
    forall a. STM a -> IO a
    atomically
          (STM () -> IO ()) -> (Status -> STM ()) -> Status -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TVar Status -> Status -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Status
    statusVar
          (Status -> f ()) -> Status -> f ()
    forall a b. (a -> b) -> a -> b
    $ Progress -> Status
    Executing Progress
    newP

    -- | Traversal type used in 'createTestActions'
    type Tr = ReaderT (Path, Seq Dependency) IO (TestActionTree UnresolvedAction)

    -- | Exceptions related to dependencies between tests.
    --
    -- @since 1.2
    newtype DependencyException
      = DependencyLoop [[Path]]
        -- ^ Test dependencies form cycles. In other words, test A cannot start
        -- until test B finishes, and test B cannot start until test
        -- A finishes. Field lists detected cycles.
        --
        -- @since 1.5
      deriving (Typeable)

    instance Show DependencyException where
      show :: DependencyException -> String
    show (DependencyLoop [[Path]]
    css) = String
    "Test dependencies have cycles:\n" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [[Path]] -> String
    showCycles [[Path]]
    css
        where
          showCycles :: [[Path]] -> String
    showCycles = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "\n" ([String] -> String)
    -> ([[Path]] -> [String]) -> [[Path]] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Path] -> String) -> [[Path]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map [Path] -> String
    showCycle
          showPath :: Path -> String
    showPath = String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "." ([String] -> String) -> (Path -> [String]) -> Path -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> [String]
    forall a. Seq a -> [a]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    F.toList

          -- For clarity in the error message, the first element is repeated at the end
          showCycle :: [Path] -> String
    showCycle []     = String
    "- <empty cycle>"
          showCycle (Path
    x:[Path]
    xs) = String
    "- " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    ", " ((Path -> String) -> [Path] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Path -> String
    showPath (Path
    xPath -> [Path] -> [Path]
    forall a. a -> [a] -> [a]
    :[Path]
    xs [Path] -> [Path] -> [Path]
    forall a. [a] -> [a] -> [a]
    ++ [Path
    x]))

    instance Exception DependencyException

    -- | Specifies how to calculate a dependency
    data DependencySpec
      = ExactDep (Seq TestName) (TVar Status)
      -- ^ Dependency specified by 'TestGroup'. Note that the first field is only
      -- there for dependency cycle detection - which can be introduced by using
      -- 'PatternDep'.
      | PatternDep Expr
      -- ^ All tests matching this 'Expr' should be considered dependencies
      deriving (DependencySpec -> DependencySpec -> Bool
    (DependencySpec -> DependencySpec -> Bool)
    -> (DependencySpec -> DependencySpec -> Bool) -> Eq DependencySpec
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DependencySpec -> DependencySpec -> Bool
    == :: DependencySpec -> DependencySpec -> Bool
    $c/= :: DependencySpec -> DependencySpec -> Bool
    /= :: DependencySpec -> DependencySpec -> Bool
    Eq)

    instance Show DependencySpec where
      show :: DependencySpec -> String
    show (PatternDep Expr
    dep) = String
    "PatternDep (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Expr -> String
    forall a. Show a => a -> String
    show Expr
    dep String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ")"
      show (ExactDep Path
    testName TVar Status
    _) = String
    "ExactDep (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Path -> String
    forall a. Show a => a -> String
    show Path
    testName String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ") (<TVar>)"

    -- | Dependency of a test. Either it points to an exact path it depends on, or
    -- contains a pattern that should be tested against all tests in a 'TestTree'.
    data Dependency = Dependency DependencyType DependencySpec
      deriving (Dependency -> Dependency -> Bool
    (Dependency -> Dependency -> Bool)
    -> (Dependency -> Dependency -> Bool) -> Eq Dependency
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Dependency -> Dependency -> Bool
    == :: Dependency -> Dependency -> Bool
    $c/= :: Dependency -> Dependency -> Bool
    /= :: Dependency -> Dependency -> Bool
    Eq, Int -> Dependency -> ShowS
    [Dependency] -> ShowS
    Dependency -> String
    (Int -> Dependency -> ShowS)
    -> (Dependency -> String)
    -> ([Dependency] -> ShowS)
    -> Show Dependency
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Dependency -> ShowS
    showsPrec :: Int -> Dependency -> ShowS
    $cshow :: Dependency -> String
    show :: Dependency -> String
    $cshowList :: [Dependency] -> ShowS
    showList :: [Dependency] -> ShowS
    Show)

    -- | Is given 'Dependency' a dependency that was introduced with 'After'?
    isPatternDependency :: Dependency -> Bool
    isPatternDependency :: Dependency -> Bool
    isPatternDependency (Dependency DependencyType
    _ (PatternDep {})) = Bool
    True
    isPatternDependency Dependency
    _ = Bool
    False

    #if !MIN_VERSION_base(4,18,0)
    -- The mapAccumM function behaves like a combination of mapM and mapAccumL that
    -- traverses the structure while evaluating the actions and passing an accumulating
    -- parameter from left to right. It returns a final value of this accumulator
    -- together with the new structure. The accummulator is often used for caching the
    -- intermediate results of a computation.
    mapAccumM :: Monad m => (acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
    mapAccumM _ acc [] = return (acc, [])
    mapAccumM f acc (x:xs) = do
      (acc', y) <- f acc x
      (acc'', ys) <- mapAccumM f acc' xs
      return (acc'', y:ys)
    #endif

    -- | An action with meta information
    data TestAction act = TestAction
      { forall act. TestAction act -> act
    testAction :: act
        -- ^ Some action, typically 'UnresolvedAction', 'ResolvedAction', or 'Action'.
      , forall act. TestAction act -> Path
    testPath :: Path
        -- ^ Path pointing to this action (a series of group names + a test name)
      , forall act. TestAction act -> Seq Dependency
    testDeps :: Seq Dependency
        -- ^ Dependencies introduced by AWK-like patterns
      , forall act. TestAction act -> TVar Status
    testStatus :: TVar Status
        -- ^ Status var that can be used to monitor test progress
      }

    -- | A test that still needs to be given its resource initializers and finalizers
    type UnresolvedAction = Seq Initializer -> Seq Finalizer -> IO ()

    -- | A test that, unlike 'UnresolvedAction', has been given its initializers and
    -- finalizers.
    type ResolvedAction = IO ()

    -- | Number of 'TAction' leafs in a 'TestActionTree'. Used to prevent repeated
    -- size calculations.
    type Size = Int

    -- | Simplified version of 'TestTree' that only includes the tests to be run (as
    -- a 'TestAction') and the resources needed to run them (as 'Initializer's and
    -- 'Finalizer's).
    data TestActionTree act
      = TResource Initializer Finalizer (TestActionTree act)
      | TGroup Size [TestActionTree act]
      -- ^ Note the 'Size' field of this constructor: it stores how many 'TAction's
      -- are present in the tree. Functions using constructing this constructor
      -- should take care, or use 'tGroup' instead. If this constructor is ever
      -- exported, we should probably move it to its own module and expose only a
      -- smart constructor using pattern synonyms. For now, this seems more trouble
      -- than it's worth, given the number of types it needs defined in this module.
      | TAction (TestAction act)

    -- | Smart constructor for 'TGroup'. Fills in 'Size' field by summing the size
    -- of the given test trees.
    tGroup :: [TestActionTree act] -> TestActionTree act
    tGroup :: forall act. [TestActionTree act] -> TestActionTree act
    tGroup [TestActionTree act]
    trees = Int -> [TestActionTree act] -> TestActionTree act
    forall act. Int -> [TestActionTree act] -> TestActionTree act
    TGroup ([Int] -> Int
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((TestActionTree act -> Int) -> [TestActionTree act] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map TestActionTree act -> Int
    forall act. TestActionTree act -> Int
    testActionTreeSize [TestActionTree act]
    trees)) [TestActionTree act]
    trees

    -- | Size of a 'TestActionTree', i.e. the number of 'TAction's it contains.
    testActionTreeSize :: TestActionTree act -> Int
    testActionTreeSize :: forall act. TestActionTree act -> Int
    testActionTreeSize = \case
      TResource Initializer
    _ Finalizer
    _ TestActionTree act
    tree -> TestActionTree act -> Int
    forall act. TestActionTree act -> Int
    testActionTreeSize TestActionTree act
    tree
      TGroup Int
    size [TestActionTree act]
    _ -> Int
    size
      TAction TestAction act
    _ -> Int
    1

    -- | Collect initializers and finalizers introduced by 'TResource' and apply them
    -- to each action.
    resolveTestActions :: TestActionTree UnresolvedAction -> TestActionTree ResolvedAction
    resolveTestActions :: TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> TestActionTree (IO ())
    resolveTestActions = Seq Initializer
    -> Seq Finalizer
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> TestActionTree (IO ())
    forall {act}.
    Seq Initializer
    -> Seq Finalizer
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    -> TestActionTree act
    go Seq Initializer
    forall a. Seq a
    Seq.empty Seq Finalizer
    forall a. Seq a
    Seq.empty
     where
      go :: Seq Initializer
    -> Seq Finalizer
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    -> TestActionTree act
    go Seq Initializer
    inits Seq Finalizer
    fins = \case
        TResource Initializer
    ini Finalizer
    fin TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    tree ->
          Initializer
    -> Finalizer -> TestActionTree act -> TestActionTree act
    forall act.
    Initializer
    -> Finalizer -> TestActionTree act -> TestActionTree act
    TResource Initializer
    ini Finalizer
    fin (TestActionTree act -> TestActionTree act)
    -> TestActionTree act -> TestActionTree act
    forall a b. (a -> b) -> a -> b
    $ Seq Initializer
    -> Seq Finalizer
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    -> TestActionTree act
    go (Seq Initializer
    inits Seq Initializer -> Initializer -> Seq Initializer
    forall a. Seq a -> a -> Seq a
    |> Initializer
    ini) (Finalizer
    fin Finalizer -> Seq Finalizer -> Seq Finalizer
    forall a. a -> Seq a -> Seq a
    <| Seq Finalizer
    fins) TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    tree
        TGroup Int
    size [TestActionTree (Seq Initializer -> Seq Finalizer -> act)]
    trees ->
          Int -> [TestActionTree act] -> TestActionTree act
    forall act. Int -> [TestActionTree act] -> TestActionTree act
    TGroup Int
    size ([TestActionTree act] -> TestActionTree act)
    -> [TestActionTree act] -> TestActionTree act
    forall a b. (a -> b) -> a -> b
    $ (TestActionTree (Seq Initializer -> Seq Finalizer -> act)
     -> TestActionTree act)
    -> [TestActionTree (Seq Initializer -> Seq Finalizer -> act)]
    -> [TestActionTree act]
    forall a b. (a -> b) -> [a] -> [b]
    map (Seq Initializer
    -> Seq Finalizer
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> act)
    -> TestActionTree act
    go Seq Initializer
    inits Seq Finalizer
    fins) [TestActionTree (Seq Initializer -> Seq Finalizer -> act)]
    trees
        TAction (TestAction {TVar Status
    Path
    Seq Dependency
    Seq Initializer -> Seq Finalizer -> act
    testAction :: forall act. TestAction act -> act
    testPath :: forall act. TestAction act -> Path
    testDeps :: forall act. TestAction act -> Seq Dependency
    testStatus :: forall act. TestAction act -> TVar Status
    testAction :: Seq Initializer -> Seq Finalizer -> act
    testPath :: Path
    testDeps :: Seq Dependency
    testStatus :: TVar Status
    ..})->
          TestAction act -> TestActionTree act
    forall act. TestAction act -> TestActionTree act
    TAction (TestAction act -> TestActionTree act)
    -> TestAction act -> TestActionTree act
    forall a b. (a -> b) -> a -> b
    $ TestAction { testAction :: act
    testAction = Seq Initializer -> Seq Finalizer -> act
    testAction Seq Initializer
    inits Seq Finalizer
    fins, TVar Status
    Path
    Seq Dependency
    testPath :: Path
    testDeps :: Seq Dependency
    testStatus :: TVar Status
    testPath :: Path
    testDeps :: Seq Dependency
    testStatus :: TVar Status
    .. }

    -- | Turn a test tree into a list of actions to run tests coupled with
    -- variables to watch them. Additionally, a collection of finalizers is
    -- returned that can be used to clean up resources in case of unexpected
    -- events.
    createTestActions
      :: OptionSet
      -> TestTree
      -> IO ([TestAction Action], Seq Finalizer)
    createTestActions :: OptionSet -> TestTree -> IO ([TestAction Action], Seq Finalizer)
    createTestActions OptionSet
    opts0 TestTree
    tree = do
      -- Folding the test tree reduces it to a 'TestActionTree', which is a simplified
      -- version of 'TestTree' that only includes the tests to be run, resources needed
      -- to run them, and meta information needed to watch test progress and calculate
      -- dependencies in 'resolveDeps'.
      unresolvedTestTree :: TestActionTree UnresolvedAction <-
        (ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
     -> (Path, Seq Dependency)
     -> IO (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> (Path, Seq Dependency)
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> IO (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip ReaderT
      (Path, Seq Dependency)
      IO
      (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> (Path, Seq Dependency)
    -> IO (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ((Path, Seq Dependency)
    forall a. Monoid a => a
    mempty :: (Path, Seq Dependency)) (ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
     -> IO (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> IO (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a b. (a -> b) -> a -> b
    $
          ReaderT
      (Path, Seq Dependency)
      IO
      (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> TreeFold
         (ReaderT
            (Path, Seq Dependency)
            IO
            (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> OptionSet
    -> TestTree
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall b. b -> TreeFold b -> OptionSet -> TestTree -> b
    foldTestTree0 (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a. a -> ReaderT (Path, Seq Dependency) IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    forall act. [TestActionTree act] -> TestActionTree act
    tGroup [])) (TreeFold { OptionSet
    -> String
    -> t
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    OptionSet
    -> String
    -> [ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    OptionSet
    -> DependencyType
    -> Expr
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    OptionSet
    -> ResourceSpec a
    -> (IO a
        -> ReaderT
             (Path, Seq Dependency)
             IO
             (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a.
    OptionSet
    -> ResourceSpec a
    -> (IO a
        -> ReaderT
             (Path, Seq Dependency)
             IO
             (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall t.
    IsTest t =>
    OptionSet
    -> String
    -> t
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldSingle :: forall t.
    IsTest t =>
    OptionSet
    -> String
    -> t
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldResource :: forall a.
    OptionSet
    -> ResourceSpec a
    -> (IO a
        -> ReaderT
             (Path, Seq Dependency)
             IO
             (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldAfter :: OptionSet
    -> DependencyType
    -> Expr
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldGroup :: OptionSet
    -> String
    -> [ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldAfter :: OptionSet
    -> DependencyType
    -> Expr
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldResource :: forall a.
    OptionSet
    -> ResourceSpec a
    -> (IO a
        -> ReaderT
             (Path, Seq Dependency)
             IO
             (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldGroup :: OptionSet
    -> String
    -> [ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldSingle :: forall t.
    IsTest t =>
    OptionSet
    -> String
    -> t
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    .. }) OptionSet
    opts0 TestTree
    tree

      let
        finalizers :: Seq Finalizer
        finalizers = TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> Seq Finalizer
    forall act. TestActionTree act -> Seq Finalizer
    collectFinalizers TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    unresolvedTestTree

        tests :: [TestAction ResolvedAction]
        tests = TestActionTree (IO ()) -> [TestAction (IO ())]
    forall act. TestActionTree act -> [TestAction act]
    collectTests (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> TestActionTree (IO ())
    resolveTestActions TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    unresolvedTestTree)

      case resolveDeps tests of
        Right [TestAction Action]
    tests' -> ([TestAction Action], Seq Finalizer)
    -> IO ([TestAction Action], Seq Finalizer)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TestAction Action]
    tests', Seq Finalizer
    finalizers)
        Left [[Path]]
    cycles  -> DependencyException -> IO ([TestAction Action], Seq Finalizer)
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO ([[Path]] -> DependencyException
    DependencyLoop [[Path]]
    cycles)

      where
        -- * Functions used in 'TreeFold'
        foldSingle :: IsTest t => OptionSet -> TestName -> t -> Tr
        foldSingle :: forall t.
    IsTest t =>
    OptionSet
    -> String
    -> t
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldSingle OptionSet
    opts String
    name t
    test = do
          testStatus <- IO (TVar Status) -> ReaderT (Path, Seq Dependency) IO (TVar Status)
    forall a. IO a -> ReaderT (Path, Seq Dependency) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (TVar Status)
     -> ReaderT (Path, Seq Dependency) IO (TVar Status))
    -> IO (TVar Status)
    -> ReaderT (Path, Seq Dependency) IO (TVar Status)
    forall a b. (a -> b) -> a -> b
    $ Status -> IO (TVar Status)
    forall a. a -> IO (TVar a)
    newTVarIO Status
    NotStarted
          (parentPath, testDeps) <- ask
          let
            testPath = Path
    parentPath Path -> String -> Path
    forall a. Seq a -> a -> Seq a
    |> String
    name
            testAction = ((Progress -> IO ()) -> IO Result)
    -> TVar Status
    -> Timeout
    -> HideProgress
    -> Seq Initializer
    -> Seq Finalizer
    -> IO ()
    executeTest (OptionSet -> t -> (Progress -> IO ()) -> IO Result
    forall t.
    IsTest t =>
    OptionSet -> t -> (Progress -> IO ()) -> IO Result
    run OptionSet
    opts t
    test) TVar Status
    testStatus (OptionSet -> Timeout
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts) (OptionSet -> HideProgress
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts)
          pure $ TAction (TestAction {..})

        foldResource :: OptionSet -> ResourceSpec a -> (IO a -> Tr) -> Tr
        foldResource :: forall a.
    OptionSet
    -> ResourceSpec a
    -> (IO a
        -> ReaderT
             (Path, Seq Dependency)
             IO
             (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldResource OptionSet
    _opts (ResourceSpec IO a
    doInit a -> IO ()
    doRelease) IO a
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    a = do
          initVar <- IO (TVar (Resource a))
    -> ReaderT (Path, Seq Dependency) IO (TVar (Resource a))
    forall a. IO a -> ReaderT (Path, Seq Dependency) IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (TVar (Resource a))
     -> ReaderT (Path, Seq Dependency) IO (TVar (Resource a)))
    -> IO (TVar (Resource a))
    -> ReaderT (Path, Seq Dependency) IO (TVar (Resource a))
    forall a b. (a -> b) -> a -> b
    $ Resource a -> IO (TVar (Resource a))
    forall a. a -> IO (TVar a)
    newTVarIO Resource a
    forall r. Resource r
    NotCreated
          testTree <- a (getResource initVar)
          finishVar <- liftIO $ newTVarIO (testActionTreeSize testTree)
          let
            ini = IO a -> TVar (Resource a) -> Initializer
    forall res. IO res -> TVar (Resource res) -> Initializer
    Initializer IO a
    doInit TVar (Resource a)
    initVar
            fin = (a -> IO ()) -> TVar (Resource a) -> TVar Int -> Finalizer
    forall res.
    (res -> IO ()) -> TVar (Resource res) -> TVar Int -> Finalizer
    Finalizer a -> IO ()
    doRelease TVar (Resource a)
    initVar TVar Int
    finishVar
          pure $ TResource ini fin testTree

        foldAfter :: OptionSet -> DependencyType -> Expr -> Tr -> Tr
        foldAfter :: OptionSet
    -> DependencyType
    -> Expr
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldAfter OptionSet
    _opts DependencyType
    depType Expr
    pat = ((Path, Seq Dependency) -> (Path, Seq Dependency))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local ((Seq Dependency -> Seq Dependency)
    -> (Path, Seq Dependency) -> (Path, Seq Dependency)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (DependencyType -> DependencySpec -> Dependency
    Dependency DependencyType
    depType (Expr -> DependencySpec
    PatternDep Expr
    pat) Dependency -> Seq Dependency -> Seq Dependency
    forall a. a -> Seq a -> Seq a
    <|))

        foldGroup :: OptionSet -> TestName -> [Tr] -> Tr
        foldGroup :: OptionSet
    -> String
    -> [ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    foldGroup OptionSet
    opts String
    name [ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    trees =
          ([TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
     -> TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a b.
    (a -> b)
    -> ReaderT (Path, Seq Dependency) IO a
    -> ReaderT (Path, Seq Dependency) IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    forall act. [TestActionTree act] -> TestActionTree act
    tGroup (ReaderT
       (Path, Seq Dependency)
       IO
       [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
     -> ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall a b. (a -> b) -> a -> b
    $ ((Path, Seq Dependency) -> (Path, Seq Dependency))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local ((Path -> Path) -> (Path, Seq Dependency) -> (Path, Seq Dependency)
    forall b c d. (b -> c) -> (b, d) -> (c, d)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (b, d) (c, d)
    first (Path -> String -> Path
    forall a. Seq a -> a -> Seq a
    |> String
    name)) (ReaderT
       (Path, Seq Dependency)
       IO
       [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
     -> ReaderT
          (Path, Seq Dependency)
          IO
          [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    forall a b. (a -> b) -> a -> b
    $
            case OptionSet -> ExecutionMode
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts of
              ExecutionMode
    Parallel ->
                [ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    trees
              Sequential DependencyType
    depType ->
                (Seq Dependency,
     [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
    -> [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    forall a b. (a, b) -> b
    snd ((Seq Dependency,
      [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
     -> [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (Seq Dependency,
          [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
    -> ReaderT
         (Path, Seq Dependency)
         IO
         [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Seq Dependency
     -> ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
     -> ReaderT
          (Path, Seq Dependency)
          IO
          (Seq Dependency,
           TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())))
    -> Seq Dependency
    -> [ReaderT
          (Path, Seq Dependency)
          IO
          (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (Seq Dependency,
          [TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())])
    forall (m :: * -> *) (t :: * -> *) s a b.
    (Monad m, Traversable t) =>
    (s -> a -> m (s, b)) -> s -> t a -> m (s, t b)
    mapAccumM (DependencyType
    -> Seq Dependency
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (Seq Dependency,
          TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    goSeqGroup DependencyType
    depType) Seq Dependency
    forall a. Monoid a => a
    mempty [ReaderT
       (Path, Seq Dependency)
       IO
       (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))]
    trees

        -- * Utility functions
        collectTests :: TestActionTree act -> [TestAction act]
        collectTests :: forall act. TestActionTree act -> [TestAction act]
    collectTests = \case
          TResource Initializer
    _ Finalizer
    _ TestActionTree act
    t -> TestActionTree act -> [TestAction act]
    forall act. TestActionTree act -> [TestAction act]
    collectTests TestActionTree act
    t
          TGroup Int
    _ [TestActionTree act]
    trees  -> (TestActionTree act -> [TestAction act])
    -> [TestActionTree act] -> [TestAction act]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap TestActionTree act -> [TestAction act]
    forall act. TestActionTree act -> [TestAction act]
    collectTests [TestActionTree act]
    trees
          TAction TestAction act
    action  -> [TestAction act
    action]

        collectFinalizers :: TestActionTree act -> Seq Finalizer
        collectFinalizers :: forall act. TestActionTree act -> Seq Finalizer
    collectFinalizers = \case
          TResource Initializer
    _ Finalizer
    fin TestActionTree act
    t -> TestActionTree act -> Seq Finalizer
    forall act. TestActionTree act -> Seq Finalizer
    collectFinalizers TestActionTree act
    t Seq Finalizer -> Finalizer -> Seq Finalizer
    forall a. Seq a -> a -> Seq a
    |> Finalizer
    fin
          TGroup Int
    _ [TestActionTree act]
    trees    -> [Seq Finalizer] -> Seq Finalizer
    forall a. Monoid a => [a] -> a
    mconcat ((TestActionTree act -> Seq Finalizer)
    -> [TestActionTree act] -> [Seq Finalizer]
    forall a b. (a -> b) -> [a] -> [b]
    map TestActionTree act -> Seq Finalizer
    forall act. TestActionTree act -> Seq Finalizer
    collectFinalizers [TestActionTree act]
    trees)
          TAction TestAction act
    _         -> Seq Finalizer
    forall a. Monoid a => a
    mempty

        goSeqGroup
          :: DependencyType
          -> Seq Dependency
          -> Tr
          -> ReaderT (Path, Seq Dependency) IO (Seq Dependency, TestActionTree UnresolvedAction)
        goSeqGroup :: DependencyType
    -> Seq Dependency
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (Seq Dependency,
          TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    goSeqGroup DependencyType
    depType Seq Dependency
    prevDeps ReaderT
      (Path, Seq Dependency)
      IO
      (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    treeM = do
          tree0 <- ((Path, Seq Dependency) -> (Path, Seq Dependency))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    -> ReaderT
         (Path, Seq Dependency)
         IO
         (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    forall r (m :: * -> *) a.
    (r -> r) -> ReaderT r m a -> ReaderT r m a
    local ((Seq Dependency -> Seq Dependency)
    -> (Path, Seq Dependency) -> (Path, Seq Dependency)
    forall b c d. (b -> c) -> (d, b) -> (d, c)
    forall (a :: * -> * -> *) b c d.
    Arrow a =>
    a b c -> a (d, b) (d, c)
    second (Seq Dependency
    prevDeps Seq Dependency -> Seq Dependency -> Seq Dependency
    forall a. Seq a -> Seq a -> Seq a
    ><)) ReaderT
      (Path, Seq Dependency)
      IO
      (TestActionTree (Seq Initializer -> Seq Finalizer -> IO ()))
    treeM

          let
            toDep TestAction {act
    TVar Status
    Path
    Seq Dependency
    testAction :: forall act. TestAction act -> act
    testPath :: forall act. TestAction act -> Path
    testDeps :: forall act. TestAction act -> Seq Dependency
    testStatus :: forall act. TestAction act -> TVar Status
    testAction :: act
    testPath :: Path
    testDeps :: Seq Dependency
    testStatus :: TVar Status
    ..} = DependencyType -> DependencySpec -> Dependency
    Dependency DependencyType
    depType (Path -> TVar Status -> DependencySpec
    ExactDep Path
    testPath TVar Status
    testStatus)
            deps0 = [Dependency] -> Seq Dependency
    forall a. [a] -> Seq a
    Seq.fromList (TestAction (Seq Initializer -> Seq Finalizer -> IO ())
    -> Dependency
    forall {act}. TestAction act -> Dependency
    toDep (TestAction (Seq Initializer -> Seq Finalizer -> IO ())
     -> Dependency)
    -> [TestAction (Seq Initializer -> Seq Finalizer -> IO ())]
    -> [Dependency]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    -> [TestAction (Seq Initializer -> Seq Finalizer -> IO ())]
    forall act. TestActionTree act -> [TestAction act]
    collectTests TestActionTree (Seq Initializer -> Seq Finalizer -> IO ())
    tree0)

            -- If this test tree is empty (either due to it being actually empty, or due
            -- to all tests being filtered) we need to propagate the previous dependencies.
            deps1 = if Seq Dependency -> Bool
    forall a. Seq a -> Bool
    Seq.null Seq Dependency
    deps0 then Seq Dependency
    prevDeps else Seq Dependency
    deps0

          pure (deps1, tree0)

    -- | Take care of the dependencies.
    --
    -- Return 'Left' if there is a dependency cycle, containing the detected cycles.
    resolveDeps
      :: [TestAction ResolvedAction]
      -> Either [[Path]] [TestAction Action]
    resolveDeps :: [TestAction (IO ())] -> Either [[Path]] [TestAction Action]
    resolveDeps [TestAction (IO ())]
    tests = [(TestAction Action, (Path, [Path]))]
    -> Either [[Path]] [TestAction Action]
    forall {a}. [(a, (Path, [Path]))] -> Either [[Path]] [a]
    maybeCheckCycles ([(TestAction Action, (Path, [Path]))]
     -> Either [[Path]] [TestAction Action])
    -> [(TestAction Action, (Path, [Path]))]
    -> Either [[Path]] [TestAction Action]
    forall a b. (a -> b) -> a -> b
    $ do
      TestAction { testAction=run_test, .. } <- [TestAction (IO ())]
    tests

      let
        deps' = (Dependency -> [(DependencyType, TVar Status, Path)])
    -> Seq Dependency -> [(DependencyType, TVar Status, Path)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Dependency -> [(DependencyType, TVar Status, Path)]
    findDeps Seq Dependency
    testDeps

        getStatus :: STM ActionStatus
        getStatus = ((DependencyType, TVar Status, Path)
     -> STM ActionStatus -> STM ActionStatus)
    -> STM ActionStatus
    -> [(DependencyType, TVar Status, Path)]
    -> STM ActionStatus
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr
          (\(DependencyType
    deptype, TVar Status
    statusvar, Path
    _) STM ActionStatus
    k -> do
            status <- TVar Status -> STM Status
    forall a. TVar a -> STM a
    readTVar TVar Status
    statusvar
            case status of
              Done Result
    result
                | DependencyType
    deptype DependencyType -> DependencyType -> Bool
    forall a. Eq a => a -> a -> Bool
    == DependencyType
    AllFinish Bool -> Bool -> Bool
    || Result -> Bool
    resultSuccessful Result
    result -> STM ActionStatus
    k
                | Bool
    otherwise -> ActionStatus -> STM ActionStatus
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActionStatus
    ActionSkip
              Status
    _ -> ActionStatus -> STM ActionStatus
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActionStatus
    ActionWait
          )
          (ActionStatus -> STM ActionStatus
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ActionStatus
    ActionReady)
          [(DependencyType, TVar Status, Path)]
    deps'
      let
        dep_paths = ((DependencyType, TVar Status, Path) -> Path)
    -> [(DependencyType, TVar Status, Path)] -> [Path]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(DependencyType
    _, TVar Status
    _, Path
    path) -> Path
    path) [(DependencyType, TVar Status, Path)]
    deps'
        action = Action
          { actionStatus :: STM ActionStatus
    actionStatus = STM ActionStatus
    getStatus
          , actionRun :: IO ()
    actionRun = IO ()
    run_test
          , actionSkip :: STM ()
    actionSkip = TVar Status -> Status -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar Status
    testStatus (Status -> STM ()) -> Status -> STM ()
    forall a b. (a -> b) -> a -> b
    $ Result -> Status
    Done (Result -> Status) -> Result -> Status
    forall a b. (a -> b) -> a -> b
    $ Result
              -- See Note [Skipped tests]
              { resultOutcome :: Outcome
    resultOutcome = FailureReason -> Outcome
    Failure FailureReason
    TestDepFailed
              , resultDescription :: String
    resultDescription = String
    ""
              , resultShortDescription :: String
    resultShortDescription = String
    "SKIP"
              , resultTime :: Time
    resultTime = Time
    0
              , resultDetailsPrinter :: ResultDetailsPrinter
    resultDetailsPrinter = ResultDetailsPrinter
    noResultDetails
              }
          }
      return (TestAction { testAction = action, .. }, (testPath, dep_paths))
     where
      -- Skip cycle checking if no patterns are used: sequential test groups can't
      -- introduce cycles on their own.
      maybeCheckCycles :: [(a, (Path, [Path]))] -> Either [[Path]] [a]
    maybeCheckCycles
        | (TestAction (IO ()) -> Bool) -> [TestAction (IO ())] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ((Dependency -> Bool) -> Seq Dependency -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Dependency -> Bool
    isPatternDependency (Seq Dependency -> Bool)
    -> (TestAction (IO ()) -> Seq Dependency)
    -> TestAction (IO ())
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TestAction (IO ()) -> Seq Dependency
    forall act. TestAction act -> Seq Dependency
    testDeps) [TestAction (IO ())]
    tests = [(a, (Path, [Path]))] -> Either [[Path]] [a]
    forall b a. Ord b => [(a, (b, [b]))] -> Either [[b]] [a]
    checkCycles
        | Bool
    otherwise = [a] -> Either [[Path]] [a]
    forall a b. b -> Either a b
    Right ([a] -> Either [[Path]] [a])
    -> ([(a, (Path, [Path]))] -> [a])
    -> [(a, (Path, [Path]))]
    -> Either [[Path]] [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((a, (Path, [Path])) -> a) -> [(a, (Path, [Path]))] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, (Path, [Path])) -> a
    forall a b. (a, b) -> a
    fst

      findDeps :: Dependency -> [(DependencyType, TVar Status, Seq TestName)]
      findDeps :: Dependency -> [(DependencyType, TVar Status, Path)]
    findDeps (Dependency DependencyType
    depType DependencySpec
    depSpec) =
        case DependencySpec
    depSpec of
          ExactDep Path
    testPath TVar Status
    statusVar ->
            -- A dependency defined using 'TestGroup' has already been pinpointed
            -- to its 'statusVar' in 'createTestActions'.
            [(DependencyType
    depType, TVar Status
    statusVar, Path
    testPath)]
          PatternDep Expr
    expr -> do
            -- A dependency defined using patterns needs to scan the whole test
            -- tree for matching tests.
            TestAction{testPath, testStatus} <- [TestAction (IO ())]
    tests
            guard $ exprMatches expr testPath
            [(depType, testStatus, testPath)]

    -- | Check a graph, given as an adjacency list, for cycles. Return 'Left' if the
    -- graph contained cycles, or return all nodes in the graph as a 'Right' if it
    -- didn't.
    checkCycles :: Ord b => [(a, (b, [b]))] -> Either [[b]] [a]
    checkCycles :: forall b a. Ord b => [(a, (b, [b]))] -> Either [[b]] [a]
    checkCycles [(a, (b, [b]))]
    tests = do
      let
        result :: [a]
    result = (a, (b, [b])) -> a
    forall a b. (a, b) -> a
    fst ((a, (b, [b])) -> a) -> [(a, (b, [b]))] -> [a]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(a, (b, [b]))]
    tests
        graph :: [(b, b, [b])]
    graph = [ (b
    v, b
    v, [b]
    vs) | (b
    v, [b]
    vs) <- (a, (b, [b])) -> (b, [b])
    forall a b. (a, b) -> b
    snd ((a, (b, [b])) -> (b, [b])) -> [(a, (b, [b]))] -> [(b, [b])]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [(a, (b, [b]))]
    tests ]
        sccs :: [SCC b]
    sccs = [(b, b, [b])] -> [SCC b]
    forall key node. Ord key => [(node, key, [key])] -> [SCC node]
    stronglyConnComp [(b, b, [b])]
    graph
        cycles :: [[b]]
    cycles =
          ((SCC b -> Maybe [b]) -> [SCC b] -> [[b]])
    -> [SCC b] -> (SCC b -> Maybe [b]) -> [[b]]
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip (SCC b -> Maybe [b]) -> [SCC b] -> [[b]]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe [SCC b]
    sccs ((SCC b -> Maybe [b]) -> [[b]]) -> (SCC b -> Maybe [b]) -> [[b]]
    forall a b. (a -> b) -> a -> b
    $ \case
            AcyclicSCC{} -> Maybe [b]
    forall a. Maybe a
    Nothing
            CyclicSCC [b]
    vs -> [b] -> Maybe [b]
    forall a. a -> Maybe a
    Just [b]
    vs

      case [[b]]
    cycles of
        [] -> [a] -> Either [[b]] [a]
    forall a b. b -> Either a b
    Right [a]
    result
        [[b]]
    _  -> [[b]] -> Either [[b]] [a]
    forall a b. a -> Either a b
    Left [[b]]
    cycles

    -- | Used to create the IO action which is passed in a WithResource node
    getResource :: TVar (Resource r) -> IO r
    getResource :: forall r. TVar (Resource r) -> IO r
    getResource TVar (Resource r)
    var =
      STM r -> IO r
    forall a. STM a -> IO a
    atomically (STM r -> IO r) -> STM r -> IO r
    forall a b. (a -> b) -> a -> b
    $ do
        rState <- TVar (Resource r) -> STM (Resource r)
    forall a. TVar a -> STM a
    readTVar TVar (Resource r)
    var
        case rState of
          Created r
    r -> r -> STM r
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    r
          Resource r
    Destroyed -> ResourceError -> STM r
    forall e a. Exception e => e -> STM a
    throwSTM ResourceError
    UseOutsideOfTest
          Resource r
    _ -> SomeException -> STM r
    forall e a. Exception e => e -> STM a
    throwSTM (SomeException -> STM r) -> SomeException -> STM r
    forall a b. (a -> b) -> a -> b
    $ String -> Resource r -> SomeException
    forall r. String -> Resource r -> SomeException
    unexpectedState String
    "getResource" Resource r
    rState

    -- | Run a resource finalizer.
    --
    -- This function is called from two different places:
    --
    -- 1. A test thread, which is the last one to use the resource.
    -- 2. The main thread, if an exception (e.g. Ctrl-C) is received.
    --
    -- Therefore, it is possible that this function is called multiple
    -- times concurrently on the same finalizer.
    --
    -- This function should be run with async exceptions masked,
    -- and the restore function should be passed as an argument.
    destroyResource :: (forall a . IO a -> IO a) -> Finalizer -> IO (Maybe SomeException)
    destroyResource :: (forall a. IO a -> IO a) -> Finalizer -> IO (Maybe SomeException)
    destroyResource forall a. IO a -> IO a
    restore (Finalizer res -> IO ()
    doRelease TVar (Resource res)
    stateVar TVar Int
    _) = IO (IO (Maybe SomeException)) -> IO (Maybe SomeException)
    forall (m :: * -> *) a. Monad m => m (m a) -> m a
    join (IO (IO (Maybe SomeException)) -> IO (Maybe SomeException))
    -> (STM (IO (Maybe SomeException))
        -> IO (IO (Maybe SomeException)))
    -> STM (IO (Maybe SomeException))
    -> IO (Maybe SomeException)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . STM (IO (Maybe SomeException)) -> IO (IO (Maybe SomeException))
    forall a. STM a -> IO a
    atomically (STM (IO (Maybe SomeException)) -> IO (Maybe SomeException))
    -> STM (IO (Maybe SomeException)) -> IO (Maybe SomeException)
    forall a b. (a -> b) -> a -> b
    $ do
      rState <- TVar (Resource res) -> STM (Resource res)
    forall a. TVar a -> STM a
    readTVar TVar (Resource res)
    stateVar
      case rState of
        Created res
    res -> do
          TVar (Resource res) -> Resource res -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Resource res)
    stateVar Resource res
    forall r. Resource r
    BeingDestroyed
          IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO (Maybe SomeException) -> STM (IO (Maybe SomeException)))
    -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a b. (a -> b) -> a -> b
    $
            ((SomeException -> Maybe SomeException)
    -> (() -> Maybe SomeException)
    -> Either SomeException ()
    -> Maybe SomeException
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either SomeException -> Maybe SomeException
    forall a. a -> Maybe a
    Just (Maybe SomeException -> () -> Maybe SomeException
    forall a b. a -> b -> a
    const Maybe SomeException
    forall a. Maybe a
    Nothing)
              (Either SomeException () -> Maybe SomeException)
    -> IO (Either SomeException ()) -> IO (Maybe SomeException)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IO () -> IO (Either SomeException ())
    forall e a. Exception e => IO a -> IO (Either e a)
    try (IO () -> IO ()
    forall a. IO a -> IO a
    restore (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ res -> IO ()
    doRelease res
    res))
              IO (Maybe SomeException) -> IO () -> IO (Maybe SomeException)
    forall a b. IO a -> IO b -> IO a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* STM () -> IO ()
    forall a. STM a -> IO a
    atomically (TVar (Resource res) -> Resource res -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Resource res)
    stateVar Resource res
    forall r. Resource r
    Destroyed)
        Resource res
    BeingCreated   -> STM (IO (Maybe SomeException))
    forall a. STM a
    retry
        -- If the resource is being destroyed, wait until it is destroyed.
        -- This is so that we don't start destroying the next resource out of
        -- order.
        Resource res
    BeingDestroyed -> STM (IO (Maybe SomeException))
    forall a. STM a
    retry
        Resource res
    NotCreated -> do
          -- prevent the resource from being created by a competing thread
          TVar (Resource res) -> Resource res -> STM ()
    forall a. TVar a -> a -> STM ()
    writeTVar TVar (Resource res)
    stateVar Resource res
    forall r. Resource r
    Destroyed
          IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO (Maybe SomeException) -> STM (IO (Maybe SomeException)))
    -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a b. (a -> b) -> a -> b
    $ Maybe SomeException -> IO (Maybe SomeException)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SomeException
    forall a. Maybe a
    Nothing
        FailedToCreate {} -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO (Maybe SomeException) -> STM (IO (Maybe SomeException)))
    -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a b. (a -> b) -> a -> b
    $ Maybe SomeException -> IO (Maybe SomeException)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SomeException
    forall a. Maybe a
    Nothing
        Resource res
    Destroyed         -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a. a -> STM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IO (Maybe SomeException) -> STM (IO (Maybe SomeException)))
    -> IO (Maybe SomeException) -> STM (IO (Maybe SomeException))
    forall a b. (a -> b) -> a -> b
    $ Maybe SomeException -> IO (Maybe SomeException)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SomeException
    forall a. Maybe a
    Nothing

    -- While tasty allows to configure 'OptionSet' at any level of test tree,
    -- it often has any effect only on options of test providers (class IsTest).
    -- But test runners and reporters typically only look into the OptionSet
    -- they were given as an argument. This is not unreasonable: e. g., if an option
    -- is a log filename you cannot expect to change it in the middle of the run.
    -- It is however too restrictive: there is no way to use 'defaultMain' but hardcode
    -- a global option, without passing it via command line.
    --
    -- 'applyTopLevelPlusTestOptions' allows for a compromise: unwrap top-level
    -- 'PlusTestOptions' from the 'TestTree' and apply them to the 'OptionSet'
    -- from command line. This way a user can wrap their tests in
    -- 'adjustOption' / 'localOption' forcing, for instance, 'NumThreads' to 1.
    --
    -- This function is not publicly exposed.
    applyTopLevelPlusTestOptions
      :: OptionSet
      -- ^ Raw options, typically from the command-line arguments.
      -> TestTree
      -- ^ Raw test tree.
      -> (OptionSet, TestTree)
      -- ^ Extended options and test tree stripped of outer layers of 'PlusTestOptions'.
    applyTopLevelPlusTestOptions :: OptionSet -> TestTree -> (OptionSet, TestTree)
    applyTopLevelPlusTestOptions OptionSet
    opts (PlusTestOptions OptionSet -> OptionSet
    f TestTree
    tree) =
      OptionSet -> TestTree -> (OptionSet, TestTree)
    applyTopLevelPlusTestOptions (OptionSet -> OptionSet
    f OptionSet
    opts) TestTree
    tree
    applyTopLevelPlusTestOptions OptionSet
    opts TestTree
    tree = (OptionSet
    opts, TestTree
    tree)

    -- | Start running the tests (in background, in parallel) and pass control
    -- to the callback.
    --
    -- Once the callback returns, stop running the tests.
    --
    -- The number of test running threads is determined by the 'NumThreads'
    -- option.
    --
    -- @since 0.10
    launchTestTree
      :: OptionSet
      -> TestTree
      -> (StatusMap -> IO (Time -> IO a))
        -- ^ A callback. First, it receives the 'StatusMap' through which it
        -- can observe the execution of tests in real time. Typically (but not
        -- necessarily), it waits until all the tests are finished.
        --
        -- After this callback returns, the test-running threads (if any) are
        -- terminated and all resources acquired by tests are released.
        --
        -- The callback must return another callback (of type @'Time' -> 'IO'
        -- a@) which additionally can report and/or record the total time
        -- taken by the test suite. This time includes the time taken to run
        -- all resource initializers and finalizers, which is why it is more
        -- accurate than what could be measured from inside the first callback.
      -> IO a
    launchTestTree :: forall a.
    OptionSet -> TestTree -> (StatusMap -> IO (Time -> IO a)) -> IO a
    launchTestTree OptionSet
    opts' TestTree
    tree' StatusMap -> IO (Time -> IO a)
    k0 = do
      -- Normally 'applyTopLevelPlusTestOptions' has been already applied by
      -- 'Test.Tasty.Ingredients.tryIngredients', but 'launchTestTree' is exposed
      -- publicly, so in principle clients could use it outside of 'tryIngredients'.
      -- Thus running 'applyTopLevelPlusTestOptions' again, just to be sure.
      let (OptionSet
    opts, TestTree
    tree) = OptionSet -> TestTree -> (OptionSet, TestTree)
    applyTopLevelPlusTestOptions OptionSet
    opts' TestTree
    tree'
      (testActions, fins) <- OptionSet -> TestTree -> IO ([TestAction Action], Seq Finalizer)
    createTestActions OptionSet
    opts TestTree
    tree
      let NumThreads numThreads = lookupOption opts
      (t,k1) <- timed $ do
         abortTests <- runInParallel numThreads (testAction <$> testActions)
         (do let smap = [(Int, TVar Status)] -> StatusMap
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromDistinctAscList ([(Int, TVar Status)] -> StatusMap)
    -> [(Int, TVar Status)] -> StatusMap
    forall a b. (a -> b) -> a -> b
    $ [Int] -> [TVar Status] -> [(Int, TVar Status)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    0..] (TestAction Action -> TVar Status
    forall act. TestAction act -> TVar Status
    testStatus (TestAction Action -> TVar Status)
    -> [TestAction Action] -> [TVar Status]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [TestAction Action]
    testActions)
             k0 smap)
          `finallyRestore` \forall a. IO a -> IO a
    restore -> do
             -- Tell all running tests to wrap up.
             IO ()
    abortTests
             -- Destroy all allocated resources in the case they didn't get
             -- destroyed by their tests. (See #75.)
             (Finalizer -> IO (Maybe SomeException)) -> Seq Finalizer -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    F.mapM_ ((forall a. IO a -> IO a) -> Finalizer -> IO (Maybe SomeException)
    destroyResource IO a -> IO a
    forall a. IO a -> IO a
    restore) Seq Finalizer
    fins
             -- Wait until all resources are destroyed. (Specifically, those
             -- that were being destroyed by their tests, not those that were
             -- destroyed by destroyResource above.)
             IO () -> IO ()
    forall a. IO a -> IO a
    restore (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Seq Finalizer -> IO ()
    forall {t :: * -> *}. Foldable t => t Finalizer -> IO ()
    waitForResources Seq Finalizer
    fins
      k1 t
      where
        alive :: Resource r -> Bool
        alive :: forall r. Resource r -> Bool
    alive Resource r
    r = case Resource r
    r of
          Resource r
    NotCreated -> Bool
    False
          Resource r
    BeingCreated -> Bool
    True
          FailedToCreate {} -> Bool
    False
          Created {} -> Bool
    True
          Resource r
    BeingDestroyed -> Bool
    True
          Resource r
    Destroyed -> Bool
    False

        waitForResources :: t Finalizer -> IO ()
    waitForResources t Finalizer
    fins = STM () -> IO ()
    forall a. STM a -> IO a
    atomically (STM () -> IO ()) -> STM () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
          t Finalizer -> (Finalizer -> STM ()) -> STM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    t a -> (a -> m b) -> m ()
    F.forM_ t Finalizer
    fins ((Finalizer -> STM ()) -> STM ())
    -> (Finalizer -> STM ()) -> STM ()
    forall a b. (a -> b) -> a -> b
    $ \(Finalizer res -> IO ()
    _ TVar (Resource res)
    rvar TVar Int
    _) -> do
            res <- TVar (Resource res) -> STM (Resource res)
    forall a. TVar a -> STM a
    readTVar TVar (Resource res)
    rvar
            check $ not $ alive res

    unexpectedState :: String -> Resource r -> SomeException
    unexpectedState :: forall r. String -> Resource r -> SomeException
    unexpectedState String
    where_ Resource r
    r = ResourceError -> SomeException
    forall e. Exception e => e -> SomeException
    toException (ResourceError -> SomeException) -> ResourceError -> SomeException
    forall a b. (a -> b) -> a -> b
    $ String -> String -> ResourceError
    UnexpectedState String
    where_ (Resource r -> String
    forall a. Show a => a -> String
    show Resource r
    r)

    sleepIndefinitely :: IO ()
    sleepIndefinitely :: IO ()
    sleepIndefinitely = IO () -> IO ()
    forall (f :: * -> *) a b. Applicative f => f a -> f b
    forever (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay (Int
    10Int -> Int -> Int
    forall a b. (Num a, Integral b) => a -> b -> a
    ^(Int
    7::Int))

    -- | Like 'finally' (which also masks its finalizers), but pass the restore
    -- action to the finalizer.
    finallyRestore
      :: IO a
        -- ^ computation to run first
      -> ((forall c . IO c -> IO c) -> IO b)
        -- ^ computation to run afterward (even if an exception was raised)
      -> IO a
        -- ^ returns the value from the first computation
    IO a
    a finallyRestore :: forall a b. IO a -> ((forall a. IO a -> IO a) -> IO b) -> IO a
    `finallyRestore` (forall a. IO a -> IO a) -> IO b
    sequel =
      ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
    mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
    -> ((forall a. IO a -> IO a) -> IO a) -> IO a
    forall a b. (a -> b) -> a -> b
    $ \forall a. IO a -> IO a
    restore -> do
        r <- IO a -> IO a
    forall a. IO a -> IO a
    restore IO a
    a IO a -> IO b -> IO a
    forall a b. IO a -> IO b -> IO a
    `onException` (forall a. IO a -> IO a) -> IO b
    sequel IO c -> IO c
    forall a. IO a -> IO a
    restore
        _ <- sequel restore
        return r