    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveTraversable #-}
    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE ConstraintKinds #-}
    {-# LANGUAGE LambdaCase #-}
    module Test.Hspec.Core.Runner.Eval (
      EvalConfig(..)
    , ColorMode(..)
    , EvalTree
    , Tree(..)
    , EvalItem(..)
    , Concurrency(..)
    , runFormatter
    #ifdef TEST
    , mergeResults
    #endif
    ) where

    import           Prelude ()
    import           Test.Hspec.Core.Compat hiding (Monad)

    import           Control.Monad.IO.Class (liftIO)
    import           Control.Monad.Trans.Reader
    import           Control.Monad.Trans.Class

    import           Test.Hspec.Core.Util
    import           Test.Hspec.Core.Spec (Progress, FailureReason(..), Result(..), ResultStatus(..), ProgressCallback)
    import           Test.Hspec.Core.Timer
    import           Test.Hspec.Core.Format (Format)
    import qualified Test.Hspec.Core.Format as Format
    import           Test.Hspec.Core.Clock
    import           Test.Hspec.Core.Example.Location
    import           Test.Hspec.Core.Example (safeEvaluateResultStatus, exceptionToResultStatus)

    import qualified Data.List.NonEmpty as NonEmpty
    import           Data.List.NonEmpty (NonEmpty(..))

    import           Test.Hspec.Core.Runner.JobQueue

    data Tree c a =
        Node String (NonEmpty (Tree c a))
      | NodeWithCleanup (Maybe (String, Location)) c (NonEmpty (Tree c a))
      | Leaf a
      deriving (Tree c a -> Tree c a -> Bool
    (Tree c a -> Tree c a -> Bool)
    -> (Tree c a -> Tree c a -> Bool) -> Eq (Tree c a)
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
    $c== :: forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
    == :: Tree c a -> Tree c a -> Bool
    $c/= :: forall c a. (Eq c, Eq a) => Tree c a -> Tree c a -> Bool
    /= :: Tree c a -> Tree c a -> Bool
    Eq, Int -> Tree c a -> ShowS
    [Tree c a] -> ShowS
    Tree c a -> String
    (Int -> Tree c a -> ShowS)
    -> (Tree c a -> String) -> ([Tree c a] -> ShowS) -> Show (Tree c a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall c a. (Show c, Show a) => Int -> Tree c a -> ShowS
    forall c a. (Show c, Show a) => [Tree c a] -> ShowS
    forall c a. (Show c, Show a) => Tree c a -> String
    $cshowsPrec :: forall c a. (Show c, Show a) => Int -> Tree c a -> ShowS
    showsPrec :: Int -> Tree c a -> ShowS
    $cshow :: forall c a. (Show c, Show a) => Tree c a -> String
    show :: Tree c a -> String
    $cshowList :: forall c a. (Show c, Show a) => [Tree c a] -> ShowS
    showList :: [Tree c a] -> ShowS
    Show, (forall a b. (a -> b) -> Tree c a -> Tree c b)
    -> (forall a b. a -> Tree c b -> Tree c a) -> Functor (Tree c)
    forall a b. a -> Tree c b -> Tree c a
    forall a b. (a -> b) -> Tree c a -> Tree c b
    forall c a b. a -> Tree c b -> Tree c a
    forall c a b. (a -> b) -> Tree c a -> Tree c b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall c a b. (a -> b) -> Tree c a -> Tree c b
    fmap :: forall a b. (a -> b) -> Tree c a -> Tree c b
    $c<$ :: forall c a b. a -> Tree c b -> Tree c a
    <$ :: forall a b. a -> Tree c b -> Tree c a
    Functor, (forall m. Monoid m => Tree c m -> m)
    -> (forall m a. Monoid m => (a -> m) -> Tree c a -> m)
    -> (forall m a. Monoid m => (a -> m) -> Tree c a -> m)
    -> (forall a b. (a -> b -> b) -> b -> Tree c a -> b)
    -> (forall a b. (a -> b -> b) -> b -> Tree c a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Tree c a -> b)
    -> (forall b a. (b -> a -> b) -> b -> Tree c a -> b)
    -> (forall a. (a -> a -> a) -> Tree c a -> a)
    -> (forall a. (a -> a -> a) -> Tree c a -> a)
    -> (forall a. Tree c a -> [a])
    -> (forall a. Tree c a -> Bool)
    -> (forall a. Tree c a -> Int)
    -> (forall a. Eq a => a -> Tree c a -> Bool)
    -> (forall a. Ord a => Tree c a -> a)
    -> (forall a. Ord a => Tree c a -> a)
    -> (forall a. Num a => Tree c a -> a)
    -> (forall a. Num a => Tree c a -> a)
    -> Foldable (Tree c)
    forall a. Eq a => a -> Tree c a -> Bool
    forall a. Num a => Tree c a -> a
    forall a. Ord a => Tree c a -> a
    forall m. Monoid m => Tree c m -> m
    forall a. Tree c a -> Bool
    forall a. Tree c a -> Int
    forall a. Tree c a -> [a]
    forall a. (a -> a -> a) -> Tree c a -> a
    forall c a. Eq a => a -> Tree c a -> Bool
    forall c a. Num a => Tree c a -> a
    forall c a. Ord a => Tree c a -> a
    forall c m. Monoid m => Tree c m -> m
    forall m a. Monoid m => (a -> m) -> Tree c a -> m
    forall c a. Tree c a -> Bool
    forall c a. Tree c a -> Int
    forall c a. Tree c a -> [a]
    forall b a. (b -> a -> b) -> b -> Tree c a -> b
    forall a b. (a -> b -> b) -> b -> Tree c a -> b
    forall c a. (a -> a -> a) -> Tree c a -> a
    forall c m a. Monoid m => (a -> m) -> Tree c a -> m
    forall c b a. (b -> a -> b) -> b -> Tree c a -> b
    forall c a b. (a -> b -> b) -> b -> Tree c a -> b
    forall (t :: * -> *).
    (forall m. Monoid m => t m -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall m a. Monoid m => (a -> m) -> t a -> m)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall a b. (a -> b -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall b a. (b -> a -> b) -> b -> t a -> b)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. (a -> a -> a) -> t a -> a)
    -> (forall a. t a -> [a])
    -> (forall a. t a -> Bool)
    -> (forall a. t a -> Int)
    -> (forall a. Eq a => a -> t a -> Bool)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Ord a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> (forall a. Num a => t a -> a)
    -> Foldable t
    $cfold :: forall c m. Monoid m => Tree c m -> m
    fold :: forall m. Monoid m => Tree c m -> m
    $cfoldMap :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
    foldMap :: forall m a. Monoid m => (a -> m) -> Tree c a -> m
    $cfoldMap' :: forall c m a. Monoid m => (a -> m) -> Tree c a -> m
    foldMap' :: forall m a. Monoid m => (a -> m) -> Tree c a -> m
    $cfoldr :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
    foldr :: forall a b. (a -> b -> b) -> b -> Tree c a -> b
    $cfoldr' :: forall c a b. (a -> b -> b) -> b -> Tree c a -> b
    foldr' :: forall a b. (a -> b -> b) -> b -> Tree c a -> b
    $cfoldl :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
    foldl :: forall b a. (b -> a -> b) -> b -> Tree c a -> b
    $cfoldl' :: forall c b a. (b -> a -> b) -> b -> Tree c a -> b
    foldl' :: forall b a. (b -> a -> b) -> b -> Tree c a -> b
    $cfoldr1 :: forall c a. (a -> a -> a) -> Tree c a -> a
    foldr1 :: forall a. (a -> a -> a) -> Tree c a -> a
    $cfoldl1 :: forall c a. (a -> a -> a) -> Tree c a -> a
    foldl1 :: forall a. (a -> a -> a) -> Tree c a -> a
    $ctoList :: forall c a. Tree c a -> [a]
    toList :: forall a. Tree c a -> [a]
    $cnull :: forall c a. Tree c a -> Bool
    null :: forall a. Tree c a -> Bool
    $clength :: forall c a. Tree c a -> Int
    length :: forall a. Tree c a -> Int
    $celem :: forall c a. Eq a => a -> Tree c a -> Bool
    elem :: forall a. Eq a => a -> Tree c a -> Bool
    $cmaximum :: forall c a. Ord a => Tree c a -> a
    maximum :: forall a. Ord a => Tree c a -> a
    $cminimum :: forall c a. Ord a => Tree c a -> a
    minimum :: forall a. Ord a => Tree c a -> a
    $csum :: forall c a. Num a => Tree c a -> a
    sum :: forall a. Num a => Tree c a -> a
    $cproduct :: forall c a. Num a => Tree c a -> a
    product :: forall a. Num a => Tree c a -> a
    Foldable, Functor (Tree c)
    Foldable (Tree c)
    (Functor (Tree c), Foldable (Tree c)) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> Tree c a -> f (Tree c b))
    -> (forall (f :: * -> *) a.
        Applicative f =>
        Tree c (f a) -> f (Tree c a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> Tree c a -> m (Tree c b))
    -> (forall (m :: * -> *) a.
        Monad m =>
        Tree c (m a) -> m (Tree c a))
    -> Traversable (Tree c)
    forall c. Functor (Tree c)
    forall c. Foldable (Tree c)
    forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
    forall c (f :: * -> *) a.
    Applicative f =>
    Tree c (f a) -> f (Tree c a)
    forall c (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree c a -> m (Tree c b)
    forall c (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree c a -> f (Tree c b)
    forall (t :: * -> *).
    (Functor t, Foldable t) =>
    (forall (f :: * -> *) a b.
     Applicative f =>
     (a -> f b) -> t a -> f (t b))
    -> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
    -> (forall (m :: * -> *) a b.
        Monad m =>
        (a -> m b) -> t a -> m (t b))
    -> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
    -> Traversable t
    forall (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
    forall (f :: * -> *) a.
    Applicative f =>
    Tree c (f a) -> f (Tree c a)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree c a -> m (Tree c b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree c a -> f (Tree c b)
    $ctraverse :: forall c (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree c a -> f (Tree c b)
    traverse :: forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree c a -> f (Tree c b)
    $csequenceA :: forall c (f :: * -> *) a.
    Applicative f =>
    Tree c (f a) -> f (Tree c a)
    sequenceA :: forall (f :: * -> *) a.
    Applicative f =>
    Tree c (f a) -> f (Tree c a)
    $cmapM :: forall c (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree c a -> m (Tree c b)
    mapM :: forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Tree c a -> m (Tree c b)
    $csequence :: forall c (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
    sequence :: forall (m :: * -> *) a. Monad m => Tree c (m a) -> m (Tree c a)
    Traversable)

    data EvalConfig = EvalConfig {
      EvalConfig -> Format
    evalConfigFormat :: Format
    , EvalConfig -> Int
    evalConfigConcurrentJobs :: Int
    , EvalConfig -> Bool
    evalConfigFailFast :: Bool
    , EvalConfig -> ColorMode
    evalConfigColorMode :: ColorMode
    }

    data ColorMode = ColorDisabled | ColorEnabled

    data Env = Env {
      Env -> EvalConfig
    envConfig :: EvalConfig
    , Env -> IORef Bool
    envAbort :: IORef Bool
    , Env -> IORef [(Path, Item)]
    envResults :: IORef [(Path, Format.Item)]
    }

    formatEvent :: Format.Event -> EvalM ()
    formatEvent :: Event -> EvalM ()
    formatEvent Event
    event = do
      format <- (Env -> Format) -> ReaderT Env IO Format
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks ((Env -> Format) -> ReaderT Env IO Format)
    -> (Env -> Format) -> ReaderT Env IO Format
    forall a b. (a -> b) -> a -> b
    $ EvalConfig -> Format
    evalConfigFormat (EvalConfig -> Format) -> (Env -> EvalConfig) -> Env -> Format
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> EvalConfig
    envConfig
      liftIO $ format event

    type EvalM = ReaderT Env IO

    abort :: EvalM ()
    abort :: EvalM ()
    abort = do
      ref <- (Env -> IORef Bool) -> ReaderT Env IO (IORef Bool)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Env -> IORef Bool
    envAbort
      liftIO $ writeIORef ref True

    shouldAbort :: EvalM Bool
    shouldAbort :: EvalM Bool
    shouldAbort = do
      ref <- (Env -> IORef Bool) -> ReaderT Env IO (IORef Bool)
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Env -> IORef Bool
    envAbort
      liftIO $ readIORef ref

    addResult :: Path -> Format.Item -> EvalM ()
    addResult :: Path -> Item -> EvalM ()
    addResult Path
    path Item
    item = do
      ref <- (Env -> IORef [(Path, Item)])
    -> ReaderT Env IO (IORef [(Path, Item)])
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks Env -> IORef [(Path, Item)]
    envResults
      liftIO $ modifyIORef ref ((path, item) :)

    reportItem :: Path -> Maybe Location -> EvalM (Seconds, Result)  -> EvalM ()
    reportItem :: Path -> Maybe Location -> EvalM (Seconds, Result) -> EvalM ()
    reportItem Path
    path Maybe Location
    loc EvalM (Seconds, Result)
    action = do
      Path -> EvalM ()
    reportItemStarted Path
    path
      EvalM (Seconds, Result)
    action EvalM (Seconds, Result)
    -> ((Seconds, Result) -> EvalM ()) -> EvalM ()
    forall a b.
    ReaderT Env IO a -> (a -> ReaderT Env IO b) -> ReaderT Env IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Path -> Maybe Location -> (Seconds, Result) -> EvalM ()
    reportResult Path
    path Maybe Location
    loc

    reportItemStarted :: Path -> EvalM ()
    reportItemStarted :: Path -> EvalM ()
    reportItemStarted = Event -> EvalM ()
    formatEvent (Event -> EvalM ()) -> (Path -> Event) -> Path -> EvalM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> Event
    Format.ItemStarted

    reportItemDone :: Path -> Format.Item -> EvalM ()
    reportItemDone :: Path -> Item -> EvalM ()
    reportItemDone Path
    path Item
    item = do
      Path -> Item -> EvalM ()
    addResult Path
    path Item
    item
      Event -> EvalM ()
    formatEvent (Event -> EvalM ()) -> Event -> EvalM ()
    forall a b. (a -> b) -> a -> b
    $ Path -> Item -> Event
    Format.ItemDone Path
    path Item
    item

    isFailure :: Result -> Bool
    isFailure :: Result -> Bool
    isFailure Result
    r = case Result -> ResultStatus
    resultStatus Result
    r of
      Success{} -> Bool
    False
      Pending{} -> Bool
    False
      Failure{} -> Bool
    True

    reportResult :: Path -> Maybe Location -> (Seconds, Result) -> EvalM ()
    reportResult :: Path -> Maybe Location -> (Seconds, Result) -> EvalM ()
    reportResult Path
    path Maybe Location
    loc (Seconds
    duration, Result
    result) = do
      mode <- (Env -> ColorMode) -> ReaderT Env IO ColorMode
    forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
    asks (EvalConfig -> ColorMode
    evalConfigColorMode (EvalConfig -> ColorMode)
    -> (Env -> EvalConfig) -> Env -> ColorMode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Env -> EvalConfig
    envConfig)
      case result of
        Result String
    info ResultStatus
    status -> Path -> Item -> EvalM ()
    reportItemDone Path
    path (Item -> EvalM ()) -> Item -> EvalM ()
    forall a b. (a -> b) -> a -> b
    $ Maybe Location -> Seconds -> String -> Result -> Item
    Format.Item Maybe Location
    loc Seconds
    duration String
    info (Result -> Item) -> Result -> Item
    forall a b. (a -> b) -> a -> b
    $ case ResultStatus
    status of
          ResultStatus
    Success                      -> Result
    Format.Success
          Pending Maybe Location
    loc_ Maybe String
    reason          -> Maybe Location -> Maybe String -> Result
    Format.Pending Maybe Location
    loc_ Maybe String
    reason
          Failure Maybe Location
    loc_ err :: FailureReason
    err@(Error Maybe String
    _ SomeException
    e) -> Maybe Location -> FailureReason -> Result
    Format.Failure (Maybe Location
    loc_ Maybe Location -> Maybe Location -> Maybe Location
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> SomeException -> Maybe Location
    extractLocation SomeException
    e) FailureReason
    err
          Failure Maybe Location
    loc_ FailureReason
    err             -> Maybe Location -> FailureReason -> Result
    Format.Failure Maybe Location
    loc_ (FailureReason -> Result) -> FailureReason -> Result
    forall a b. (a -> b) -> a -> b
    $ case ColorMode
    mode of
            ColorMode
    ColorEnabled -> FailureReason
    err
            ColorMode
    ColorDisabled -> case FailureReason
    err of
              FailureReason
    NoReason -> FailureReason
    err
              Reason String
    _ -> FailureReason
    err
              ExpectedButGot Maybe String
    _ String
    _ String
    _ -> FailureReason
    err
              ColorizedReason String
    r -> String -> FailureReason
    Reason (ShowS
    stripAnsi String
    r)
    #if __GLASGOW_HASKELL__ < 900
              Error _ _ -> err
    #endif

    groupStarted :: Path -> EvalM ()
    groupStarted :: Path -> EvalM ()
    groupStarted = Event -> EvalM ()
    formatEvent (Event -> EvalM ()) -> (Path -> Event) -> Path -> EvalM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> Event
    Format.GroupStarted

    groupDone :: Path -> EvalM ()
    groupDone :: Path -> EvalM ()
    groupDone = Event -> EvalM ()
    formatEvent (Event -> EvalM ()) -> (Path -> Event) -> Path -> EvalM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Path -> Event
    Format.GroupDone

    data EvalItem = EvalItem {
      EvalItem -> String
    evalItemDescription :: String
    , EvalItem -> Maybe Location
    evalItemLocation :: Maybe Location
    , EvalItem -> Concurrency
    evalItemConcurrency :: Concurrency
    , EvalItem -> ProgressCallback -> IO (Seconds, Result)
    evalItemAction :: ProgressCallback -> IO (Seconds, Result)
    }

    type EvalTree = Tree (IO ()) EvalItem

    -- | Evaluate all examples of a given spec and produce a report.
    runFormatter :: EvalConfig -> [EvalTree] -> IO [(Path, Format.Item)]
    runFormatter :: EvalConfig -> [EvalTree] -> IO [(Path, Item)]
    runFormatter EvalConfig
    config [EvalTree]
    specs = do
      Int -> (JobQueue -> IO [(Path, Item)]) -> IO [(Path, Item)]
    forall a. Int -> (JobQueue -> IO a) -> IO a
    withJobQueue (EvalConfig -> Int
    evalConfigConcurrentJobs EvalConfig
    config) ((JobQueue -> IO [(Path, Item)]) -> IO [(Path, Item)])
    -> (JobQueue -> IO [(Path, Item)]) -> IO [(Path, Item)]
    forall a b. (a -> b) -> a -> b
    $ \ JobQueue
    queue -> do
        Seconds -> (IO Bool -> IO [(Path, Item)]) -> IO [(Path, Item)]
    forall a. Seconds -> (IO Bool -> IO a) -> IO a
    withTimer Seconds
    0.05 ((IO Bool -> IO [(Path, Item)]) -> IO [(Path, Item)])
    -> (IO Bool -> IO [(Path, Item)]) -> IO [(Path, Item)]
    forall a b. (a -> b) -> a -> b
    $ \ IO Bool
    timer -> do
          env <- IO Env
    mkEnv
          runningSpecs_ <- enqueueItems queue specs

          let
            applyReportProgress :: RunningItem_ IO -> RunningItem IO
            applyReportProgress RunningItem_ IO
    item = ((ProgressCallback -> IO (Seconds, Result))
     -> Path -> IO (Seconds, Result))
    -> RunningItem_ IO -> RunningItem IO
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((ProgressCallback -> IO (Seconds, Result))
    -> (Path -> ProgressCallback) -> Path -> IO (Seconds, Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO Bool -> Path -> ProgressCallback
    reportProgress IO Bool
    timer) RunningItem_ IO
    item

            runningSpecs :: [RunningTree () EvalM]
            runningSpecs = (Result -> Bool)
    -> [RunningTree (IO ()) IO] -> [RunningTree () (ReaderT Env IO)]
    applyCleanup Result -> Bool
    abortEarly ([RunningTree (IO ()) IO] -> [RunningTree () (ReaderT Env IO)])
    -> [RunningTree (IO ()) IO] -> [RunningTree () (ReaderT Env IO)]
    forall a b. (a -> b) -> a -> b
    $ (RunningTree_ IO -> RunningTree (IO ()) IO)
    -> [RunningTree_ IO] -> [RunningTree (IO ()) IO]
    forall a b. (a -> b) -> [a] -> [b]
    map ((RunningItem_ IO -> RunningItem IO)
    -> RunningTree_ IO -> RunningTree (IO ()) IO
    forall a b. (a -> b) -> Tree (IO ()) a -> Tree (IO ()) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap RunningItem_ IO -> RunningItem IO
    applyReportProgress) [RunningTree_ IO]
    runningSpecs_

            abortEarly :: Result -> Bool
            abortEarly Result
    result = EvalConfig -> Bool
    evalConfigFailFast EvalConfig
    config Bool -> Bool -> Bool
    && Result -> Bool
    isFailure Result
    result

            getResults :: IO [(Path, Format.Item)]
            getResults = [(Path, Item)] -> [(Path, Item)]
    forall a. [a] -> [a]
    reverse ([(Path, Item)] -> [(Path, Item)])
    -> IO [(Path, Item)] -> IO [(Path, Item)]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef [(Path, Item)] -> IO [(Path, Item)]
    forall a. IORef a -> IO a
    readIORef (Env -> IORef [(Path, Item)]
    envResults Env
    env)

            formatItems :: IO ()
            formatItems = EvalM () -> Env -> IO ()
    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
    runReaderT ([RunningTree () (ReaderT Env IO)] -> EvalM ()
    eval [RunningTree () (ReaderT Env IO)]
    runningSpecs) Env
    env

            formatDone :: IO ()
            formatDone = IO [(Path, Item)]
    getResults IO [(Path, Item)] -> ([(Path, Item)] -> IO ()) -> IO ()
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Format
    format Format -> ([(Path, Item)] -> Event) -> [(Path, Item)] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [(Path, Item)] -> Event
    Format.Done

          format Format.Started
          formatItems `finally` formatDone
          getResults
      where
        mkEnv :: IO Env
        mkEnv :: IO Env
    mkEnv = EvalConfig -> IORef Bool -> IORef [(Path, Item)] -> Env
    Env EvalConfig
    config (IORef Bool -> IORef [(Path, Item)] -> Env)
    -> IO (IORef Bool) -> IO (IORef [(Path, Item)] -> Env)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False IO (IORef [(Path, Item)] -> Env)
    -> IO (IORef [(Path, Item)]) -> IO Env
    forall a b. IO (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [(Path, Item)] -> IO (IORef [(Path, Item)])
    forall a. a -> IO (IORef a)
    newIORef []

        format :: Format
        format :: Format
    format = EvalConfig -> Format
    evalConfigFormat EvalConfig
    config

        reportProgress :: IO Bool -> Path -> Progress -> IO ()
        reportProgress :: IO Bool -> Path -> ProgressCallback
    reportProgress IO Bool
    timer Path
    path Progress
    progress = do
          r <- IO Bool
    timer
          when r $ do
            format (Format.Progress path progress)

    data Item a = Item {
      forall a. Item a -> String
    itemDescription :: String
    , forall a. Item a -> Maybe Location
    itemLocation :: Maybe Location
    , forall a. Item a -> a
    itemAction :: a
    } deriving (forall a b. (a -> b) -> Item a -> Item b)
    -> (forall a b. a -> Item b -> Item a) -> Functor Item
    forall a b. a -> Item b -> Item a
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> Item a -> Item b
    fmap :: forall a b. (a -> b) -> Item a -> Item b
    $c<$ :: forall a b. a -> Item b -> Item a
    <$ :: forall a b. a -> Item b -> Item a
    Functor

    type RunningItem m = Item (Path -> m (Seconds, Result))
    type RunningTree c m = Tree c (RunningItem m)

    type RunningItem_ m = Item (Job m Progress (Seconds, Result))
    type RunningTree_ m = Tree (IO ()) (RunningItem_ m)

    applyFailFast :: (Result -> Bool) -> RunningTree () IO -> RunningTree () EvalM
    applyFailFast :: (Result -> Bool)
    -> RunningTree () IO -> RunningTree () (ReaderT Env IO)
    applyFailFast = (RunningItem IO -> RunningItem (ReaderT Env IO))
    -> RunningTree () IO -> RunningTree () (ReaderT Env IO)
    forall a b. (a -> b) -> Tree () a -> Tree () b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((RunningItem IO -> RunningItem (ReaderT Env IO))
     -> RunningTree () IO -> RunningTree () (ReaderT Env IO))
    -> ((Result -> Bool)
        -> RunningItem IO -> RunningItem (ReaderT Env IO))
    -> (Result -> Bool)
    -> RunningTree () IO
    -> RunningTree () (ReaderT Env IO)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ((Path -> IO (Seconds, Result)) -> Path -> EvalM (Seconds, Result))
    -> RunningItem IO -> RunningItem (ReaderT Env IO)
    forall a b. (a -> b) -> Item a -> Item b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (((Path -> IO (Seconds, Result))
      -> Path -> EvalM (Seconds, Result))
     -> RunningItem IO -> RunningItem (ReaderT Env IO))
    -> ((Result -> Bool)
        -> (Path -> IO (Seconds, Result))
        -> Path
        -> EvalM (Seconds, Result))
    -> (Result -> Bool)
    -> RunningItem IO
    -> RunningItem (ReaderT Env IO)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (IO (Seconds, Result) -> EvalM (Seconds, Result))
    -> (Path -> IO (Seconds, Result))
    -> Path
    -> EvalM (Seconds, Result)
    forall a b. (a -> b) -> (Path -> a) -> Path -> b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((IO (Seconds, Result) -> EvalM (Seconds, Result))
     -> (Path -> IO (Seconds, Result))
     -> Path
     -> EvalM (Seconds, Result))
    -> ((Result -> Bool)
        -> IO (Seconds, Result) -> EvalM (Seconds, Result))
    -> (Result -> Bool)
    -> (Path -> IO (Seconds, Result))
    -> Path
    -> EvalM (Seconds, Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Result -> Bool) -> IO (Seconds, Result) -> EvalM (Seconds, Result)
    forall {t} {a}. (t -> Bool) -> IO (a, t) -> ReaderT Env IO (a, t)
    applyToItem
      where
        applyToItem :: (t -> Bool) -> IO (a, t) -> ReaderT Env IO (a, t)
    applyToItem t -> Bool
    abortEarly IO (a, t)
    action = do
          result@(_, r) <- IO (a, t) -> ReaderT Env IO (a, t)
    forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift IO (a, t)
    action
          when (abortEarly r) abort
          return result

    applyCleanup :: (Result -> Bool) -> [RunningTree (IO ()) IO] -> [RunningTree () EvalM]
    applyCleanup :: (Result -> Bool)
    -> [RunningTree (IO ()) IO] -> [RunningTree () (ReaderT Env IO)]
    applyCleanup Result -> Bool
    abortEarly = (RunningTree (IO ()) IO -> RunningTree () (ReaderT Env IO))
    -> [RunningTree (IO ()) IO] -> [RunningTree () (ReaderT Env IO)]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Result -> Bool)
    -> RunningTree () IO -> RunningTree () (ReaderT Env IO)
    applyFailFast Result -> Bool
    abortEarly (RunningTree () IO -> RunningTree () (ReaderT Env IO))
    -> (RunningTree (IO ()) IO -> RunningTree () IO)
    -> RunningTree (IO ()) IO
    -> RunningTree () (ReaderT Env IO)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . RunningTree (IO ()) IO -> RunningTree () IO
    go)
      where
        go :: RunningTree (IO ()) IO -> RunningTree () IO
        go :: RunningTree (IO ()) IO -> RunningTree () IO
    go RunningTree (IO ()) IO
    t = case RunningTree (IO ()) IO
    t of
          Node String
    label NonEmpty (RunningTree (IO ()) IO)
    xs -> String -> NonEmpty (RunningTree () IO) -> RunningTree () IO
    forall c a. String -> NonEmpty (Tree c a) -> Tree c a
    Node String
    label (RunningTree (IO ()) IO -> RunningTree () IO
    go (RunningTree (IO ()) IO -> RunningTree () IO)
    -> NonEmpty (RunningTree (IO ()) IO)
    -> NonEmpty (RunningTree () IO)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty (RunningTree (IO ()) IO)
    xs)
          NodeWithCleanup Maybe (String, Location)
    loc IO ()
    cleanup NonEmpty (RunningTree (IO ()) IO)
    xs -> Maybe (String, Location)
    -> () -> NonEmpty (RunningTree () IO) -> RunningTree () IO
    forall c a.
    Maybe (String, Location) -> c -> NonEmpty (Tree c a) -> Tree c a
    NodeWithCleanup Maybe (String, Location)
    loc () ((Result -> Bool)
    -> Maybe (String, Location)
    -> IO ()
    -> NonEmpty (RunningTree () IO)
    -> NonEmpty (RunningTree () IO)
    applyCleanupAction Result -> Bool
    abortEarly Maybe (String, Location)
    loc IO ()
    cleanup (NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO))
    -> NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO)
    forall a b. (a -> b) -> a -> b
    $ RunningTree (IO ()) IO -> RunningTree () IO
    go (RunningTree (IO ()) IO -> RunningTree () IO)
    -> NonEmpty (RunningTree (IO ()) IO)
    -> NonEmpty (RunningTree () IO)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> NonEmpty (RunningTree (IO ()) IO)
    xs)
          Leaf RunningItem IO
    a -> RunningItem IO -> RunningTree () IO
    forall c a. a -> Tree c a
    Leaf RunningItem IO
    a

    applyCleanupAction :: (Result -> Bool) -> Maybe (String, Location) -> IO () -> NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO)
    applyCleanupAction :: (Result -> Bool)
    -> Maybe (String, Location)
    -> IO ()
    -> NonEmpty (RunningTree () IO)
    -> NonEmpty (RunningTree () IO)
    applyCleanupAction Result -> Bool
    abortEarly Maybe (String, Location)
    loc IO ()
    cleanup = (RunningItem IO -> RunningItem IO)
    -> NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO)
    forall a. (a -> a) -> NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forLastLeaf ((Result -> Bool) -> RunningItem IO -> RunningItem IO
    addCleanupOn (Bool -> Bool
    not (Bool -> Bool) -> (Result -> Bool) -> Result -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Result -> Bool
    abortEarly)) (NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO))
    -> (NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO))
    -> NonEmpty (RunningTree () IO)
    -> NonEmpty (RunningTree () IO)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (RunningItem IO -> RunningItem IO)
    -> NonEmpty (RunningTree () IO) -> NonEmpty (RunningTree () IO)
    forall a b.
    (a -> b) -> NonEmpty (Tree () a) -> NonEmpty (Tree () b)
    forEachLeaf ((Result -> Bool) -> RunningItem IO -> RunningItem IO
    addCleanupOn Result -> Bool
    abortEarly)
      where
        addCleanupOn :: (Result -> Bool) -> RunningItem IO -> RunningItem IO
    addCleanupOn Result -> Bool
    p = (Result -> Bool)
    -> Maybe (String, Location)
    -> IO ()
    -> RunningItem IO
    -> RunningItem IO
    addCleanupToItem Result -> Bool
    p Maybe (String, Location)
    loc IO ()
    cleanup

    forEachLeaf :: (a -> b) -> NonEmpty (Tree () a) -> NonEmpty (Tree () b)
    forEachLeaf :: forall a b.
    (a -> b) -> NonEmpty (Tree () a) -> NonEmpty (Tree () b)
    forEachLeaf a -> b
    f = (Tree () a -> Tree () b)
    -> NonEmpty (Tree () a) -> NonEmpty (Tree () b)
    forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap ((a -> b) -> Tree () a -> Tree () b
    forall a b. (a -> b) -> Tree () a -> Tree () b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap a -> b
    f)

    forLastLeaf :: (a -> a) -> NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forLastLeaf :: forall a. (a -> a) -> NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forLastLeaf a -> a
    p = NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    go
      where
        go :: NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    go = NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forall a. NonEmpty a -> NonEmpty a
    NonEmpty.reverse (NonEmpty (Tree () a) -> NonEmpty (Tree () a))
    -> (NonEmpty (Tree () a) -> NonEmpty (Tree () a))
    -> NonEmpty (Tree () a)
    -> NonEmpty (Tree () a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Tree () a -> Tree () a)
    -> NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forall a. (a -> a) -> NonEmpty a -> NonEmpty a
    mapHead Tree () a -> Tree () a
    goNode (NonEmpty (Tree () a) -> NonEmpty (Tree () a))
    -> (NonEmpty (Tree () a) -> NonEmpty (Tree () a))
    -> NonEmpty (Tree () a)
    -> NonEmpty (Tree () a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    forall a. NonEmpty a -> NonEmpty a
    NonEmpty.reverse

        goNode :: Tree () a -> Tree () a
    goNode Tree () a
    node = case Tree () a
    node of
          Node String
    description NonEmpty (Tree () a)
    xs -> String -> NonEmpty (Tree () a) -> Tree () a
    forall c a. String -> NonEmpty (Tree c a) -> Tree c a
    Node String
    description (NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    go NonEmpty (Tree () a)
    xs)
          NodeWithCleanup Maybe (String, Location)
    loc_ () NonEmpty (Tree () a)
    xs -> Maybe (String, Location) -> () -> NonEmpty (Tree () a) -> Tree () a
    forall c a.
    Maybe (String, Location) -> c -> NonEmpty (Tree c a) -> Tree c a
    NodeWithCleanup Maybe (String, Location)
    loc_ () (NonEmpty (Tree () a) -> NonEmpty (Tree () a)
    go NonEmpty (Tree () a)
    xs)
          Leaf a
    item -> a -> Tree () a
    forall c a. a -> Tree c a
    Leaf (a -> a
    p a
    item)

    mapHead :: (a -> a) -> NonEmpty a -> NonEmpty a
    mapHead :: forall a. (a -> a) -> NonEmpty a -> NonEmpty a
    mapHead a -> a
    f NonEmpty a
    xs = case NonEmpty a
    xs of
      a
    y :| [a]
    ys -> a -> a
    f a
    y a -> [a] -> NonEmpty a
    forall a. a -> [a] -> NonEmpty a
    :| [a]
    ys

    addCleanupToItem :: (Result -> Bool) -> Maybe (String, Location) -> IO () -> RunningItem IO -> RunningItem IO
    addCleanupToItem :: (Result -> Bool)
    -> Maybe (String, Location)
    -> IO ()
    -> RunningItem IO
    -> RunningItem IO
    addCleanupToItem Result -> Bool
    shouldRunCleanup Maybe (String, Location)
    loc IO ()
    cleanup RunningItem IO
    item = RunningItem IO
    item {
      itemAction = \ Path
    path -> do
        result@(t1, r1) <- RunningItem IO -> Path -> IO (Seconds, Result)
    forall a. Item a -> a
    itemAction RunningItem IO
    item Path
    path
        if shouldRunCleanup r1 then do
          (t2, r2) <- measure $ safeEvaluateResultStatus (cleanup >> return Success)
          let t = Seconds
    t1 Seconds -> Seconds -> Seconds
    forall a. Num a => a -> a -> a
    + Seconds
    t2
          return (t, mergeResults loc r1 r2)
        else do
          return result
    }

    mergeResults :: Maybe (String, Location) -> Result -> ResultStatus -> Result
    mergeResults :: Maybe (String, Location) -> Result -> ResultStatus -> Result
    mergeResults Maybe (String, Location)
    mCallSite (Result String
    info ResultStatus
    r1) ResultStatus
    r2 = String -> ResultStatus -> Result
    Result String
    info (ResultStatus -> Result) -> ResultStatus -> Result
    forall a b. (a -> b) -> a -> b
    $ case (ResultStatus
    r1, ResultStatus
    r2) of
      (ResultStatus
    _, ResultStatus
    Success) -> ResultStatus
    r1
      (Failure{}, ResultStatus
    _) -> ResultStatus
    r1
      (Pending{}, Pending{}) -> ResultStatus
    r1
      (ResultStatus
    Success, Pending{}) -> ResultStatus
    r2
      (ResultStatus
    _, Failure Maybe Location
    mLoc FailureReason
    err) -> Maybe Location -> FailureReason -> ResultStatus
    Failure (Maybe Location
    mLoc Maybe Location -> Maybe Location -> Maybe Location
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe Location
    hookLoc) (FailureReason -> ResultStatus) -> FailureReason -> ResultStatus
    forall a b. (a -> b) -> a -> b
    $ case FailureReason
    err of
        Error Maybe String
    message SomeException
    e -> Maybe String -> SomeException -> FailureReason
    Error (Maybe String
    message Maybe String -> Maybe String -> Maybe String
    forall a. Maybe a -> Maybe a -> Maybe a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Maybe String
    hookFailed) SomeException
    e
        FailureReason
    _ -> FailureReason
    err
      where
        hookLoc :: Maybe Location
    hookLoc = (String, Location) -> Location
    forall a b. (a, b) -> b
    snd ((String, Location) -> Location)
    -> Maybe (String, Location) -> Maybe Location
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (String, Location)
    mCallSite
        hookFailed :: Maybe String
    hookFailed = case Maybe (String, Location)
    mCallSite of
          Just (String
    name, Location
    _) -> String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String) -> String -> Maybe String
    forall a b. (a -> b) -> a -> b
    $ String
    "in " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    name String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "-hook:"
          Maybe (String, Location)
    Nothing -> Maybe String
    forall a. Maybe a
    Nothing

    enqueueItems :: MonadIO m => JobQueue -> [EvalTree] -> IO [RunningTree_ m]
    enqueueItems :: forall (m :: * -> *).
    MonadIO m =>
    JobQueue -> [EvalTree] -> IO [RunningTree_ m]
    enqueueItems JobQueue
    queue = (EvalTree -> IO (RunningTree_ m))
    -> [EvalTree] -> IO [RunningTree_ m]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM ((EvalItem -> IO (RunningItem_ m))
    -> EvalTree -> IO (RunningTree_ m)
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Tree (IO ()) a -> f (Tree (IO ()) b)
    traverse ((EvalItem -> IO (RunningItem_ m))
     -> EvalTree -> IO (RunningTree_ m))
    -> (EvalItem -> IO (RunningItem_ m))
    -> EvalTree
    -> IO (RunningTree_ m)
    forall a b. (a -> b) -> a -> b
    $ JobQueue -> EvalItem -> IO (RunningItem_ m)
    forall (m :: * -> *).
    MonadIO m =>
    JobQueue -> EvalItem -> IO (RunningItem_ m)
    enqueueItem JobQueue
    queue)

    enqueueItem :: MonadIO m => JobQueue -> EvalItem -> IO (RunningItem_ m)
    enqueueItem :: forall (m :: * -> *).
    MonadIO m =>
    JobQueue -> EvalItem -> IO (RunningItem_ m)
    enqueueItem JobQueue
    queue EvalItem{String
    Maybe Location
    Concurrency
    ProgressCallback -> IO (Seconds, Result)
    evalItemDescription :: EvalItem -> String
    evalItemLocation :: EvalItem -> Maybe Location
    evalItemConcurrency :: EvalItem -> Concurrency
    evalItemAction :: EvalItem -> ProgressCallback -> IO (Seconds, Result)
    evalItemDescription :: String
    evalItemLocation :: Maybe Location
    evalItemConcurrency :: Concurrency
    evalItemAction :: ProgressCallback -> IO (Seconds, Result)
    ..} = do
      job <- JobQueue
    -> Concurrency
    -> (ProgressCallback -> IO (Seconds, Result))
    -> IO (Job m Progress (Either SomeException (Seconds, Result)))
    forall (m :: * -> *) progress a.
    MonadIO m =>
    JobQueue
    -> Concurrency
    -> Job IO progress a
    -> IO (Job m progress (Either SomeException a))
    enqueueJob JobQueue
    queue Concurrency
    evalItemConcurrency ProgressCallback -> IO (Seconds, Result)
    evalItemAction
      return Item {
        itemDescription = evalItemDescription
      , itemLocation = evalItemLocation
      , itemAction = job >=> liftIO . either exceptionToResult return
      }
      where
        exceptionToResult :: SomeException -> IO (Seconds, Result)
        exceptionToResult :: SomeException -> IO (Seconds, Result)
    exceptionToResult SomeException
    err = (,) Seconds
    0 (Result -> (Seconds, Result))
    -> (ResultStatus -> Result) -> ResultStatus -> (Seconds, Result)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ResultStatus -> Result
    Result String
    "" (ResultStatus -> (Seconds, Result))
    -> IO ResultStatus -> IO (Seconds, Result)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> SomeException -> IO ResultStatus
    exceptionToResultStatus SomeException
    err

    eval :: [RunningTree () EvalM] -> EvalM ()
    eval :: [RunningTree () (ReaderT Env IO)] -> EvalM ()
    eval [RunningTree () (ReaderT Env IO)]
    specs = do
      [EvalM ()] -> EvalM ()
    sequenceActions ((RunningTree () (ReaderT Env IO) -> [EvalM ()])
    -> [RunningTree () (ReaderT Env IO)] -> [EvalM ()]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap RunningTree () (ReaderT Env IO) -> [EvalM ()]
    foldSpec [RunningTree () (ReaderT Env IO)]
    specs)
      where
        foldSpec :: RunningTree () EvalM -> [EvalM ()]
        foldSpec :: RunningTree () (ReaderT Env IO) -> [EvalM ()]
    foldSpec = FoldTree () (RunningItem (ReaderT Env IO)) (EvalM ())
    -> RunningTree () (ReaderT Env IO) -> [EvalM ()]
    forall c a r. FoldTree c a r -> Tree c a -> [r]
    foldTree FoldTree {
          onGroupStarted :: Path -> EvalM ()
    onGroupStarted = Path -> EvalM ()
    groupStarted
        , onGroupDone :: Path -> EvalM ()
    onGroupDone = Path -> EvalM ()
    groupDone
        , onCleanup :: Maybe (String, Location) -> [String] -> () -> EvalM ()
    onCleanup = Maybe (String, Location) -> [String] -> () -> EvalM ()
    runCleanup
        , onLeafe :: [String] -> RunningItem (ReaderT Env IO) -> EvalM ()
    onLeafe = [String] -> RunningItem (ReaderT Env IO) -> EvalM ()
    evalItem
        }

        runCleanup :: Maybe (String, Location) -> [String] -> () -> EvalM ()
        runCleanup :: Maybe (String, Location) -> [String] -> () -> EvalM ()
    runCleanup Maybe (String, Location)
    _loc [String]
    _groups = () -> EvalM ()
    forall a. a -> ReaderT Env IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

        evalItem :: [String] -> RunningItem EvalM -> EvalM ()
        evalItem :: [String] -> RunningItem (ReaderT Env IO) -> EvalM ()
    evalItem [String]
    groups (Item String
    requirement Maybe Location
    loc Path -> EvalM (Seconds, Result)
    action) = do
          Path -> Maybe Location -> EvalM (Seconds, Result) -> EvalM ()
    reportItem Path
    path Maybe Location
    loc (EvalM (Seconds, Result) -> EvalM ())
    -> EvalM (Seconds, Result) -> EvalM ()
    forall a b. (a -> b) -> a -> b
    $ Path -> EvalM (Seconds, Result)
    action Path
    path
          where
            path :: Path
            path :: Path
    path = ([String]
    groups, String
    requirement)

    data FoldTree c a r = FoldTree {
      forall c a r. FoldTree c a r -> Path -> r
    onGroupStarted :: Path -> r
    , forall c a r. FoldTree c a r -> Path -> r
    onGroupDone :: Path -> r
    , forall c a r.
    FoldTree c a r -> Maybe (String, Location) -> [String] -> c -> r
    onCleanup :: Maybe (String, Location) -> [String] -> c -> r
    , forall c a r. FoldTree c a r -> [String] -> a -> r
    onLeafe :: [String] -> a -> r
    }

    foldTree :: FoldTree c a r -> Tree c a -> [r]
    foldTree :: forall c a r. FoldTree c a r -> Tree c a -> [r]
    foldTree FoldTree{[String] -> a -> r
    Maybe (String, Location) -> [String] -> c -> r
    Path -> r
    onGroupStarted :: forall c a r. FoldTree c a r -> Path -> r
    onGroupDone :: forall c a r. FoldTree c a r -> Path -> r
    onCleanup :: forall c a r.
    FoldTree c a r -> Maybe (String, Location) -> [String] -> c -> r
    onLeafe :: forall c a r. FoldTree c a r -> [String] -> a -> r
    onGroupStarted :: Path -> r
    onGroupDone :: Path -> r
    onCleanup :: Maybe (String, Location) -> [String] -> c -> r
    onLeafe :: [String] -> a -> r
    ..} = [String] -> Tree c a -> [r]
    go []
      where
        go :: [String] -> Tree c a -> [r]
    go [String]
    rGroups (Node String
    group NonEmpty (Tree c a)
    xs) = r
    start r -> [r] -> [r]
    forall a. a -> [a] -> [a]
    : [r]
    children [r] -> [r] -> [r]
    forall a. [a] -> [a] -> [a]
    ++ [r
    done]
          where
            path :: Path
    path = ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    rGroups, String
    group)
            start :: r
    start = Path -> r
    onGroupStarted Path
    path
            children :: [r]
    children = (Tree c a -> [r]) -> NonEmpty (Tree c a) -> [r]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([String] -> Tree c a -> [r]
    go (String
    group String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    : [String]
    rGroups)) NonEmpty (Tree c a)
    xs
            done :: r
    done =  Path -> r
    onGroupDone Path
    path
        go [String]
    rGroups (NodeWithCleanup Maybe (String, Location)
    loc c
    action NonEmpty (Tree c a)
    xs) = [r]
    children [r] -> [r] -> [r]
    forall a. [a] -> [a] -> [a]
    ++ [r
    cleanup]
          where
            children :: [r]
    children = (Tree c a -> [r]) -> NonEmpty (Tree c a) -> [r]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ([String] -> Tree c a -> [r]
    go [String]
    rGroups) NonEmpty (Tree c a)
    xs
            cleanup :: r
    cleanup = Maybe (String, Location) -> [String] -> c -> r
    onCleanup Maybe (String, Location)
    loc ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    rGroups) c
    action
        go [String]
    rGroups (Leaf a
    a) = [[String] -> a -> r
    onLeafe ([String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    rGroups) a
    a]

    sequenceActions :: [EvalM ()] -> EvalM ()
    sequenceActions :: [EvalM ()] -> EvalM ()
    sequenceActions = [EvalM ()] -> EvalM ()
    go
      where
        go :: [EvalM ()] -> EvalM ()
        go :: [EvalM ()] -> EvalM ()
    go [] = EvalM ()
    forall (m :: * -> *). Applicative m => m ()
    pass
        go (EvalM ()
    action : [EvalM ()]
    actions) = do
          EvalM ()
    action
          EvalM Bool
    shouldAbort EvalM Bool -> (Bool -> EvalM ()) -> EvalM ()
    forall a b.
    ReaderT Env IO a -> (a -> ReaderT Env IO b) -> ReaderT Env IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \ case
            Bool
    False -> [EvalM ()] -> EvalM ()
    go [EvalM ()]
    actions
            Bool
    True -> EvalM ()
    forall (m :: * -> *). Applicative m => m ()
    pass