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

module Test.Syd.Runner.Synchronous.Interleaved (runSpecForestInterleavedWithOutputSynchronously) where

import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
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.Single
import Test.Syd.Runner.Wrappers
import Test.Syd.SpecDef
import Test.Syd.SpecForest
import Text.Colour

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 = IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TerminalCapabilities -> [Chunk] -> IO ()
putChunksLocaleWith TerminalCapabilities
tc [Chunk]
lineChunks
        Text -> IO ()
TIO.putStrLn Text
""

      treeWidth :: Int
      treeWidth :: Int
treeWidth = TestForest '[] () -> Int
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 (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 outputLineR :: [Chunk] -> R a ()
      outputLineR :: forall (a :: [*]). [Chunk] -> R a ()
outputLineR [Chunk]
line = do
        Int
level <- (Env a -> Int) -> ReaderT (Env a) IO Int
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env a -> Int
forall (externalResources :: [*]). Env externalResources -> Int
eLevel
        IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> R a ()) -> IO () -> R a ()
forall a b. (a -> b) -> a -> b
$ [Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Chunk] -> [Chunk]
pad Int
level [Chunk]
line

      outputLinesR :: [[Chunk]] -> R a ()
      outputLinesR :: forall (a :: [*]). [[Chunk]] -> R a ()
outputLinesR = ([Chunk] -> ReaderT (Env a) IO ())
-> [[Chunk]] -> ReaderT (Env a) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> ReaderT (Env a) IO ()
forall (a :: [*]). [Chunk] -> R a ()
outputLineR

  let goForest :: TestForest a () -> R a (Next ResultForest)
      goForest :: forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest [] = Next ResultForest -> ReaderT (Env a) IO (Next ResultForest)
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultForest -> Next ResultForest
forall a. a -> Next a
Continue [])
      goForest (SpecDefTree a () ()
tt : [SpecDefTree a () ()]
rest) = do
        Next ResultTree
nrt <- SpecDefTree a () () -> R a (Next ResultTree)
forall (a :: [*]). TestTree a () -> R a (Next ResultTree)
goTree SpecDefTree a () ()
tt
        case Next ResultTree
nrt of
          Continue ResultTree
rt -> do
            Next ResultForest
nf <- [SpecDefTree a () ()] -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest [SpecDefTree a () ()]
rest
            Next ResultForest -> ReaderT (Env a) IO (Next ResultForest)
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> ReaderT (Env a) IO (Next ResultForest))
-> Next ResultForest -> ReaderT (Env a) IO (Next ResultForest)
forall a b. (a -> b) -> a -> b
$ (ResultTree
rt ResultTree -> ResultForest -> ResultForest
forall a. a -> [a] -> [a]
:) (ResultForest -> ResultForest)
-> Next ResultForest -> Next ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next ResultForest
nf
          Stop ResultTree
rt -> Next ResultForest -> ReaderT (Env a) IO (Next ResultForest)
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> ReaderT (Env a) IO (Next ResultForest))
-> Next ResultForest -> ReaderT (Env a) IO (Next ResultForest)
forall a b. (a -> b) -> a -> b
$ ResultForest -> Next ResultForest
forall a. a -> Next a
Stop [ResultTree
rt]

      goTree :: TestTree a () -> R a (Next ResultTree)
      goTree :: forall (a :: [*]). TestTree a () -> R a (Next ResultTree)
goTree = \case
        DefSpecifyNode Text
t TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td () -> do
          Env {Int
Word
HList a
ExpectationMode
FlakinessMode
eLevel :: forall (externalResources :: [*]). Env externalResources -> Int
eLevel :: Int
eRetries :: Word
eFlakinessMode :: FlakinessMode
eExpectationMode :: ExpectationMode
eExternalResources :: HList a
eRetries :: forall (externalResources :: [*]). Env externalResources -> Word
eFlakinessMode :: forall (externalResources :: [*]).
Env externalResources -> FlakinessMode
eExpectationMode :: forall (externalResources :: [*]).
Env externalResources -> ExpectationMode
eExternalResources :: forall (externalResources :: [*]).
Env externalResources -> HList externalResources
..} <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
          let progressReporter :: Progress -> IO ()
              progressReporter :: ProgressReporter
progressReporter =
                [Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> (Progress -> [Chunk]) -> ProgressReporter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad (Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int
forall a. Enum a => a -> a
succ Int
eLevel)) ([Chunk] -> [Chunk])
-> (Progress -> [Chunk]) -> Progress -> [Chunk]
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 (Chunk -> Chunk) -> Chunk -> Chunk
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 (Chunk -> Chunk) -> Chunk -> Chunk
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 (Chunk -> Chunk) -> Chunk -> Chunk
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 (Chunk -> Chunk) -> Chunk -> Chunk
forall a b. (a -> b) -> a -> b
$ Text -> Chunk
chunk Text
t
                    ]
          Timed TestRunReport
result <-
            IO (Timed TestRunReport)
-> ReaderT (Env a) IO (Timed TestRunReport)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Timed TestRunReport)
 -> ReaderT (Env a) IO (Timed TestRunReport))
-> IO (Timed TestRunReport)
-> ReaderT (Env a) IO (Timed TestRunReport)
forall a b. (a -> b) -> a -> b
$
              Int -> IO TestRunReport -> IO (Timed TestRunReport)
forall (m :: * -> *) a. MonadIO m => Int -> m a -> m (Timed a)
timeItT Int
0 (IO TestRunReport -> IO (Timed TestRunReport))
-> IO TestRunReport -> IO (Timed TestRunReport)
forall a b. (a -> b) -> a -> b
$
                ProgressReporter
-> HList a
-> TDef
     (ProgressReporter
      -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
runSingleTestWithFlakinessMode
                  ProgressReporter
progressReporter
                  HList a
eExternalResources
                  TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td
                  Word
eRetries
                  FlakinessMode
eFlakinessMode
                  ExpectationMode
eExpectationMode
          let td' :: TDef (Timed TestRunReport)
td' = TDef
  (ProgressReporter
   -> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal = result}
          [[Chunk]] -> R a ()
forall (a :: [*]). [[Chunk]] -> R a ()
outputLinesR ([[Chunk]] -> R a ()) -> [[Chunk]] -> R a ()
forall a b. (a -> b) -> a -> b
$ Settings
-> Int -> Int -> Text -> TDef (Timed TestRunReport) -> [[Chunk]]
outputSpecifyLines Settings
settings Int
eLevel Int
treeWidth Text
t TDef (Timed TestRunReport)
td'
          let r :: Next (TDef (Timed TestRunReport))
r = Settings
-> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))
failFastNext Settings
settings TDef (Timed TestRunReport)
td'
          Next ResultTree -> R a (Next ResultTree)
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> R a (Next ResultTree))
-> Next ResultTree -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ Text -> TDef (Timed TestRunReport) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t (TDef (Timed TestRunReport) -> ResultTree)
-> Next (TDef (Timed TestRunReport)) -> Next ResultTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next (TDef (Timed TestRunReport))
r
        DefPendingNode Text
t Maybe Text
mr -> do
          [[Chunk]] -> R a ()
forall (a :: [*]). [[Chunk]] -> R a ()
outputLinesR ([[Chunk]] -> R a ()) -> [[Chunk]] -> R a ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
          Next ResultTree -> R a (Next ResultTree)
forall a. a -> ReaderT (Env a) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> R a (Next ResultTree))
-> Next ResultTree -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ ResultTree -> Next ResultTree
forall a. a -> Next a
Continue (ResultTree -> Next ResultTree) -> ResultTree -> Next 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 () ()
sdf -> do
          [Chunk] -> R a ()
forall (a :: [*]). [Chunk] -> R a ()
outputLineR ([Chunk] -> R a ()) -> [Chunk] -> R a ()
forall a b. (a -> b) -> a -> b
$ Text -> [Chunk]
outputDescribeLine Text
t
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
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) (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Env a) IO (Next ResultForest)
-> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]) b. R a b -> R a b
addLevel (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf)
        DefSetupNode IO ()
func SpecDefForest a () ()
sdf -> do
          IO () -> R a ()
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
func
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf
        DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
            (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
                    outer
b <- IO outer -> ReaderT (Env a) IO outer
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO outer
func
                    (Env a -> Env (outer : a))
-> ReaderT (Env (outer : a)) IO (Next ResultForest)
-> ReaderT (Env a) IO (Next ResultForest)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
                      (\Env a
e -> Env a
e {eExternalResources = HCons b (eExternalResources e)})
                      (SpecDefForest (outer : a) () ()
-> ReaderT (Env (outer : a)) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (outer : a) () ()
sdf)
                )
        DefBeforeAllWithNode oldOuter -> IO newOuter
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf -> do
          Env (oldOuter : otherOuters)
e <- ReaderT (Env a) IO (Env (oldOuter : otherOuters))
forall r (m :: * -> *). MonadReader r m => m r
ask
          let HCons oldOuter
e
x HList l
_ = Env (oldOuter : otherOuters) -> HList (oldOuter : otherOuters)
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
          IO (Next ResultTree) -> R a (Next ResultTree)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Next ResultTree) -> R a (Next ResultTree))
-> IO (Next ResultTree) -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$
            (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
              (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
                      newOuter
b <- IO newOuter -> IO newOuter
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO newOuter -> IO newOuter) -> IO newOuter -> IO newOuter
forall a b. (a -> b) -> a -> b
$ oldOuter -> IO newOuter
func oldOuter
x
                      ReaderT
  (Env (newOuter : oldOuter : otherOuters)) IO (Next ResultForest)
-> Env (newOuter : oldOuter : otherOuters)
-> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                        (SpecDefForest (newOuter : oldOuter : otherOuters) () ()
-> ReaderT
     (Env (newOuter : oldOuter : otherOuters)) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf)
                        (Env (oldOuter : otherOuters)
e {eExternalResources = HCons b (eExternalResources e)})
                  )
        DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
sdf -> do
          Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
          IO (Next ResultTree) -> R a (Next ResultTree)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Next ResultTree) -> R a (Next ResultTree))
-> IO (Next ResultTree) -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (IO () -> IO ())
-> IO (Next ResultForest) -> IO (Next ResultForest)
forall (m :: * -> *) r. MonadIO m => (m () -> m ()) -> m r -> m r
applySimpleWrapper'' IO () -> IO ()
func (ReaderT (Env a) IO (Next ResultForest)
-> Env a -> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf) Env a
e)
        DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () ()
sdf -> do
          Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
          IO (Next ResultTree) -> R a (Next ResultTree)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Next ResultTree) -> R a (Next ResultTree))
-> IO (Next ResultTree) -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$
            (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
              (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((outer -> IO ()) -> IO ())
-> (outer -> IO (Next ResultForest)) -> IO (Next ResultForest)
forall (m :: * -> *) a r.
MonadIO m =>
((a -> m ()) -> m ()) -> (a -> m r) -> m r
applySimpleWrapper'
                (outer -> IO ()) -> IO ()
func
                ( \outer
b ->
                    ReaderT (Env (outer : a)) IO (Next ResultForest)
-> Env (outer : a) -> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                      (SpecDefForest (outer : a) () ()
-> ReaderT (Env (outer : a)) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (outer : a) () ()
sdf)
                      (Env a
e {eExternalResources = HCons b (eExternalResources e)})
                )
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf -> do
          Env (oldOuter : otherOuters)
e <- ReaderT (Env a) IO (Env (oldOuter : otherOuters))
forall r (m :: * -> *). MonadReader r m => m r
ask
          let HCons oldOuter
e
x HList l
_ = Env (oldOuter : otherOuters) -> HList (oldOuter : otherOuters)
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
          IO (Next ResultTree) -> R a (Next ResultTree)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Next ResultTree) -> R a (Next ResultTree))
-> IO (Next ResultTree) -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$
            (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
              (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((newOuter -> IO ()) -> oldOuter -> IO ())
-> (newOuter -> IO (Next ResultForest))
-> oldOuter
-> IO (Next ResultForest)
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 ->
                    ReaderT
  (Env (newOuter : oldOuter : otherOuters)) IO (Next ResultForest)
-> Env (newOuter : oldOuter : otherOuters)
-> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                      (SpecDefForest (newOuter : oldOuter : otherOuters) () ()
-> ReaderT
     (Env (newOuter : oldOuter : otherOuters)) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf)
                      (Env (oldOuter : otherOuters)
e {eExternalResources = HCons b (eExternalResources e)})
                )
                oldOuter
x
        DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
sdf -> do
          Env a
e <- ReaderT (Env a) IO (Env a)
forall r (m :: * -> *). MonadReader r m => m r
ask
          let externalResources :: HList a
externalResources = Env a -> HList a
forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env a
e
          IO (Next ResultTree) -> R a (Next ResultTree)
forall a. IO a -> ReaderT (Env a) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Next ResultTree) -> R a (Next ResultTree))
-> IO (Next ResultTree) -> R a (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReaderT (Env a) IO (Next ResultForest)
-> Env a -> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf) Env a
e IO (Next ResultForest) -> IO () -> IO (Next ResultForest)
forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
externalResources)
        DefParallelismNode Parallelism
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf -- Ignore, it's synchronous anyway
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf -- Ignore, randomisation has already happened.
        DefRetriesNode Word -> Word
modRetries SpecDefForest a () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
            (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env a -> Env a)
-> ReaderT (Env a) IO (Next ResultForest)
-> ReaderT (Env a) IO (Next ResultForest)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eRetries = modRetries (eRetries e)})
              (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf)
        DefFlakinessNode FlakinessMode
fm SpecDefForest a () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
            (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env a -> Env a)
-> ReaderT (Env a) IO (Next ResultForest)
-> ReaderT (Env a) IO (Next ResultForest)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eFlakinessMode = fm})
              (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf)
        DefExpectationNode ExpectationMode
em SpecDefForest a () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall a b. (a -> b) -> Next a -> Next b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ResultForest -> ResultTree
forall a. SpecForest a -> SpecTree a
SubForestNode
            (Next ResultForest -> Next ResultTree)
-> ReaderT (Env a) IO (Next ResultForest) -> R a (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Env a -> Env a)
-> ReaderT (Env a) IO (Next ResultForest)
-> ReaderT (Env a) IO (Next ResultForest)
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
              (\Env a
e -> Env a
e {eExpectationMode = em})
              (SpecDefForest a () () -> ReaderT (Env a) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
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 <-
    Int -> IO ResultForest -> IO (Timed ResultForest)
forall (m :: * -> *) a. MonadIO m => Int -> m a -> m (Timed a)
timeItT Int
0 (IO ResultForest -> IO (Timed ResultForest))
-> IO ResultForest -> IO (Timed ResultForest)
forall a b. (a -> b) -> a -> b
$
      Next ResultForest -> ResultForest
forall a. Next a -> a
extractNext
        (Next ResultForest -> ResultForest)
-> IO (Next ResultForest) -> IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT (Env '[]) IO (Next ResultForest)
-> Env '[] -> IO (Next ResultForest)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
          (TestForest '[] () -> ReaderT (Env '[]) IO (Next ResultForest)
forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest TestForest '[] ()
testForest)
          Env
            { eLevel :: Int
eLevel = Int
0,
              eRetries :: Word
eRetries = Settings -> Word
settingRetries Settings
settings,
              eFlakinessMode :: FlakinessMode
eFlakinessMode = FlakinessMode
MayNotBeFlaky,
              eExpectationMode :: ExpectationMode
eExpectationMode = ExpectationMode
ExpectPassing,
              eExternalResources :: HList '[]
eExternalResources = HList '[]
HNil
            }

  [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
$ Settings -> ResultForest -> [[Chunk]]
outputFailuresWithHeading Settings
settings (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 (Settings -> ResultForest -> TestSuiteStats
computeTestSuiteStats Settings
settings (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
" "]

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Settings -> Bool
settingProfile Settings
settings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine (Timed ResultForest -> [[Chunk]]
outputProfilingInfo Timed ResultForest
resultForest)
    [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]

  Timed ResultForest -> IO (Timed ResultForest)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Timed ResultForest
resultForest

addLevel :: R a b -> R a b
addLevel :: forall (a :: [*]) b. R a b -> R a b
addLevel = (Env a -> Env a) -> ReaderT (Env a) IO b -> ReaderT (Env a) IO b
forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT (\Env a
e -> Env a
e {eLevel = succ (eLevel e)})

type R a = ReaderT (Env a) IO

-- Not exported, on purpose.
data Env externalResources = Env
  { forall (externalResources :: [*]). Env externalResources -> Int
eLevel :: Int,
    forall (externalResources :: [*]). Env externalResources -> Word
eRetries :: !Word,
    forall (externalResources :: [*]).
Env externalResources -> FlakinessMode
eFlakinessMode :: !FlakinessMode,
    forall (externalResources :: [*]).
Env externalResources -> ExpectationMode
eExpectationMode :: !ExpectationMode,
    forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources :: !(HList externalResources)
  }