{-# 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 as SB
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 Rainbow
import Test.QuickCheck.IO ()
import Test.Syd.HList
import Test.Syd.Output
import Test.Syd.Run
import Test.Syd.SpecDef
import Test.Syd.SpecForest

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 :: Maybe Bool -> Bool -> Int -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously :: Maybe Bool
-> Bool -> Int -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously Maybe Bool
mColour 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
$ Maybe Bool
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer Maybe Bool
mColour 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 v. TDef v -> v
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 a
func SpecDefForest (a : a) () (MVar (Timed TestRunResult))
sdf -> do
          a
b <- IO a
func
          Parallelism
-> HList (a : a)
-> SpecDefForest (a : a) () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (a -> HList a -> HList (a : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
b HList a
a) SpecDefForest (a : a) () (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (a -> IO ()) -> IO ()
func SpecDefForest (a : a) () (MVar (Timed TestRunResult))
sdf ->
          (a -> IO ()) -> IO ()
func (\a
b -> Parallelism
-> HList (a : a)
-> SpecDefForest (a : a) () (MVar (Timed TestRunResult))
-> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (a -> HList a -> HList (a : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons a
b HList a
a) SpecDefForest (a : a) () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
waitForCurrentlyRunning)
        DefAroundAllWithNode (b -> IO ()) -> a -> IO ()
func SpecDefForest (b : a : l) () (MVar (Timed TestRunResult))
sdf ->
          let HCons e
x HList l
_ = HList a
a
           in (b -> IO ()) -> a -> IO ()
func (\b
b -> Parallelism -> HList (b : a) -> HandleForest (b : a) () -> IO ()
forall (a :: [*]).
Parallelism -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p (b -> HList a -> HList (b : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons b
b HList a
a) HandleForest (b : a) ()
SpecDefForest (b : a : l) () (MVar (Timed TestRunResult))
sdf IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
waitForCurrentlyRunning) a
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 :: Maybe Bool -> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer :: Maybe Bool
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer Maybe Bool
mColour MVar ()
failFastVar HandleForest '[] ()
handleForest = do
  Chunk -> [ByteString] -> [ByteString]
byteStringMaker <- case Maybe Bool
mColour of
    Just Bool
False -> (Chunk -> [ByteString] -> [ByteString])
-> IO (Chunk -> [ByteString] -> [ByteString])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunk -> [ByteString] -> [ByteString]
toByteStringsColors0
    Just Bool
True -> (Chunk -> [ByteString] -> [ByteString])
-> IO (Chunk -> [ByteString] -> [ByteString])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Chunk -> [ByteString] -> [ByteString]
toByteStringsColors256
    Maybe Bool
Nothing -> IO (Chunk -> [ByteString] -> [ByteString])
-> IO (Chunk -> [ByteString] -> [ByteString])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Chunk -> [ByteString] -> [ByteString])
byteStringMakerFromEnvironment
  let outputLine :: [Chunk] -> IO ()
      outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = do
        let bss :: [ByteString]
bss = (Chunk -> [ByteString] -> [ByteString]) -> [Chunk] -> [ByteString]
chunksToByteStrings Chunk -> [ByteString] -> [ByteString]
byteStringMaker [Chunk]
lineChunks
        (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> IO ()
SB.putStr [ByteString]
bss
        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 a
_ SpecDefForest (a : 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 : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (a : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (a -> IO ()) -> IO ()
_ SpecDefForest (a : 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 : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (a : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllWithNode (b -> IO ()) -> a -> IO ()
_ SpecDefForest (b : a : l) 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 (b : a : l) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (b : a : l) 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 a
_ SpecDefForest (a : 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 : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (a : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllNode (a -> IO ()) -> IO ()
_ SpecDefForest (a : 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 : a) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (a : a) b (MVar (Timed TestRunResult))
sdf
        DefAroundAllWithNode (b -> IO ()) -> a -> IO ()
_ SpecDefForest (b : a : l) 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 (b : a : l) b (MVar (Timed TestRunResult))
-> IO (Maybe ResultForest)
forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest (b : a : l) 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