{-# 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.ByteString.Char8 as SB8
import qualified Data.Text as T
import Test.Syd.HList
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 :: Bool -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously :: Bool -> TestForest '[] () -> IO ResultForest
runSpecForestSynchronously Bool
failFast = (Next ResultForest -> ResultForest)
-> IO (Next ResultForest) -> IO ResultForest
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Next ResultForest -> ResultForest
forall a. Next a -> a
extractNext (IO (Next ResultForest) -> IO ResultForest)
-> (TestForest '[] () -> IO (Next ResultForest))
-> TestForest '[] ()
-> IO ResultForest
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HList '[] -> TestForest '[] () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList '[]
HNil
  where
    goForest :: HList a -> TestForest a () -> IO (Next ResultForest)
    goForest :: HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
_ [] = Next ResultForest -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultForest -> Next ResultForest
forall a. a -> Next a
Continue [])
    goForest HList a
l (SpecDefTree a () ()
tt : TestForest a ()
rest) = do
      Next ResultTree
nrt <- HList a -> SpecDefTree a () () -> IO (Next ResultTree)
forall (a :: [*]). HList a -> TestTree a () -> IO (Next ResultTree)
goTree HList a
l SpecDefTree a () ()
tt
      case Next ResultTree
nrt of
        Continue ResultTree
rt -> do
          Next ResultForest
nf <- HList a -> TestForest a () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l TestForest a ()
rest
          Next ResultForest -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> IO (Next ResultForest))
-> Next ResultForest -> 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 -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> IO (Next ResultForest))
-> Next ResultForest -> IO (Next ResultForest)
forall a b. (a -> b) -> a -> b
$ ResultForest -> Next ResultForest
forall a. a -> Next a
Stop [ResultTree
rt]
    goTree :: forall a. HList a -> TestTree a () -> IO (Next ResultTree)
    goTree :: HList a -> TestTree a () -> IO (Next ResultTree)
goTree HList a
l = \case
      DefSpecifyNode Text
t TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td () -> do
        let runFunc :: IO TestRunResult
runFunc = TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult
forall value. TDef value -> value
testDefVal TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td (\HList a -> () -> IO ()
f -> HList a -> () -> IO ()
f HList a
l ())
        Timed TestRunResult
result <- IO TestRunResult -> IO (Timed TestRunResult)
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT IO TestRunResult
runFunc
        let td' :: TDef (Timed TestRunResult)
td' = TDef (((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 Bool
failFast TDef (Timed TestRunResult)
td'
        Next ResultTree -> IO (Next ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> IO (Next ResultTree))
-> Next ResultTree -> IO (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ Text -> TDef (Timed TestRunResult) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t (TDef (Timed TestRunResult) -> ResultTree)
-> Next (TDef (Timed TestRunResult)) -> Next ResultTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next (TDef (Timed TestRunResult))
r
      DefPendingNode Text
t Maybe Text
mr -> Next ResultTree -> IO (Next ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> IO (Next ResultTree))
-> Next ResultTree -> IO (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 -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ResultForest -> ResultTree
forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l SpecDefForest a () ()
sdf
      DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 (HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l SpecDefForest a () ()
sdf)
      DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () ()
sdf -> do
        (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
                  outer
b <- IO outer
func
                  HList (outer : a)
-> SpecDefForest (outer : a) () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
l) SpecDefForest (outer : a) () ()
sdf
              )
      DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () ()
sdf ->
        (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 -> HList (outer : a)
-> SpecDefForest (outer : a) () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
l) SpecDefForest (outer : a) () ()
sdf)
      DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf ->
        let HCons e
x HList l
_ = HList a
l
         in (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 -> HList (newOuter : a)
-> TestForest (newOuter : a) () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest (newOuter -> HList a -> HList (newOuter : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
l) TestForest (newOuter : a) ()
SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf) oldOuter
x
      DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> (HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l SpecDefForest a () ()
sdf IO (Next ResultForest) -> IO () -> IO (Next ResultForest)
forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
l)
      DefParallelismNode Parallelism
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l SpecDefForest a () ()
sdf -- Ignore, it's synchronous anyway
      DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
HList a -> TestForest a () -> IO (Next ResultForest)
goForest HList a
l SpecDefForest a () ()
sdf

runSpecForestInterleavedWithOutputSynchronously :: TerminalCapabilities -> Bool -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputSynchronously :: TerminalCapabilities
-> Bool -> TestForest '[] () -> IO (Timed ResultForest)
runSpecForestInterleavedWithOutputSynchronously TerminalCapabilities
tc Bool
failFast TestForest '[] ()
testForest = do
  let outputLine :: [Chunk] -> IO ()
      outputLine :: [Chunk] -> IO ()
outputLine [Chunk]
lineChunks = IO () -> IO ()
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 ()
putChunksWith TerminalCapabilities
tc [Chunk]
lineChunks
        ByteString -> IO ()
SB8.putStrLn ByteString
""
      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]
:)
      goForest :: Int -> HList a -> TestForest a () -> IO (Next ResultForest)
      goForest :: Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
_ HList a
_ [] = Next ResultForest -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ResultForest -> Next ResultForest
forall a. a -> Next a
Continue [])
      goForest Int
level HList a
l (SpecDefTree a () ()
tt : TestForest a ()
rest) = do
        Next ResultTree
nrt <- Int -> HList a -> SpecDefTree a () () -> IO (Next ResultTree)
forall (a :: [*]).
Int -> HList a -> TestTree a () -> IO (Next ResultTree)
goTree Int
level HList a
l SpecDefTree a () ()
tt
        case Next ResultTree
nrt of
          Continue ResultTree
rt -> do
            Next ResultForest
nf <- Int -> HList a -> TestForest a () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level HList a
l TestForest a ()
rest
            Next ResultForest -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> IO (Next ResultForest))
-> Next ResultForest -> 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 -> IO (Next ResultForest)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultForest -> IO (Next ResultForest))
-> Next ResultForest -> IO (Next ResultForest)
forall a b. (a -> b) -> a -> b
$ ResultForest -> Next ResultForest
forall a. a -> Next a
Stop [ResultTree
rt]
      goTree :: Int -> HList a -> TestTree a () -> IO (Next ResultTree)
      goTree :: Int -> HList a -> TestTree a () -> IO (Next ResultTree)
goTree Int
level HList a
a = \case
        DefSpecifyNode Text
t TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td () -> do
          let runFunc :: IO TestRunResult
runFunc = TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
-> ((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult
forall value. TDef value -> value
testDefVal TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td (\HList a -> () -> IO ()
f -> HList a -> () -> IO ()
f HList a
a ())
          Timed TestRunResult
result <- IO TestRunResult -> IO (Timed TestRunResult)
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT IO TestRunResult
runFunc
          let td' :: TDef (Timed TestRunResult)
td' = TDef (((HList a -> () -> IO ()) -> IO ()) -> IO TestRunResult)
td {testDefVal :: Timed TestRunResult
testDefVal = Timed TestRunResult
result}
          ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> ([Chunk] -> [Chunk]) -> [Chunk] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Text -> TDef (Timed TestRunResult) -> [[Chunk]]
outputSpecifyLines Int
level Int
treeWidth Text
t TDef (Timed TestRunResult)
td'
          let r :: Next (TDef (Timed TestRunResult))
r = Bool
-> TDef (Timed TestRunResult) -> Next (TDef (Timed TestRunResult))
failFastNext Bool
failFast TDef (Timed TestRunResult)
td'
          Next ResultTree -> IO (Next ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> IO (Next ResultTree))
-> Next ResultTree -> IO (Next ResultTree)
forall a b. (a -> b) -> a -> b
$ Text -> TDef (Timed TestRunResult) -> ResultTree
forall a. Text -> a -> SpecTree a
SpecifyNode Text
t (TDef (Timed TestRunResult) -> ResultTree)
-> Next (TDef (Timed TestRunResult)) -> Next ResultTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Next (TDef (Timed TestRunResult))
r
        DefPendingNode Text
t Maybe Text
mr -> do
          ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ([Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> ([Chunk] -> [Chunk]) -> [Chunk] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> [Chunk] -> [Chunk]
pad Int
level) ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text -> [[Chunk]]
outputPendingLines Text
t Maybe Text
mr
          Next ResultTree -> IO (Next ResultTree)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Next ResultTree -> IO (Next ResultTree))
-> Next ResultTree -> IO (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 () ()
sf -> do
          [Chunk] -> IO ()
outputLine ([Chunk] -> IO ()) -> [Chunk] -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> [Chunk] -> [Chunk]
pad Int
level ([Chunk] -> [Chunk]) -> [Chunk] -> [Chunk]
forall a b. (a -> b) -> a -> b
$ Text -> [Chunk]
outputDescribeLine Text
t
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> ResultForest -> ResultTree
forall a. Text -> SpecForest a -> SpecTree a
DescribeNode Text
t) (Next ResultForest -> Next ResultTree)
-> IO (Next ResultForest) -> IO (Next ResultTree)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest (Int -> Int
forall a. Enum a => a -> a
succ Int
level) HList a
a SpecDefForest a () ()
sf
        DefWrapNode IO () -> IO ()
func SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 (Int -> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level HList a
a SpecDefForest a () ()
sdf)
        DefBeforeAllNode IO outer
func SpecDefForest (outer : a) () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
                    outer
b <- IO outer
func
                    Int
-> HList (outer : a)
-> SpecDefForest (outer : a) () ()
-> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
a) SpecDefForest (outer : a) () ()
sdf
                )
        DefAroundAllNode (outer -> IO ()) -> IO ()
func SpecDefForest (outer : a) () ()
sdf ->
          (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 -> Int
-> HList (outer : a)
-> SpecDefForest (outer : a) () ()
-> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level (outer -> HList a -> HList (outer : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons outer
b HList a
a) SpecDefForest (outer : a) () ()
sdf)
        DefAroundAllWithNode (newOuter -> IO ()) -> oldOuter -> IO ()
func SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf ->
          let HCons e
x HList l
_ = HList a
a
           in (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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 -> Int
-> HList (newOuter : a)
-> TestForest (newOuter : a) ()
-> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level (newOuter -> HList a -> HList (newOuter : a)
forall e (l :: [*]). e -> HList l -> HList (e : l)
HCons newOuter
b HList a
a) TestForest (newOuter : a) ()
SpecDefForest (newOuter : oldOuter : otherOuters) () ()
sdf) oldOuter
x
        DefAfterAllNode HList a -> IO ()
func SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> (Int -> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level HList a
a SpecDefForest a () ()
sdf IO (Next ResultForest) -> IO () -> IO (Next ResultForest)
forall a b. IO a -> IO b -> IO a
`finally` HList a -> IO ()
func HList a
a)
        DefParallelismNode Parallelism
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> Int -> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level HList a
a SpecDefForest a () ()
sdf -- Ignore, it's synchronous anyway
        DefRandomisationNode ExecutionOrderRandomisation
_ SpecDefForest a () ()
sdf -> (ResultForest -> ResultTree)
-> Next ResultForest -> Next ResultTree
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
<$> Int -> HList a -> SpecDefForest a () () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
level HList a
a 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 <- IO ResultForest -> IO (Timed ResultForest)
forall (m :: * -> *) a. MonadIO m => m a -> m (Timed a)
timeItT (IO ResultForest -> IO (Timed ResultForest))
-> IO ResultForest -> IO (Timed ResultForest)
forall a b. (a -> b) -> a -> b
$ 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
<$> Int -> HList '[] -> TestForest '[] () -> IO (Next ResultForest)
forall (a :: [*]).
Int -> HList a -> TestForest a () -> IO (Next ResultForest)
goForest Int
0 HList '[]
HNil TestForest '[] ()
testForest
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
  ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ ResultForest -> [[Chunk]]
outputFailuresWithHeading (Timed ResultForest -> ResultForest
forall a. Timed a -> a
timedValue Timed ResultForest
resultForest)
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]
  ([Chunk] -> IO ()) -> [[Chunk]] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Chunk] -> IO ()
outputLine ([[Chunk]] -> IO ()) -> [[Chunk]] -> IO ()
forall a b. (a -> b) -> a -> b
$ Timed TestSuiteStats -> [[Chunk]]
outputStats (ResultForest -> TestSuiteStats
computeTestSuiteStats (ResultForest -> TestSuiteStats)
-> Timed ResultForest -> Timed TestSuiteStats
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Timed ResultForest
resultForest)
  [Chunk] -> IO ()
outputLine [Text -> Chunk
chunk Text
" "]

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