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

-- | This module defines how to run a test suite
module Test.Syd.Runner.Asynchronous where

import Control.Concurrent
import Control.Concurrent.Async
import Control.Exception
import Control.Monad.Reader
import qualified Data.ByteString.Char8 as SB8
import Data.IORef
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Text as T
import Test.QuickCheck.IO ()
import Test.Syd.HList
import Test.Syd.Output
import Test.Syd.Run
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour

runSpecForestAsynchronously :: Bool -> Int -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously :: Bool -> Int -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously Bool
failFast Int
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 = Bool -> Int -> MVar () -> HandleForest '[] () -> IO ()
runner Bool
failFast Int
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
      runPrinter :: IO ResultForest
runPrinter = IO ResultForest -> IO ResultForest
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 (f :: * -> *) a. Applicative f => a -> f a
pure ResultForest
resultForest

runSpecForestInterleavedWithOutputAsynchronously :: TerminalCapabilities -> Bool -> Int -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously :: TerminalCapabilities
-> Bool -> Int -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously TerminalCapabilities
tc Bool
failFast Int
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 = Bool -> Int -> MVar () -> HandleForest '[] () -> IO ()
runner Bool
failFast Int
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
      runPrinter :: IO (Timed ResultForest)
runPrinter = IO (Timed ResultForest) -> IO (Timed ResultForest)
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
$ TerminalCapabilities
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer TerminalCapabilities
tc MVar ()
failFastVar 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 (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
resultForest

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

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

makeHandleForest :: TestForest a b -> IO (HandleForest a b)
makeHandleForest :: TestForest a b -> IO (HandleForest a b)
makeHandleForest = (SpecDefTree a b ()
 -> IO (SpecDefTree a b (MVar (Timed TestRunResult))))
-> TestForest a b -> IO (HandleForest a b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((SpecDefTree a b ()
  -> IO (SpecDefTree a b (MVar (Timed TestRunResult))))
 -> TestForest a b -> IO (HandleForest a b))
-> (SpecDefTree a b ()
    -> IO (SpecDefTree a b (MVar (Timed TestRunResult))))
-> TestForest a b
-> IO (HandleForest a b)
forall a b. (a -> b) -> a -> b
$
  (() -> IO (MVar (Timed TestRunResult)))
-> SpecDefTree a b ()
-> IO (SpecDefTree a b (MVar (Timed TestRunResult)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((() -> IO (MVar (Timed TestRunResult)))
 -> SpecDefTree a b ()
 -> IO (SpecDefTree a b (MVar (Timed TestRunResult))))
-> (() -> IO (MVar (Timed TestRunResult)))
-> SpecDefTree a b ()
-> IO (SpecDefTree a b (MVar (Timed TestRunResult)))
forall a b. (a -> b) -> a -> b
$ \() ->
    IO (MVar (Timed TestRunResult))
forall a. IO (MVar a)
newEmptyMVar

runner :: Bool -> Int -> MVar () -> HandleForest '[] () -> IO ()
runner :: Bool -> Int -> MVar () -> HandleForest '[] () -> IO ()
runner Bool
failFast Int
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  QSemN
sem <- IO QSemN -> IO QSemN
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO QSemN -> IO QSemN) -> IO QSemN -> IO QSemN
forall a b. (a -> b) -> a -> b
$ Int -> IO QSemN
newQSemN Int
nbThreads
  IORef (Set (Async ()))
jobs <- Set (Async ()) -> IO (IORef (Set (Async ())))
forall a. a -> IO (IORef a)
newIORef (Set (Async ())
forall a. Set a
S.empty :: Set (Async ()))
  -- This is used to make sure that the 'after' part of the resources actually happens after the tests are done, not just when they are started.
  let waitForCurrentlyRunning :: IO ()
      waitForCurrentlyRunning :: IO ()
waitForCurrentlyRunning = do
        Set (Async ())
as <- IORef (Set (Async ())) -> IO (Set (Async ()))
forall a. IORef a -> IO a
readIORef IORef (Set (Async ()))
jobs
        (Async () -> IO ()) -> Set (Async ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall a. Async a -> IO a
wait Set (Async ())
as
        IORef (Set (Async ())) -> Set (Async ()) -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Set (Async ()))
jobs Set (Async ())
forall a. Set a
S.empty
  let goForest :: Parallelism -> HList a -> HandleForest a () -> IO ()
      goForest :: Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p HList a
a = (HandleTree a () -> IO ()) -> HandleForest a () -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Parallelism -> HList a -> HandleTree a () -> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleTree a () -> IO ()
goTree Parallelism
p HList a
a)
      goTree :: Parallelism -> HList a -> HandleTree a () -> IO ()
      goTree :: Parallelism -> HList a -> HandleTree a () -> IO ()
goTree Parallelism
p HList a
a = \case
        DefSpecifyNode Text
_ TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
          Maybe ()
mDone <- MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
          case Maybe ()
mDone of
            Maybe ()
Nothing -> do
              let runNow :: IO (Timed TestRunResult)
runNow = IO TestRunResult -> IO (Timed TestRunResult)
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT (IO TestRunResult -> IO (Timed TestRunResult))
-> IO TestRunResult -> IO (Timed TestRunResult)
forall a b. (a -> b) -> a -> b
$ TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult
forall value. TDef value -> value
testDefVal TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td (\HList a -> () -> IO ()
f -> HList a -> () -> IO ()
f HList a
a ())
              -- Wait before spawning a thread so that we don't spawn too many threads
              let quantity :: Int
quantity = case Parallelism
p of
                    -- When the test wants to be executed sequentially, we take n locks because we must make sure that
                    -- 1. no more other tests are still running.
                    -- 2. no other tests are started during execution.
                    Parallelism
Sequential -> Int
nbThreads
                    Parallelism
Parallel -> Int
1
              IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
waitQSemN QSemN
sem Int
quantity
              let job :: IO ()
                  job :: IO ()
job = do
                    Timed TestRunResult
result <- IO (Timed TestRunResult)
runNow
                    MVar (Timed TestRunResult) -> Timed TestRunResult -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar (Timed TestRunResult)
var Timed TestRunResult
result
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
failFast Bool -> Bool -> Bool
&& TestRunResult -> TestStatus
testRunResultStatus (Timed TestRunResult -> TestRunResult
forall a. Timed a -> a
timedValue Timed TestRunResult
result) TestStatus -> TestStatus -> Bool
forall a. Eq a => a -> a -> Bool
== TestStatus
TestFailed) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                      MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
failFastVar ()
                      Set (Async ())
as <- IORef (Set (Async ())) -> IO (Set (Async ()))
forall a. IORef a -> IO a
readIORef IORef (Set (Async ()))
jobs
                      (Async () -> IO ()) -> Set (Async ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Async () -> IO ()
forall a. Async a -> IO ()
cancel Set (Async ())
as
                    IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
signalQSemN QSemN
sem Int
quantity
              Async ()
jobAsync <- IO () -> IO (Async ())
forall a. IO a -> IO (Async a)
async IO ()
job
              IORef (Set (Async ()))
-> (Set (Async ()) -> Set (Async ())) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Set (Async ()))
jobs (Async () -> Set (Async ()) -> Set (Async ())
forall a. Ord a => a -> Set a -> Set a
S.insert Async ()
jobAsync)
              Async () -> IO ()
forall a. Async a -> IO ()
link Async ()
jobAsync
            Just () -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        DefPendingNode Text
_ Maybe Text
_ -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        DefDescribeNode Text
_ SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> Parallelism
-> HList a
-> SpecDefForest a () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
        DefWrapNode IO () -> IO ()
func SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> IO () -> IO ()
func (Parallelism
-> HList a
-> SpecDefForest a () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
waitForCurrentlyRunning)
        DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
sdf -> do
          outer
b <- IO outer
func
          Parallelism
-> HList (outer : a)
-> SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
a) SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
sdf ->
          (outer -> IO ()) -> IO ()
func (\outer
b -> Parallelism
-> HList (outer : a)
-> SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
a) SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
waitForCurrentlyRunning)
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunResult))
sdf ->
          let HCons e
x HList l
_ = HList a
a
           in (newOuter -> IO ()) -> oldOuter -> IO ()
func (\newOuter
b -> Parallelism
-> HList (newOuter : a) -> HandleForest (newOuter : a) () -> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (newOuter -> HList a -> HList (newOuter : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
a) HandleForest (newOuter : a) ()
SpecDefForest
  (newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
waitForCurrentlyRunning) oldOuter
x
        DefAfterAllNode HList a -> IO ()
func SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> Parallelism
-> HList a
-> SpecDefForest a () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` (IO ()
waitForCurrentlyRunning IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> HList a -> IO ()
func HList a
a)
        DefParallelismNode Parallelism
p' SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> Parallelism
-> HList a
-> SpecDefForest a () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p' HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> Parallelism
-> HList a
-> SpecDefForest a () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
  Parallelism -> HList '[] -> HandleForest '[] () -> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
Parallel HList '[]
HNil HandleForest '[] ()
handleForest

printer :: TerminalCapabilities -> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer :: TerminalCapabilities
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer TerminalCapabilities
tc MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  let outputLine :: [Chunk] -> IO ()
      outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = IO () -> IO ()
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 ()
putChunksWith TerminalCapabilities
tc [Chunk]
lineChunks
        ByteString -> IO ()
SB8.putStrLn ByteString
""

      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 goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)
      goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level 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)
mapM (Int -> HandleTree a b -> IO (Maybe ResultTree)
forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level) HandleForest a b
hts
        Maybe ResultForest -> IO (Maybe ResultForest)
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 (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 :: Int -> HandleTree a b -> IO (Maybe ResultTree)
      goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level = \case
        DefSpecifyNode Text
t TDef (((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
          Either () (Timed TestRunResult)
failFastOrResult <- IO ()
-> IO (Timed TestRunResult) -> IO (Either () (Timed TestRunResult))
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 TestRunResult) -> IO (Timed TestRunResult)
forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunResult)
var)
          case Either () (Timed TestRunResult)
failFastOrResult of
            Left () -> Maybe ResultTree -> IO (Maybe ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
            Right Timed TestRunResult
result -> do
              let td' :: TDef (Timed TestRunResult)
td' = TDef (((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
              ([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] -> [Chunk]) -> [Chunk] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
outputSpecifyLines Int
level Int
treeWidth Text
t TDef (Timed TestRunResult)
td'
              Maybe ResultTree -> IO (Maybe ResultTree)
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 TestRunResult) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunResult)
td'
        DefPendingNode Text
t Maybe Text
mr -> do
          ([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] -> [Chunk]) -> [Chunk] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
          Maybe ResultTree -> IO (Maybe ResultTree)
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 TestRunResult))
sf -> do
          Maybe ()
mDone <- MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
          case Maybe ()
mDone of
            Maybe ()
Nothing -> do
              [Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Chunk] -> [Chunk]
pad Int
level ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ Text -> [Chunk]
outputDescribeLine Text
t
              (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest (Int -> Int
forall a. Enum a => a -> a
succ Int
level) SpecDefForest a b (MVar (Timed TestRunResult))
sf
            Just () -> Maybe ResultTree -> IO (Maybe ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
        DefWrapNode IO () -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest
     (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
sdf
        DefAfterAllNode HList a -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefParallelismNode Parallelism
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
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
  Timed ResultForest
resultForest <- IO ResultForest -> IO (Timed ResultForest)
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT (IO ResultForest -> IO (Timed ResultForest))
-> IO ResultForest -> IO (Timed ResultForest)
forall a b. (a -> b) -> a -> b
$ 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
<$> Int -> HandleForest '[] () -> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
0 HandleForest '[] ()
handleForest
  [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
$ ResultForest -> [[Chunk]]
outputFailuresWithHeading (Timed ResultForest -> ResultForest
forall a. Timed a -> a
timedValue Timed ResultForest
resultForest)
  [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
$ Timed TestSuiteStats -> [[Chunk]]
outputStats (ResultForest -> TestSuiteStats
computeTestSuiteStats (ResultForest -> TestSuiteStats)
-> Timed ResultForest -> Timed TestSuiteStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
resultForest)
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
  Timed ResultForest -> IO (Timed ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
resultForest

waiter :: MVar () -> HandleForest '[] () -> IO ResultForest
waiter :: MVar () -> HandleForest '[] () -> IO ResultForest
waiter MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  let goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)
      goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level 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)
mapM (Int -> HandleTree a b -> IO (Maybe ResultTree)
forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level) HandleForest a b
hts
        Maybe ResultForest -> IO (Maybe ResultForest)
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 (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 :: Int -> HandleTree a b -> IO (Maybe ResultTree)
      goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level = \case
        DefSpecifyNode Text
t TDef (((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
          Either () (Timed TestRunResult)
failFastOrResult <- IO ()
-> IO (Timed TestRunResult) -> IO (Either () (Timed TestRunResult))
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 TestRunResult) -> IO (Timed TestRunResult)
forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunResult)
var)
          case Either () (Timed TestRunResult)
failFastOrResult of
            Left () -> Maybe ResultTree -> IO (Maybe ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ResultTree
forall a. Maybe a
Nothing
            Right Timed TestRunResult
result -> do
              let td' :: TDef (Timed TestRunResult)
td' = TDef (((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
              Maybe ResultTree -> IO (Maybe ResultTree)
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 TestRunResult) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunResult)
td'
        DefPendingNode Text
t Maybe Text
mr -> Maybe ResultTree -> IO (Maybe ResultTree)
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 TestRunResult))
sf -> do
          (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest (Int -> Int
forall a. Enum a => a -> a
succ Int
level) SpecDefForest a b (MVar (Timed TestRunResult))
sf
        DefWrapNode IO () -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefBeforeAllNode IO outer
_ SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (outer -> IO ()) -> IO ()
_ SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (outer : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
_ SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest
     (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest
  (newOuter : oldOuter : otherOuters) b (MVar (Timed TestRunResult))
sdf
        DefAfterAllNode HList a -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefParallelismNode Parallelism
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> (ResultForest -> ResultTree)
-> Maybe ResultForest -> Maybe ResultTree
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
<$> Int
-> SpecDefForest a b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
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
<$> Int -> HandleForest '[] () -> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
0 HandleForest '[] ()
handleForest