{-# 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 Data.IORef
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Test.QuickCheck.IO ()
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Output
import Test.Syd.Run
import Test.Syd.Runner.Synchronous
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour
runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously :: Settings -> Word -> TestForest '[] () -> IO ResultForest
runSpecForestAsynchronously Settings
settings Word
nbThreads TestForest '[] ()
testForest = do
HandleForest '[] ()
handleForest <- forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest TestForest '[] ()
testForest
MVar ()
failFastVar <- forall a. IO (MVar a)
newEmptyMVar
let runRunner :: IO ()
runRunner = Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
runPrinter :: IO ResultForest
runPrinter = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ MVar () -> HandleForest '[] () -> IO ResultForest
waiter MVar ()
failFastVar HandleForest '[] ()
handleForest
((), ResultForest
resultForest) <- forall a b. IO a -> IO b -> IO (a, b)
concurrently IO ()
runRunner IO ResultForest
runPrinter
forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultForest
resultForest
runSpecForestInterleavedWithOutputAsynchronously :: Settings -> Word -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously :: Settings -> Word -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputAsynchronously Settings
settings Word
nbThreads TestForest '[] ()
testForest = do
HandleForest '[] ()
handleForest <- forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest TestForest '[] ()
testForest
MVar ()
failFastVar <- forall a. IO (MVar a)
newEmptyMVar
let runRunner :: IO ()
runRunner = Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest
runPrinter :: IO (Timed ResultForest)
runPrinter = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Settings
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer Settings
settings MVar ()
failFastVar HandleForest '[] ()
handleForest
((), Timed ResultForest
resultForest) <- forall a b. IO a -> IO b -> IO (a, b)
concurrently IO ()
runRunner IO (Timed ResultForest)
runPrinter
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 :: forall (a :: [*]) b. TestForest a b -> IO (HandleForest a b)
makeHandleForest = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a b. (a -> b) -> a -> b
$ \() -> forall a. IO (MVar a)
newEmptyMVar
runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner :: Settings -> Word -> MVar () -> HandleForest '[] () -> IO ()
runner Settings
settings Word
nbThreads MVar ()
failFastVar HandleForest '[] ()
handleForest = do
QSemN
sem <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Int -> IO QSemN
newQSemN forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
nbThreads
IORef (Set (Async ()))
jobs <- forall a. a -> IO (IORef a)
newIORef (forall a. Set a
S.empty :: Set (Async ()))
let waitForCurrentlyRunning :: IO ()
waitForCurrentlyRunning :: IO ()
waitForCurrentlyRunning = do
Set (Async ())
as <- forall a. IORef a -> IO a
readIORef IORef (Set (Async ()))
jobs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Async a -> IO a
wait Set (Async ())
as
forall a. IORef a -> a -> IO ()
writeIORef IORef (Set (Async ()))
jobs forall a. Set a
S.empty
let goForest :: Parallelism -> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest :: forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm HList a
a = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall (a :: [*]).
Parallelism -> FlakinessMode -> HList a -> HandleTree a () -> IO ()
goTree Parallelism
p FlakinessMode
fm HList a
a)
goTree :: Parallelism -> FlakinessMode -> HList a -> HandleTree a () -> IO ()
goTree :: forall (a :: [*]).
Parallelism -> FlakinessMode -> HList a -> HandleTree a () -> IO ()
goTree Parallelism
p FlakinessMode
fm HList a
a = \case
DefSpecifyNode Text
_ TDef
(ProgressReporter
-> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
Maybe ()
mDone <- forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
case Maybe ()
mDone of
Maybe ()
Nothing -> do
let runNow :: IO (Timed TestRunResult)
runNow = forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT forall a b. (a -> b) -> a -> b
$ forall (a :: [*]) t.
ProgressReporter
-> HList a
-> TDef
(ProgressReporter
-> ((HList a -> () -> t) -> t) -> IO TestRunResult)
-> FlakinessMode
-> IO TestRunResult
runSingleTestWithFlakinessMode ProgressReporter
noProgressReporter HList a
a TDef
(ProgressReporter
-> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td FlakinessMode
fm
let quantity :: Word
quantity = case Parallelism
p of
Parallelism
Sequential -> Word
nbThreads
Parallelism
Parallel -> Word
1
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
waitQSemN QSemN
sem forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
quantity
let job :: IO ()
job :: IO ()
job = do
Timed TestRunResult
result <- IO (Timed TestRunResult)
runNow
forall a. MVar a -> a -> IO ()
putMVar MVar (Timed TestRunResult)
var Timed TestRunResult
result
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
settingFailFast Settings
settings Bool -> Bool -> Bool
&& TestRunResult -> TestStatus
testRunResultStatus (forall a. Timed a -> a
timedValue Timed TestRunResult
result) forall a. Eq a => a -> a -> Bool
== TestStatus
TestFailed) forall a b. (a -> b) -> a -> b
$ do
forall a. MVar a -> a -> IO ()
putMVar MVar ()
failFastVar ()
Set (Async ())
as <- forall a. IORef a -> IO a
readIORef IORef (Set (Async ()))
jobs
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall a. Async a -> IO ()
cancel Set (Async ())
as
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ QSemN -> Int -> IO ()
signalQSemN QSemN
sem forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
quantity
Async ()
jobAsync <- forall a. IO a -> IO (Async a)
async IO ()
job
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef IORef (Set (Async ()))
jobs (forall a. Ord a => a -> Set a -> Set a
S.insert Async ()
jobAsync)
forall a. Async a -> IO ()
link Async ()
jobAsync
Just () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DefPendingNode Text
_ Maybe Text
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
DefDescribeNode Text
_ SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
DefWrapNode IO () -> IO ()
func SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> IO () -> IO ()
func (forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf 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
forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm (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 -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
a) SpecDefForest (outer : a) () (MVar (Timed TestRunResult))
sdf 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 oldOuter
e
x HList l
_ = HList a
a
in (newOuter -> IO ()) -> oldOuter -> IO ()
func (\newOuter
b -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
a) SpecDefForest
(newOuter : oldOuter : otherOuters) () (MVar (Timed TestRunResult))
sdf 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 -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf forall a b. IO a -> IO b -> IO a
`finally` (IO ()
waitForCurrentlyRunning 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 -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p' FlakinessMode
fm HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
DefFlakinessNode FlakinessMode
fm' SpecDefForest a () (MVar (Timed TestRunResult))
sdf -> forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
p FlakinessMode
fm' HList a
a SpecDefForest a () (MVar (Timed TestRunResult))
sdf
forall (a :: [*]).
Parallelism
-> FlakinessMode -> HList a -> HandleForest a () -> IO ()
goForest Parallelism
Parallel FlakinessMode
MayNotBeFlaky HList '[]
HNil HandleForest '[] ()
handleForest
printer :: Settings -> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer :: Settings
-> MVar () -> HandleForest '[] () -> IO (Timed ResultForest)
printer Settings
settings MVar ()
failFastVar HandleForest '[] ()
handleForest = do
TerminalCapabilities
tc <- Settings -> IO TerminalCapabilities
deriveTerminalCapababilities Settings
settings
let outputLine :: [Chunk] -> IO ()
outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
tc [Chunk]
lineChunks
Text -> IO ()
TIO.putStrLn Text
""
treeWidth :: Int
treeWidth :: Int
treeWidth = 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 (forall a. Int -> a -> [a]
replicate (Int
paddingSize forall a. Num a => a -> a -> a
* Int
level) Char
' ')) forall a. a -> [a] -> [a]
:)
let goForest :: Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest :: forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level HandleForest a b
hts = do
ResultForest
rts <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level) HandleForest a b
hts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultForest
rts then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ResultForest
rts
goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree :: forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level = \case
DefSpecifyNode Text
t TDef
(ProgressReporter
-> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
Either () (Timed TestRunResult)
failFastOrResult <- forall a b. IO a -> IO b -> IO (Either a b)
race (forall a. MVar a -> IO a
readMVar MVar ()
failFastVar) (forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunResult)
var)
case Either () (Timed TestRunResult)
failFastOrResult of
Left () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Right Timed TestRunResult
result -> do
let td' :: TDef (Timed TestRunResult)
td' = TDef
(ProgressReporter
-> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Chunk] -> IO ()
outputLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) 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'
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunResult)
td'
DefPendingNode Text
t Maybe Text
mr -> do
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Chunk] -> IO ()
outputLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ 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 <- forall a. MVar a -> IO (Maybe a)
tryReadMVar MVar ()
failFastVar
case Maybe ()
mDone of
Maybe ()
Nothing -> do
[Chunk] -> IO ()
outputLine forall a b. (a -> b) -> a -> b
$ Int -> [Chunk] -> [Chunk]
pad Int
level forall a b. (a -> b) -> a -> b
$ Text -> [Chunk]
outputDescribeLine Text
t
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest (forall a. Enum a => a -> a
succ Int
level) SpecDefForest a b (MVar (Timed TestRunResult))
sf
Just () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
DefWrapNode IO () -> IO ()
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
DefFlakinessNode FlakinessMode
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine [[Chunk]]
outputTestsHeader
Timed ResultForest
resultForest <- forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
0 HandleForest '[] ()
handleForest
[Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine forall a b. (a -> b) -> a -> b
$ Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading Settings
settings (forall a. Timed a -> a
timedValue Timed ResultForest
resultForest)
[Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine forall a b. (a -> b) -> a -> b
$ Timed TestSuiteStats -> [[Chunk]]
outputStats (ResultForest -> TestSuiteStats
computeTestSuiteStats forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
resultForest)
[Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
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 :: forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level HandleForest a b
hts = do
ResultForest
rts <- forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level) HandleForest a b
hts
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null ResultForest
rts then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ResultForest
rts
goTree :: Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree :: forall (a :: [*]) b. Int -> HandleTree a b -> IO (Maybe ResultTree)
goTree Int
level = \case
DefSpecifyNode Text
t TDef
(ProgressReporter
-> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td MVar (Timed TestRunResult)
var -> do
Either () (Timed TestRunResult)
failFastOrResult <- forall a b. IO a -> IO b -> IO (Either a b)
race (forall a. MVar a -> IO a
readMVar MVar ()
failFastVar) (forall a. MVar a -> IO a
takeMVar MVar (Timed TestRunResult)
var)
case Either () (Timed TestRunResult)
failFastOrResult of
Left () -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
Right Timed TestRunResult
result -> do
let td' :: TDef (Timed TestRunResult)
td' = TDef
(ProgressReporter
-> ((HList a -> b -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> SpecTree a
SpecifyNode Text
t TDef (Timed TestRunResult)
td'
DefPendingNode Text
t Maybe Text
mr -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Text -> Maybe Text -> SpecTree a
PendingNode Text
t Maybe Text
mr
DefDescribeNode Text
t SpecDefForest a b (MVar (Timed TestRunResult))
sf -> do
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest (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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
DefFlakinessNode FlakinessMode
_ SpecDefForest a b (MVar (Timed TestRunResult))
sdf -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. SpecForest a -> SpecTree a
SubForestNode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
level SpecDefForest a b (MVar (Timed TestRunResult))
sdf
forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]) b.
Int -> HandleForest a b -> IO (Maybe ResultForest)
goForest Int
0 HandleForest '[] ()
handleForest