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

module Test.Syd.Runner.Synchronous.Separate (runSpecForestSynchronously) where

import Control.Exception
import Control.Monad.Reader
import Test.Syd.HList
import Test.Syd.OptParse
import Test.Syd.Run
import Test.Syd.Runner.Single
import Test.Syd.Runner.Wrappers
import Test.Syd.SpecDef
import Test.Syd.SpecForest

runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously :: Settings -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously Settings
settings TestForest '[] ()
testForest =
  forall a. Next a -> a
extractNext
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
      (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest TestForest '[] ()
testForest)
      Env
        { eRetries :: Word
eRetries = Settings -> Word
settingRetries Settings
settings,
          eFlakinessMode :: FlakinessMode
eFlakinessMode = FlakinessMode
MayNotBeFlaky,
          eExpectationMode :: ExpectationMode
eExpectationMode = ExpectationMode
ExpectPassing,
          eExternalResources :: HList '[]
eExternalResources = HList '[]
HNil
        }
  where
    goForest :: forall a. TestForest a () -> R a (Next ResultForest)
    goForest :: forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a. a -> Next a
Continue [])
    goForest (SpecDefTree a () ()
tt : [SpecDefTree a () ()]
rest) = do
      Next ResultTree
nrt <- forall (a :: [*]). TestTree a () -> R a (Next ResultTree)
goTree SpecDefTree a () ()
tt
      case Next ResultTree
nrt of
        Continue ResultTree
rt -> do
          Next ResultForest
nf <- forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest [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. 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 {Word
HList a
ExpectationMode
FlakinessMode
eExternalResources :: HList a
eExpectationMode :: ExpectationMode
eFlakinessMode :: FlakinessMode
eRetries :: Word
eExternalResources :: forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExpectationMode :: forall (externalResources :: [*]).
Env externalResources -> ExpectationMode
eFlakinessMode :: forall (externalResources :: [*]).
Env externalResources -> FlakinessMode
eRetries :: forall (externalResources :: [*]). Env externalResources -> Word
..} <- forall r (m :: * -> *). MonadReader r m => m r
ask
        Timed TestRunReport
result <-
          forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
            forall (m :: * -> *) a. MonadIO m => Int -> m a -> m (Timed a)
timeItT Int
0 forall a b. (a -> b) -> a -> b
$
              forall (externalResources :: [*]) t.
ProgressReporter
-> HList externalResources
-> TDef
     (ProgressReporter
      -> ((HList externalResources -> () -> t) -> t) -> IO TestRunResult)
-> Word
-> FlakinessMode
-> ExpectationMode
-> IO TestRunReport
runSingleTestWithFlakinessMode
                ProgressReporter
noProgressReporter
                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 :: Timed TestRunReport
testDefVal = Timed TestRunReport
result}
        let r :: Next (TDef (Timed TestRunReport))
r = Settings
-> TDef (Timed TestRunReport) -> Next (TDef (Timed TestRunReport))
failFastNext Settings
settings TDef (Timed TestRunReport)
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 TestRunReport))
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 :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf
      DefSetupNode IO ()
func SpecDefForest a () ()
sdf -> do
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ()
func
        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 :: [*]). TestForest a () -> R a (Next ResultForest)
goForest 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 <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO outer
func
                  forall r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
                    (\Env a
e -> Env a
e {eExternalResources :: HList (outer : a)
eExternalResources = forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b (forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env a
e)})
                    (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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let HCons oldOuter
e
x HList l
_ = forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
          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
                    newOuter
b <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (oldOuter -> IO newOuter
func oldOuter
x)
                    forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                      (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf)
                      (Env (oldOuter : otherOuters)
e {eExternalResources :: HList (newOuter : oldOuter : otherOuters)
eExternalResources = forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b (forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e)})
                )
      DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
sdf -> do
        Env a
e <- forall r (m :: * -> *). MonadReader r m => m r
ask
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (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 <- forall r (m :: * -> *). MonadReader r m => m r
ask
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
          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 r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                    (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (outer : a) () ()
sdf)
                    (Env a
e {eExternalResources :: HList (outer : a)
eExternalResources = forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b (forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env a
e)})
              )
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf -> do
        Env (oldOuter : otherOuters)
e <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let HCons oldOuter
e
x HList l
_ = forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
          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 r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT
                    (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf)
                    (Env (oldOuter : otherOuters)
e {eExternalResources :: HList (newOuter : oldOuter : otherOuters)
eExternalResources = forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b (forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env (oldOuter : otherOuters)
e)})
              )
              oldOuter
x
      DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
sdf -> do
        Env a
e <- forall r (m :: * -> *). MonadReader r m => m r
ask
        let externalResources :: HList a
externalResources = forall (externalResources :: [*]).
Env externalResources -> HList externalResources
eExternalResources Env a
e
        forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ 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 r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf) Env a
e forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
externalResources)
      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 :: [*]). TestForest a () -> R a (Next ResultForest)
goForest 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 :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf -- Ignore, randomisation has already happened.
      DefRetriesNode Word -> Word
modRetries 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 r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
            (\Env a
e -> Env a
e {eRetries :: Word
eRetries = Word -> Word
modRetries (forall (externalResources :: [*]). Env externalResources -> Word
eRetries Env a
e)})
            (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest 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 r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
            (\Env a
e -> Env a
e {eFlakinessMode :: FlakinessMode
eFlakinessMode = FlakinessMode
fm})
            (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf)
      DefExpectationNode ExpectationMode
em 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 r' r (m :: * -> *) a.
(r' -> r) -> ReaderT r m a -> ReaderT r' m a
withReaderT
            (\Env a
e -> Env a
e {eExpectationMode :: ExpectationMode
eExpectationMode = ExpectationMode
em})
            (forall (a :: [*]). TestForest a () -> R a (Next ResultForest)
goForest SpecDefForest a () ()
sdf)

type R a = ReaderT (Env a) IO

-- Not exported, on purpose.
data Env externalResources = Env
  { 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)
  }