{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
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 ()))
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 ())
let quantity :: Int
quantity = case Parallelism
p of
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