{-# 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.Synchronous where

import Control.Exception
import Control.Monad.IO.Class
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Output
import Test.Syd.Run
import Test.Syd.Runner.Wrappers
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour

runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously Settings
settings = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Next a -> a
extractNext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
MayNotBeFlaky HList '[]
HNil
  where
    goForest :: FlakinessMode -> HList a -> TestForest a () -> IO (Next ResultForest)
    goForest :: forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
_ HList a
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Next a
Continue [])
    goForest FlakinessMode
f HList a
hl (SpecDefTree a () ()
tt : [SpecDefTree a () ()]
rest) = do
      Next ResultTree
nrt <- forall (a :: [*]).
FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)
goTree FlakinessMode
f HList a
hl SpecDefTree a () ()
tt
      case Next ResultTree
nrt of
        Continue ResultTree
rt -> do
          Next ResultForest
nf <- forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
f HList a
hl [SpecDefTree a () ()]
rest
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ResultTree
rt forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next ResultForest
nf
        Stop ResultTree
rt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Next a
Stop [ResultTree
rt]
    goTree :: forall a. FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)
    goTree :: forall (a :: [*]).
FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)
goTree FlakinessMode
fm HList a
hl = \case
      DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td () -> do
        Timed TestRunResult
result <- 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
hl TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td FlakinessMode
fm
        let td' :: TDef (Timed TestRunResult)
td' = TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
        let r :: Next (TDef (Timed TestRunResult))
r = Bool
-> TDef (Timed TestRunResult) -> Next (TDef (Timed TestRunResult))
failFastNext (Settings -> Bool
settingFailFast Settings
settings) TDef (Timed TestRunResult)
td'
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> SpecTree a
SpecifyNode Text
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next (TDef (Timed TestRunResult))
r
      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 -> Next a
Continue 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 () ()
sdf -> 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 :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf
      DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
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 (m :: * -> *) r. MonadIO m => (m () -> m ()) -> m r -> m r
applySimpleWrapper'' IO () -> IO ()
func (forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf)
      DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () ()
sdf -> do
        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
<$> ( do
                  outer
b <- IO outer
func
                  forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
hl) SpecDefForest (outer : a) () ()
sdf
              )
      DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () ()
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 (m :: * -> *) a r.
MonadIO m =>
((a -> m ()) -> m ()) -> (a -> m r) -> m r
applySimpleWrapper' (outer -> IO ()) -> IO ()
func (\outer
b -> forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
hl) SpecDefForest (outer : a) () ()
sdf)
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf ->
        let HCons oldOuter
e
x HList l
_ = HList a
hl
         in 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 (m :: * -> *) a b r.
MonadIO m =>
((a -> m ()) -> b -> m ()) -> (a -> m r) -> b -> m r
applySimpleWrapper (newOuter -> IO ()) -> oldOuter -> IO ()
func (\newOuter
b -> forall (a :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
hl) SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf) oldOuter
x
      DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
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 :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
hl)
      DefParallelismNode Parallelism
_ SpecDefForest a () ()
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 :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf -- Ignore, it's synchronous anyway
      DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () ()
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 :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf
      DefFlakinessNode FlakinessMode
fm' SpecDefForest a () ()
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 :: [*]).
FlakinessMode
-> HList a -> TestForest a () -> IO (Next ResultForest)
goForest FlakinessMode
fm' HList a
hl SpecDefForest a () ()
sdf

runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputSynchronously :: Settings -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputSynchronously Settings
settings TestForest '[] ()
testForest = 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 TestForest '[] ()
testForest
  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]
:)
      goForest :: Int -> FlakinessMode -> HList a -> TestForest a () -> IO (Next ResultForest)
      goForest :: forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
_ FlakinessMode
_ HList a
_ [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Next a
Continue [])
      goForest Int
level FlakinessMode
fm HList a
l (SpecDefTree a () ()
tt : [SpecDefTree a () ()]
rest) = do
        Next ResultTree
nrt <- forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestTree a ()
-> IO (Next ResultTree)
goTree Int
level FlakinessMode
fm HList a
l SpecDefTree a () ()
tt
        case Next ResultTree
nrt of
          Continue ResultTree
rt -> do
            Next ResultForest
nf <- forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm HList a
l [SpecDefTree a () ()]
rest
            forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (ResultTree
rt forall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next ResultForest
nf
          Stop ResultTree
rt -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Next a
Stop [ResultTree
rt]
      goTree :: Int -> FlakinessMode -> HList a -> TestTree a () -> IO (Next ResultTree)
      goTree :: forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestTree a ()
-> IO (Next ResultTree)
goTree Int
level FlakinessMode
fm HList a
hl = \case
        DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td () -> do
          let progressReporter :: Progress -> IO ()
              progressReporter :: ProgressReporter
progressReporter =
                [Chunk] -> IO ()
outputLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad (forall a. Enum a => a -> a
succ (forall a. Enum a => a -> a
succ Int
level)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
                  Progress
ProgressTestStarting ->
                    [ Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"Test starting: ",
                      Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
                    ]
                  ProgressExampleStarting Word
totalExamples Word
exampleNr ->
                    [ Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"Example starting:  ",
                      Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Word -> Word -> Chunk
exampleNrChunk Word
totalExamples Word
exampleNr
                    ]
                  ProgressExampleDone Word
totalExamples Word
exampleNr Word64
executionTime ->
                    [ Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"Example done:      ",
                      Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Word -> Word -> Chunk
exampleNrChunk Word
totalExamples Word
exampleNr,
                      Word64 -> Chunk
timeChunkFor Word64
executionTime
                    ]
                  Progress
ProgressTestDone ->
                    [ Colour -> Chunk -> Chunk
fore Colour
cyan Chunk
"Test done: ",
                      Colour -> Chunk -> Chunk
fore Colour
yellow forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
                    ]
          Timed TestRunResult
result <- 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
progressReporter HList a
hl TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td FlakinessMode
fm
          let td' :: TDef (Timed TestRunResult)
td' = TDef
  (ProgressReporter
   -> ((HList a -> () -> 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'
          let r :: Next (TDef (Timed TestRunResult))
r = Bool
-> TDef (Timed TestRunResult) -> Next (TDef (Timed TestRunResult))
failFastNext (Settings -> Bool
settingFailFast Settings
settings) TDef (Timed TestRunResult)
td'
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. Text -> a -> SpecTree a
SpecifyNode Text
t forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next (TDef (Timed TestRunResult))
r
        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 -> Next a
Continue 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 () ()
sf -> 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 :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest (forall a. Enum a => a -> a
succ Int
level) FlakinessMode
fm HList a
hl SpecDefForest a () ()
sf
        DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
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 (m :: * -> *) r. MonadIO m => (m () -> m ()) -> m r -> m r
applySimpleWrapper'' IO () -> IO ()
func (forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf)
        DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () ()
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
<$> ( do
                    outer
b <- IO outer
func
                    forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
hl) SpecDefForest (outer : a) () ()
sdf
                )
        DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () ()
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 (m :: * -> *) a r.
MonadIO m =>
((a -> m ()) -> m ()) -> (a -> m r) -> m r
applySimpleWrapper' (outer -> IO ()) -> IO ()
func (\outer
b -> forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
hl) SpecDefForest (outer : a) () ()
sdf)
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf ->
          let HCons oldOuter
e
x HList l
_ = HList a
hl
           in 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 (m :: * -> *) a b r.
MonadIO m =>
((a -> m ()) -> b -> m ()) -> (a -> m r) -> b -> m r
applySimpleWrapper (newOuter -> IO ()) -> oldOuter -> IO ()
func (\newOuter
b -> forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm (forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
hl) SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf) oldOuter
x
        DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
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 :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
hl)
        DefParallelismNode Parallelism
_ SpecDefForest a () ()
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 :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf -- Ignore, it's synchronous anyway
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () ()
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 :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm HList a
hl SpecDefForest a () ()
sdf
        DefFlakinessNode FlakinessMode
fm' SpecDefForest a () ()
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 :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
level FlakinessMode
fm' HList a
hl SpecDefForest a () ()
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. Next a -> a
extractNext forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: [*]).
Int
-> FlakinessMode
-> HList a
-> TestForest a ()
-> IO (Next ResultForest)
goForest Int
0 FlakinessMode
MayNotBeFlaky HList '[]
HNil TestForest '[] ()
testForest
  [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

runSingleTestWithFlakinessMode :: forall a t. ProgressReporter -> HList a -> TDef (ProgressReporter -> ((HList a -> () -> t) -> t) -> IO TestRunResult) -> FlakinessMode -> IO TestRunResult
runSingleTestWithFlakinessMode :: forall (a :: [*]) t.
ProgressReporter
-> HList a
-> TDef
     (ProgressReporter
      -> ((HList a -> () -> t) -> t) -> IO TestRunResult)
-> FlakinessMode
-> IO TestRunResult
runSingleTestWithFlakinessMode ProgressReporter
progressReporter HList a
l TDef
  (ProgressReporter
   -> ((HList a -> () -> t) -> t) -> IO TestRunResult)
td = \case
  FlakinessMode
MayNotBeFlaky -> IO TestRunResult
runFunc
  MayBeFlakyUpTo Int
retries Maybe String
mMsg -> TestRunResult -> TestRunResult
updateFlakinessMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {t}. (Ord t, Num t, Enum t) => t -> IO TestRunResult
go Int
retries
    where
      updateFlakinessMessage :: TestRunResult -> TestRunResult
      updateFlakinessMessage :: TestRunResult -> TestRunResult
updateFlakinessMessage TestRunResult
trr = case Maybe String
mMsg of
        Maybe String
Nothing -> TestRunResult
trr
        Just String
msg -> TestRunResult
trr {testRunResultFlakinessMessage :: Maybe String
testRunResultFlakinessMessage = forall a. a -> Maybe a
Just String
msg}
      go :: t -> IO TestRunResult
go t
i
        | t
i forall a. Ord a => a -> a -> Bool
<= t
1 = IO TestRunResult
runFunc
        | Bool
otherwise = do
            TestRunResult
result <- IO TestRunResult
runFunc
            case TestRunResult -> TestStatus
testRunResultStatus TestRunResult
result of
              TestStatus
TestPassed -> forall (f :: * -> *) a. Applicative f => a -> f a
pure TestRunResult
result
              TestStatus
TestFailed -> TestRunResult -> TestRunResult
updateRetriesResult forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> IO TestRunResult
go (forall a. Enum a => a -> a
pred t
i)
        where
          updateRetriesResult :: TestRunResult -> TestRunResult
          updateRetriesResult :: TestRunResult -> TestRunResult
updateRetriesResult TestRunResult
trr =
            TestRunResult
trr
              { testRunResultRetries :: Maybe Int
testRunResultRetries =
                  case TestRunResult -> Maybe Int
testRunResultRetries TestRunResult
trr of
                    Maybe Int
Nothing -> forall a. a -> Maybe a
Just Int
1
                    Just Int
r -> forall a. a -> Maybe a
Just (forall a. Enum a => a -> a
succ Int
r)
              }
  where
    runFunc :: IO TestRunResult
    runFunc :: IO TestRunResult
runFunc = forall value. TDef value -> value
testDefVal TDef
  (ProgressReporter
   -> ((HList a -> () -> t) -> t) -> IO TestRunResult)
td ProgressReporter
progressReporter (\HList a -> () -> t
f -> HList a -> () -> t
f HList a
l ())