{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

-- | This module defines how to run a test suite
module Test.Syd.Runner.Asynchronous
  ( runSpecForestAsynchronously,
    runSpecForestInterleavedWithOutputAsynchronously,
  )
where

import Control.Concurrent.Async as Async
import Control.Concurrent.MVar
import Control.Concurrent.STM as STM
import Control.Exception
import Control.Monad
import Control.Monad.Reader
import Data.Maybe
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Data.Word
import GHC.Clock (getMonotonicTimeNSec)
import Test.QuickCheck.IO ()
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Output
import Test.Syd.Run
import Test.Syd.Runner.Single
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour

runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously Settings
settings Word
nbThreads TestForest '[] ()
testForest = do
  HandleForest '[] ()
handleForest <- TestForest '[] () -> IO (HandleForest '[] ())
forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest TestForest '[] ()
testForest
  MVar ()
failFastVar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  let runRunner :: IO ()
runRunner = Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
      runPrinter :: IO ResultForest
runPrinter = IO ResultForest -> IO ResultForest
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResultForest -> IO ResultForest)
-> IO ResultForest -> IO ResultForest
forall a b. (a -> b) -> a -> b
$ MVar () -> HandleForest '[] () -> IO ResultForest
waiter MVar ()
failFastVar HandleForest '[] ()
handleForest
  ((), ResultForest
resultForest) <- IO () -> IO ResultForest -> IO ((), ResultForest)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO ()
runRunner IO ResultForest
runPrinter
  ResultForest -> IO ResultForest
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultForest
resultForest

runSpecForestInterleavedWithOutputAsynchronously :: Settings -> Word -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously :: Settings -> Word -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously Settings
settings Word
nbThreads TestForest '[] ()
testForest = do
  HandleForest '[] ()
handleForest <- TestForest '[] () -> IO (HandleForest '[] ())
forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest TestForest '[] ()
testForest
  MVar ()
failFastVar <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
  Word64
suiteBegin <- IO Word64
getMonotonicTimeNSec
  let runRunner :: IO ()
runRunner = Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
      runPrinter :: IO (Timed ResultForest)
runPrinter = IO (Timed ResultForest) -> IO (Timed ResultForest)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Timed ResultForest) -> IO (Timed ResultForest))
-> IO (Timed ResultForest) -> IO (Timed ResultForest)
forall a b. (a -> b) -> a -> b
$ Settings
-> MVar ()
-> Word64
-> HandleForest '[] ()
-> IO (Timed ResultForest)
printer Settings
settings MVar ()
failFastVar Word64
suiteBegin HandleForest '[] ()
handleForest
  ((), Timed ResultForest
resultForest) <- IO () -> IO (Timed ResultForest) -> IO ((), Timed ResultForest)
forall a b. IO a -> IO b -> IO (a, b)
concurrently IO ()
runRunner IO (Timed ResultForest)
runPrinter
  Timed ResultForest -> IO (Timed ResultForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
resultForest

type HandleForest a b = SpecDefForest a b (MVar (Timed TestRunReport))

type HandleTree a b = SpecDefTree a b (MVar (Timed TestRunReport))

makeHandleForest :: TestForest a b -> IO (HandleForest a b)
makeHandleForest :: forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest = (SpecDefTree a b ()
 -> IO (SpecDefTree a b (MVar (Timed TestRunReport))))
-> [SpecDefTree a b ()]
-> IO [SpecDefTree a b (MVar (Timed TestRunReport))]
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) -> [a] -> f [b]
traverse ((SpecDefTree a b ()
  -> IO (SpecDefTree a b (MVar (Timed TestRunReport))))
 -> [SpecDefTree a b ()]
 -> IO [SpecDefTree a b (MVar (Timed TestRunReport))])
-> (SpecDefTree a b ()
    -> IO (SpecDefTree a b (MVar (Timed TestRunReport))))
-> [SpecDefTree a b ()]
-> IO [SpecDefTree a b (MVar (Timed TestRunReport))]
forall a b. (a -> b) -> a -> b
$ (() -> IO (MVar (Timed TestRunReport)))
-> SpecDefTree a b ()
-> IO (SpecDefTree a b (MVar (Timed TestRunReport)))
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) -> SpecDefTree a b a -> f (SpecDefTree a b b)
traverse ((() -> IO (MVar (Timed TestRunReport)))
 -> SpecDefTree a b ()
 -> IO (SpecDefTree a b (MVar (Timed TestRunReport))))
-> (() -> IO (MVar (Timed TestRunReport)))
-> SpecDefTree a b ()
-> IO (SpecDefTree a b (MVar (Timed TestRunReport)))
forall a b. (a -> b) -> a -> b
$ \() -> IO (MVar (Timed TestRunReport))
forall a. IO (MVar a)
newEmptyMVar

type Job = Int -> IO ()

-- | Job queue for workers that can synchronise
data JobQueue = JobQueue
  { -- | Bounded channel for the jobs.
    -- We use a TBQueue because it's bounded and we can check if it's empty.
    JobQueue -> TBQueue Job
jobQueueTBQueue :: !(TBQueue Job),
    -- | Count of the number of job currently executed by workers.
    JobQueue -> TVar Int
jobQueueWorkingCount :: !(TVar Int)
  }

-- | Make a new job queue with a given capacity
newJobQueue :: Word -> IO JobQueue
newJobQueue :: Word -> IO JobQueue
newJobQueue Word
spots = do
  TBQueue Job
jobQueueTBQueue <- Natural -> IO (TBQueue Job)
forall a. Natural -> IO (TBQueue a)
newTBQueueIO (Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
spots)
  TVar Int
jobQueueWorkingCount <- Int -> IO (TVar Int)
forall a. a -> IO (TVar a)
newTVarIO (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word
0 :: Word))
  JobQueue -> IO JobQueue
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure JobQueue {TVar Int
TBQueue Job
jobQueueTBQueue :: TBQueue Job
jobQueueWorkingCount :: TVar Int
jobQueueTBQueue :: TBQueue Job
jobQueueWorkingCount :: TVar Int
..}

-- | Enqueue a job, block until that's possible.
enqueueJob :: JobQueue -> Job -> IO ()
enqueueJob :: JobQueue -> Job -> IO ()
enqueueJob JobQueue {TVar Int
TBQueue Job
jobQueueTBQueue :: JobQueue -> TBQueue Job
jobQueueWorkingCount :: JobQueue -> TVar Int
jobQueueTBQueue :: TBQueue Job
jobQueueWorkingCount :: TVar Int
..} Job
job =
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TBQueue Job -> Job -> STM ()
forall a. TBQueue a -> a -> STM ()
writeTBQueue TBQueue Job
jobQueueTBQueue Job
job

-- | Dequeue a job.
dequeueJob :: JobQueue -> STM Job
dequeueJob :: JobQueue -> STM Job
dequeueJob JobQueue {TVar Int
TBQueue Job
jobQueueTBQueue :: JobQueue -> TBQueue Job
jobQueueWorkingCount :: JobQueue -> TVar Int
jobQueueTBQueue :: TBQueue Job
jobQueueWorkingCount :: TVar Int
..} =
  TBQueue Job -> STM Job
forall a. TBQueue a -> STM a
readTBQueue TBQueue Job
jobQueueTBQueue

-- | Block until all workers are done (waiting to dequeue a job).
blockUntilDone :: JobQueue -> IO ()
blockUntilDone :: JobQueue -> IO ()
blockUntilDone JobQueue {TVar Int
TBQueue Job
jobQueueTBQueue :: JobQueue -> TBQueue Job
jobQueueWorkingCount :: JobQueue -> TVar Int
jobQueueTBQueue :: TBQueue Job
jobQueueWorkingCount :: TVar Int
..} = do
  STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    -- Wait until the queue is empty.
    TBQueue Job -> STM Bool
forall a. TBQueue a -> STM Bool
isEmptyTBQueue TBQueue Job
jobQueueTBQueue STM Bool -> (Bool -> STM ()) -> STM ()
forall a b. STM a -> (a -> STM b) -> STM b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Bool -> STM ()
STM.check
    -- Wait for all workers to stop working.
    Int
currentlyRunning <- TVar Int -> STM Int
forall a. TVar a -> STM a
readTVar TVar Int
jobQueueWorkingCount
    Bool -> STM () -> STM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
currentlyRunning Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) STM ()
forall a. STM a
retry

-- No new work can be started now, because the queue is empty and no worker
-- are running.

withJobQueueWorkers :: Word -> JobQueue -> IO a -> IO a
withJobQueueWorkers :: forall a. Word -> JobQueue -> IO a -> IO a
withJobQueueWorkers Word
nbWorkers JobQueue
jobQueue IO a
func =
  IO [()] -> (Async [()] -> IO a) -> IO a
forall a b. IO a -> (Async a -> IO b) -> IO b
withAsync
    ( Job -> [Int] -> IO [()]
forall (t :: * -> *) a b.
Traversable t =>
(a -> IO b) -> t a -> IO (t b)
mapConcurrently
        (JobQueue -> Job
jobQueueWorker JobQueue
jobQueue)
        [Int
0 .. Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nbWorkers Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]
    )
    (\Async [()]
_ -> IO a
func)

jobQueueWorker :: JobQueue -> Int -> IO ()
jobQueueWorker :: JobQueue -> Job
jobQueueWorker JobQueue
jobQueue Int
workerIx = do
  IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IO Job -> (Job -> IO ()) -> (Job -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
      ( STM Job -> IO Job
forall a. STM a -> IO a
atomically (STM Job -> IO Job) -> STM Job -> IO Job
forall a b. (a -> b) -> a -> b
$ do
          -- Pick a job in queue and increase the count
          TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (JobQueue -> TVar Int
jobQueueWorkingCount JobQueue
jobQueue) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          JobQueue -> STM Job
dequeueJob JobQueue
jobQueue
      )
      (\Job
_ -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Int -> (Int -> Int) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' (JobQueue -> TVar Int
jobQueueWorkingCount JobQueue
jobQueue) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1))
      (\Job
job -> Job
job Int
workerIx)

-- The plan is as follows:
--
-- We have:
--
-- 1 runner thread that schedules jobs
-- 1 waiter/printer thread that waits for the jobs to be done and puts them in
--   the result forest.
-- n worker threads that run the jobs.
--
-- Any outer resource might need cleanup, so whenever the scheduler thread
-- finishes an outer-resource subtree, it must wait for all tasks until then to
-- be completed before running the cleanup action.
--
-- There might be an ungodly number of tests so, to keep memory usage
-- contained, we want to limit the number of jobs that the scheduler can put on
-- the queue.
--
-- Tests may be marked as sequential, in which case only one test may be
-- executing at a time.
--
--
-- 1. We use a job queue semaphore that holds the number of empty
--    spots left on the queue.
--    The scheduler must wait for one unit of the semaphore before
--    enqueuing a job.
--    Any dequeuing must signal this semaphore
--
-- 2. We use a global lock for any job marked as "sequential".
--
--
-- The runner goes through the test 'HandleForest' one by one, and:
--
-- 1. Tries to enqueue as many jobs as possible.
--    It's only allowed to enqueue a jobs if there is space left on
--    the queue as indicated by the job semaphore.
--
-- 2. Asks workers to wait after finishing what they were doing at the end of
--     an outer resource block.
runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  let nbWorkers :: Word
nbWorkers = Word
nbThreads
  let nbSpacesOnTheJobQueue :: Word
nbSpacesOnTheJobQueue = Word
nbWorkers Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
2
  JobQueue
jobQueue <- Word -> IO JobQueue
newJobQueue Word
nbSpacesOnTheJobQueue

  Word -> JobQueue -> IO () -> IO ()
forall a. Word -> JobQueue -> IO a -> IO a
withJobQueueWorkers Word
nbWorkers JobQueue
jobQueue (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let waitForWorkersDone :: IO ()
        waitForWorkersDone :: IO ()
waitForWorkersDone = JobQueue -> IO ()
blockUntilDone JobQueue
jobQueue

    let goForest :: forall a. HandleForest a () -> R a ()
        goForest :: forall (a :: [*]). HandleForest a () -> R a ()
goForest = (SpecDefTree a () (MVar (Timed TestRunReport))
 -> ReaderT (Env a) IO ())
-> [SpecDefTree a () (MVar (Timed TestRunReport))]
-> ReaderT (Env a) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ SpecDefTree a () (MVar (Timed TestRunReport))
-> ReaderT (Env a) IO ()
forall (a :: [*]). HandleTree a () -> R a ()
goTree

        goTree :: forall a. HandleTree a () -> R a ()
        goTree :: forall (a :: [*]). HandleTree a () -> R a ()
goTree = \case
          DefSpecifyNode Text
_ TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunReport)
var -> do
            -- If the fail-fast var has been put, we stop enqueuing jobs.
            Maybe ()
mDoneEarly <- IO (Maybe ()) -> ReaderT (Env a) IO (Maybe ())
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ()) -> ReaderT (Env a) IO (Maybe ()))
-> IO (Maybe ()) -> ReaderT (Env a) IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
            case Maybe ()
mDoneEarly of
              Just () -> () -> R a ()
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
              Maybe ()
Nothing -> do
                Env {Word
HList a
ExpectationMode
FlakinessMode
Parallelism
eParallelism :: Parallelism
eRetries :: Word
eFlakinessMode :: FlakinessMode
eExpectationMode :: ExpectationMode
eExternalResources :: HList a
eParallelism :: forall (externalResources :: [*]).
Env externalResources -> Parallelism
eRetries :: forall (externalResources :: [*]). Env externalResources -> Word
eFlakinessMode :: forall (externalResources :: [*]).
Env externalResources -> FlakinessMode
eExpectationMode :: forall (externalResources :: [*]).
Env externalResources -> ExpectationMode
eExternalResources :: forall (externalResources :: [*]).
Env externalResources -> HList externalResources
..} <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask

                IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$ do
                  let runNow :: Int -> IO (Timed TestRunReport)
runNow Int
workerNr =
                        Int -> IO TestRunReport -> IO (Timed TestRunReport)
forall (m :: * -> *) a. MonadIO m => Int -> m a -> m (Timed a)
timeItT Int
workerNr (IO TestRunReport -> IO (Timed TestRunReport))
-> IO TestRunReport -> IO (Timed TestRunReport)
forall a b. (a -> b) -> a -> b
$
                          ProgressReporter
-> HList a
-> TDef
     (ProgressReporter
      -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
runSingleTestWithFlakinessMode
                            ProgressReporter
noProgressReporter
                            HList a
eExternalResources
                            TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td
                            Word
eRetries
                            FlakinessMode
eFlakinessMode
                            ExpectationMode
eExpectationMode

                  let job :: Int -> IO ()
                      job :: Job
job Int
workerNr = do
                        -- Start the test
                        Timed TestRunReport
result <- Int -> IO (Timed TestRunReport)
runNow Int
workerNr

                        -- Put the result in the mvar
                        MVar (Timed TestRunReport) -> Timed TestRunReport -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Timed TestRunReport)
var Timed TestRunReport
result

                        -- If we should fail fast, put the
                        -- fail-fast var so that no new
                        -- jobs are started by the
                        -- scheduler.
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                          ( Settings -> Bool
settingFailFast Settings
settings
                              Bool -> Bool -> Bool
&& Settings -> TestRunReport -> Bool
testRunReportFailed Settings
settings (Timed TestRunReport -> TestRunReport
forall a. Timed a -> a
timedValue Timed TestRunReport
result)
                          )
                          (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
failFastVar ()

                  -- When enqueuing a sequential job, make sure all workers are
                  -- done before and after.
                  -- It's not enough to just not have two tests running at the
                  -- same time, because they also need to be executed in order.
                  case Parallelism
eParallelism of
                    Parallelism
Sequential -> do
                      IO ()
waitForWorkersDone
                      Job
job Int
0
                    Parallelism
Parallel -> do
                      JobQueue -> Job -> IO ()
enqueueJob JobQueue
jobQueue Job
job
          DefPendingNode Text
_ Maybe Text
_ -> () -> R a ()
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
          DefDescribeNode Text
_ SpecDefForest a () (MVar (Timed TestRunReport))
sdf -> SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf
          DefSetupNode IO ()
func SpecDefForest a () (MVar (Timed TestRunReport))
sdf -> do
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
func
            SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf
          DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
sdf -> do
            outer
b <- IO outer -> ReaderT (Env a) IO outer
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO outer
func
            (Env a -> Env (outer : a))
-> ReaderT (Env (outer : a)) IO () -> R a ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eExternalResources = HCons b (eExternalResources e)})
              (SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
-> ReaderT (Env (outer : a)) IO ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
sdf)
          DefBeforeAllWithNode oldOuter -> IO newOuter
func SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
sdf -> do
            Env (oldOuter : otherOuters)
e <- ReaderT (Env a) IO (Env (oldOuter : otherOuters))
forall r (m :: * -> *). MonadReader r m => m r
ask
            let HCons oldOuter
e
x HList l
_ = Env (oldOuter : otherOuters) -> HList (oldOuter : otherOuters)
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
            newOuter
b <- IO newOuter -> ReaderT (Env a) IO newOuter
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO newOuter -> ReaderT (Env a) IO newOuter)
-> IO newOuter -> ReaderT (Env a) IO newOuter
forall a b. (a -> b) -> a -> b
$ oldOuter -> IO newOuter
func oldOuter
x
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$
              ReaderT (Env (newOuter : oldOuter : otherOuters)) IO ()
-> Env (newOuter : oldOuter : otherOuters) -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                (SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
-> ReaderT (Env (newOuter : oldOuter : otherOuters)) IO ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
sdf)
                (Env (oldOuter : otherOuters)
e {eExternalResources = HCons b (eExternalResources e)})
          DefWrapNode IO () -> IO ()
func SpecDefForest a () (MVar (Timed TestRunReport))
sdf -> do
            Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$
              IO () -> IO ()
func (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                R a () -> Env a -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf) Env a
e
                IO ()
waitForWorkersDone
          DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
sdf -> do
            Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$
              (outer -> IO ()) -> IO ()
func
                ( \outer
b -> do
                    ReaderT (Env (outer : a)) IO () -> Env (outer : a) -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                      (SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
-> ReaderT (Env (outer : a)) IO ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest (outer : a) () (MVar (Timed TestRunReport))
sdf)
                      (Env a
e {eExternalResources = HCons b (eExternalResources e)})
                    IO ()
waitForWorkersDone
                )
          DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
sdf -> do
            Env (oldOuter : otherOuters)
e <- ReaderT (Env a) IO (Env (oldOuter : otherOuters))
forall r (m :: * -> *). MonadReader r m => m r
ask
            let HCons oldOuter
e
x HList l
_ = Env (oldOuter : otherOuters) -> HList (oldOuter : otherOuters)
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$
              (newOuter -> IO ()) -> oldOuter -> IO ()
func
                ( \newOuter
b -> do
                    ReaderT (Env (newOuter : oldOuter : otherOuters)) IO ()
-> Env (newOuter : oldOuter : otherOuters) -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                      (SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
-> ReaderT (Env (newOuter : oldOuter : otherOuters)) IO ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunReport))
sdf)
                      (Env (oldOuter : otherOuters)
e {eExternalResources = HCons b (eExternalResources e)})
                    IO ()
waitForWorkersDone
                )
                oldOuter
x
          DefAfterAllNode HList a -> IO ()
func SpecDefForest a () (MVar (Timed TestRunReport))
sdf -> do
            Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
            IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$
              R a () -> Env a -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf) Env a
e
                IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` ( do
                              IO ()
waitForWorkersDone
                              HList a -> IO ()
func (Env a -> HList a
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env a
e)
                          )
          DefParallelismNode Parallelism
p' SpecDefForest a () (MVar (Timed TestRunReport))
sdf ->
            (Env a -> Env a) -> R a () -> R a ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eParallelism = p'})
              (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf)
          DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () (MVar (Timed TestRunReport))
sdf ->
            SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf -- Ignore, randomisation has already happened.
          DefRetriesNode Word -> Word
modRetries SpecDefForest a () (MVar (Timed TestRunReport))
sdf ->
            (Env a -> Env a) -> R a () -> R a ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eRetries = modRetries (eRetries e)})
              (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf)
          DefFlakinessNode FlakinessMode
fm SpecDefForest a () (MVar (Timed TestRunReport))
sdf ->
            (Env a -> Env a) -> R a () -> R a ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eFlakinessMode = fm})
              (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf)
          DefExpectationNode ExpectationMode
em SpecDefForest a () (MVar (Timed TestRunReport))
sdf ->
            (Env a -> Env a) -> R a () -> R a ()
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eExpectationMode = em})
              (SpecDefForest a () (MVar (Timed TestRunReport)) -> R a ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest SpecDefForest a () (MVar (Timed TestRunReport))
sdf)

    ReaderT (Env '[]) IO () -> Env '[] -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
      (HandleForest '[] () -> ReaderT (Env '[]) IO ()
forall (a :: [*]). HandleForest a () -> R a ()
goForest HandleForest '[] ()
handleForest)
      Env
        { eParallelism :: Parallelism
eParallelism = Parallelism
Parallel,
          eRetries :: Word
eRetries = Settings -> Word
settingRetries Settings
settings,
          eFlakinessMode :: FlakinessMode
eFlakinessMode = FlakinessMode
MayNotBeFlaky,
          eExpectationMode :: ExpectationMode
eExpectationMode = ExpectationMode
ExpectPassing,
          eExternalResources :: HList '[]
eExternalResources = HList '[]
HNil
        }
    IO ()
waitForWorkersDone -- Make sure all jobs are done before cancelling the runners.

type R a = ReaderT (Env a) IO

-- Not exported, on purpose.
data Env externalResources = Env
  { forall (externalResources :: [*]).
Env externalResources -> Parallelism
eParallelism :: !Parallelism,
    forall (externalResources :: [*]). Env externalResources -> Word
eRetries :: !Word,
    forall (externalResources :: [*]).
Env externalResources -> FlakinessMode
eFlakinessMode :: !FlakinessMode,
    forall (externalResources :: [*]).
Env externalResources -> ExpectationMode
eExpectationMode :: !ExpectationMode,
    forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources :: !(HList externalResources)
  }

printer :: Settings -> MVar () -> Word64 -> HandleForest '[] () -> IO (Timed ResultForest)
printer :: Settings
-> MVar ()
-> Word64
-> HandleForest '[] ()
-> IO (Timed ResultForest)
printer Settings
settings MVar ()
failFastVar Word64
suiteBegin HandleForest '[] ()
handleForest = do
  TerminalCapabilities
tc <- Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings

  let outputLine :: [Chunk] -> IO ()
      outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
tc [Chunk]
lineChunks
        Text -> IO ()
TIO.putStrLn Text
""

      treeWidth :: Int
      treeWidth :: Int
treeWidth = HandleForest '[] () -> Int
forall (a :: [*]) b c. SpecDefForest a b c -> Int
specForestWidth HandleForest '[] ()
handleForest

  let pad :: Int -> [Chunk] -> [Chunk]
      pad :: Int -> [Chunk] -> [Chunk]
pad Int
level = (Text -> Chunk
chunk (String -> Text
T.pack (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
paddingSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
level) Char
' ')) Chunk -> [Chunk] -> [Chunk]
forall a. a -> [a] -> [a]
:)

  let outputLineP :: [Chunk] -> P ()
      outputLineP :: [Chunk] -> P ()
outputLineP [Chunk]
line = do
        Int
level <- ReaderT Int IO Int
forall r (m :: * -> *). MonadReader r m => m r
ask
        IO () -> P ()
forall a. IO a -> ReaderT Int IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> P ()) -> IO () -> P ()
forall a b. (a -> b) -> a -> b
$ [Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Chunk] -> [Chunk]
pad Int
level [Chunk]
line

      outputLinesP :: [[Chunk]] -> P ()
      outputLinesP :: [[Chunk]] -> P ()
outputLinesP = ([Chunk] -> P ()) -> [[Chunk]] -> P ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> P ()
outputLineP

  let goForest :: HandleForest a b -> P (Maybe ResultForest)
      goForest :: forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest HandleForest a b
hts = do
        ResultForest
rts <- [Maybe ResultTree] -> ResultForest
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ResultTree] -> ResultForest)
-> ReaderT Int IO [Maybe ResultTree] -> ReaderT Int IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandleTree a b -> ReaderT Int IO (Maybe ResultTree))
-> HandleForest a b -> ReaderT Int IO [Maybe ResultTree]
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 HandleTree a b -> ReaderT Int IO (Maybe ResultTree)
forall (a :: [*]) b.
HandleTree a b -> ReaderT Int IO (Maybe ResultTree)
goTree HandleForest a b
hts
        Maybe ResultForest -> P (Maybe ResultForest)
forall a. a -> ReaderT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultForest -> P (Maybe ResultForest))
-> Maybe ResultForest -> P (Maybe ResultForest)
forall a b. (a -> b) -> a -> b
$ if ResultForest -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultForest
rts then Maybe ResultForest
forall a. Maybe a
Nothing else ResultForest -> Maybe ResultForest
forall a. a -> Maybe a
Just ResultForest
rts

      goTree :: HandleTree a b -> P (Maybe ResultTree)
      goTree :: forall (a :: [*]) b.
HandleTree a b -> ReaderT Int IO (Maybe ResultTree)
goTree = \case
        DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunReport)
var -> do
          Either () (Timed TestRunReport)
failFastOrResult <-
            IO (Either () (Timed TestRunReport))
-> ReaderT Int IO (Either () (Timed TestRunReport))
forall a. IO a -> ReaderT Int IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either () (Timed TestRunReport))
 -> ReaderT Int IO (Either () (Timed TestRunReport)))
-> IO (Either () (Timed TestRunReport))
-> ReaderT Int IO (Either () (Timed TestRunReport))
forall a b. (a -> b) -> a -> b
$
              IO ()
-> IO (Timed TestRunReport) -> IO (Either () (Timed TestRunReport))
forall a b. IO a -> IO b -> IO (Either a b)
race
                (MVar () -> IO ()
forall a. MVar a -> IO a
readMVar MVar ()
failFastVar)
                (MVar (Timed TestRunReport) -> IO (Timed TestRunReport)
forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunReport)
var)
          case Either () (Timed TestRunReport)
failFastOrResult of
            Left () -> Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a. a -> ReaderT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
            Right Timed TestRunReport
result -> do
              let td' :: TDef (Timed TestRunReport)
td' = TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal = result}
              Int
level <- ReaderT Int IO Int
forall r (m :: * -> *). MonadReader r m => m r
ask
              [[Chunk]] -> P ()
outputLinesP ([[Chunk]] -> P ()) -> [[Chunk]] -> P ()
forall a b. (a -> b) -> a -> b
$ Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
level Int
treeWidth Text
t TDef (Timed TestRunReport)
td'
              Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a. a -> ReaderT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree))
-> Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a b. (a -> b) -> a -> b
$ ResultTree -> Maybe ResultTree
forall a. a -> Maybe a
Just (ResultTree -> Maybe ResultTree) -> ResultTree -> Maybe ResultTree
forall a b. (a -> b) -> a -> b
$ Text -> TDef (Timed TestRunReport) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunReport)
td'
        DefPendingNode Text
t Maybe Text
mr -> do
          [[Chunk]] -> P ()
outputLinesP ([[Chunk]] -> P ()) -> [[Chunk]] -> P ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
          Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a. a -> ReaderT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree))
-> Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a b. (a -> b) -> a -> b
$ ResultTree -> Maybe ResultTree
forall a. a -> Maybe a
Just (ResultTree -> Maybe ResultTree) -> ResultTree -> Maybe ResultTree
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> ResultTree
forall a. Text -> Maybe Text -> SpecTree a
PendingNode Text
t Maybe Text
mr
        DefDescribeNode Text
t SpecDefForest a b (MVar (Timed TestRunReport))
sf -> do
          Maybe ()
mDoneEarly <- IO (Maybe ()) -> ReaderT Int IO (Maybe ())
forall a. IO a -> ReaderT Int IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ()) -> ReaderT Int IO (Maybe ()))
-> IO (Maybe ()) -> ReaderT Int IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
          case Maybe ()
mDoneEarly of
            Just () -> Maybe ResultTree -> ReaderT Int IO (Maybe ResultTree)
forall a. a -> ReaderT Int IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
            Maybe ()
Nothing -> do
              [Chunk] -> P ()
outputLineP ([Chunk] -> P ()) -> [Chunk] -> P ()
forall a b. (a -> b) -> a -> b
$ Text -> [Chunk]
outputDescribeLine Text
t
              (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ResultForest -> ResultTree
forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Maybe ResultForest) -> P (Maybe ResultForest)
forall a. P a -> P a
addLevel (SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sf)
        DefSetupNode IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf
        DefBeforeAllWithNode oldOuter -> IO newOuter
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf
        DefWrapNode IO () -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf
        DefAfterAllNode HList a -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefParallelismNode Parallelism
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefRetriesNode Word -> Word
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefFlakinessNode FlakinessMode
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefExpectationNode ExpectationMode
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> P (Maybe ResultForest) -> ReaderT Int IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
  ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine [[Chunk]]
outputTestsHeader
  ResultForest
resultForest <- ResultForest -> Maybe ResultForest -> ResultForest
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe ResultForest -> ResultForest)
-> IO (Maybe ResultForest) -> IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> P (Maybe ResultForest) -> Int -> IO (Maybe ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (HandleForest '[] () -> P (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> P (Maybe ResultForest)
goForest HandleForest '[] ()
handleForest) Int
0
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
  ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading Settings
settings ResultForest
resultForest
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
  Word64
suiteEnd <- IO Word64
getMonotonicTimeNSec
  let timedResult :: Timed ResultForest
timedResult =
        Timed
          { timedValue :: ResultForest
timedValue = ResultForest
resultForest,
            timedWorker :: Int
timedWorker = Int
0,
            timedBegin :: Word64
timedBegin = Word64
suiteBegin,
            timedEnd :: Word64
timedEnd = Word64
suiteEnd
          }
  ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Timed TestSuiteStats -> [[Chunk]]
outputStats (Settings -> ResultForest -> TestSuiteStats
computeTestSuiteStats Settings
settings (ResultForest -> TestSuiteStats)
-> Timed ResultForest -> Timed TestSuiteStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
timedResult)
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
settingProfile Settings
settings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine (Timed ResultForest -> [[Chunk]]
outputProfilingInfo Timed ResultForest
timedResult)
    [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]

  Timed ResultForest -> IO (Timed ResultForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
timedResult

addLevel :: P a -> P a
addLevel :: forall a. P a -> P a
addLevel = (Int -> Int) -> ReaderT Int IO a -> ReaderT Int IO a
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT Int -> Int
forall a. Enum a => a -> a
succ

type P = ReaderT Int IO

waiter :: MVar () -> HandleForest '[] () -> IO ResultForest
waiter :: MVar () -> HandleForest '[] () -> IO ResultForest
waiter MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  let goForest :: HandleForest a b -> IO (Maybe ResultForest)
      goForest :: forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest HandleForest a b
hts = do
        ResultForest
rts <- [Maybe ResultTree] -> ResultForest
forall a. [Maybe a] -> [a]
catMaybes ([Maybe ResultTree] -> ResultForest)
-> IO [Maybe ResultTree] -> IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (HandleTree a b -> IO (Maybe ResultTree))
-> HandleForest a b -> IO [Maybe ResultTree]
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 HandleTree a b -> IO (Maybe ResultTree)
forall (a :: [*]) b. HandleTree a b -> IO (Maybe ResultTree)
goTree HandleForest a b
hts
        Maybe ResultForest -> IO (Maybe ResultForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultForest -> IO (Maybe ResultForest))
-> Maybe ResultForest -> IO (Maybe ResultForest)
forall a b. (a -> b) -> a -> b
$ if ResultForest -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultForest
rts then Maybe ResultForest
forall a. Maybe a
Nothing else ResultForest -> Maybe ResultForest
forall a. a -> Maybe a
Just ResultForest
rts

      goTree :: HandleTree a b -> IO (Maybe ResultTree)
      goTree :: forall (a :: [*]) b. HandleTree a b -> IO (Maybe ResultTree)
goTree = \case
        DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunReport)
var -> do
          Either () (Timed TestRunReport)
failFastOrResult <-
            IO ()
-> IO (Timed TestRunReport) -> IO (Either () (Timed TestRunReport))
forall a b. IO a -> IO b -> IO (Either a b)
race
              (MVar () -> IO ()
forall a. MVar a -> IO a
readMVar MVar ()
failFastVar)
              (MVar (Timed TestRunReport) -> IO (Timed TestRunReport)
forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunReport)
var)
          case Either () (Timed TestRunReport)
failFastOrResult of
            Left () -> Maybe ResultTree -> IO (Maybe ResultTree)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
            Right Timed TestRunReport
result -> do
              let td' :: TDef (Timed TestRunReport)
td' = TDef
  (ProgressReporter
   -> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal = result}
              Maybe ResultTree -> IO (Maybe ResultTree)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultTree -> IO (Maybe ResultTree))
-> Maybe ResultTree -> IO (Maybe ResultTree)
forall a b. (a -> b) -> a -> b
$ ResultTree -> Maybe ResultTree
forall a. a -> Maybe a
Just (ResultTree -> Maybe ResultTree) -> ResultTree -> Maybe ResultTree
forall a b. (a -> b) -> a -> b
$ Text -> TDef (Timed TestRunReport) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunReport)
td'
        DefPendingNode Text
t Maybe Text
mr -> Maybe ResultTree -> IO (Maybe ResultTree)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ResultTree -> IO (Maybe ResultTree))
-> Maybe ResultTree -> IO (Maybe ResultTree)
forall a b. (a -> b) -> a -> b
$ ResultTree -> Maybe ResultTree
forall a. a -> Maybe a
Just (ResultTree -> Maybe ResultTree) -> ResultTree -> Maybe ResultTree
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> ResultTree
forall a. Text -> Maybe Text -> SpecTree a
PendingNode Text
t Maybe Text
mr
        DefDescribeNode Text
t SpecDefForest a b (MVar (Timed TestRunReport))
sf -> do
          (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ResultForest -> ResultTree
forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sf
        DefSetupNode IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf
        DefBeforeAllWithNode oldOuter -> IO newOuter
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf
        DefWrapNode IO () -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest (outer : a) b (MVar (Timed TestRunReport))
sdf
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunReport))
sdf
        DefAfterAllNode HList a -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefParallelismNode Parallelism
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefRetriesNode Word -> Word
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefFlakinessNode FlakinessMode
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
        DefExpectationNode ExpectationMode
_ SpecDefForest a b (MVar (Timed TestRunReport))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Maybe ResultForest -> Maybe ResultTree)
-> IO (Maybe ResultForest) -> IO (Maybe ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a b (MVar (Timed TestRunReport))
-> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest SpecDefForest a b (MVar (Timed TestRunReport))
sdf
  ResultForest -> Maybe ResultForest -> ResultForest
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe ResultForest -> ResultForest)
-> IO (Maybe ResultForest) -> IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HandleForest '[] () -> IO (Maybe ResultForest)
forall (a :: [*]) b. HandleForest a b -> IO (Maybe ResultForest)
goForest HandleForest '[] ()
handleForest