{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeApplications #-}

module Test.Sandwich (
  -- | Sandwich is a test framework for Haskell. See the <https://codedownio.github.io/sandwich/docs/ documentation> for details and usage examples.

  -- * Running tests with command line args
  --
  -- | These functions will read command line arguments when setting up your tests.
  -- These flags allow you filter the test tree, configure formatters, and pass your own custom options.
  --
  -- @
  -- # Run using the terminal UI formatter, webdriver headless mode, filtering to nodes matching \"Login\"
  -- stack run my-tests -- --tui --headless -f Login
  -- @
  --
  runSandwichWithCommandLineArgs
  , runSandwichWithCommandLineArgs'
  , parseCommandLineArgs

  -- * Running tests
  , runSandwich
  , runSandwich'

  -- * Basic nodes
  --
  -- | The basic building blocks of tests.
  , it
  , describe
  , parallel

  -- * Context manager nodes
  --
  -- | For introducing new contexts into tests and doing setup/teardown.
  , introduce
  , introduceWith
  , before
  , beforeEach
  , after
  , afterEach
  , around
  , aroundEach

  -- * Timing
  --
  -- | For timing actions within your tests. Test tree nodes are timed by default.
  , timeActionByProfile
  , timeAction
  , withTimingProfile
  , withTimingProfile'

  -- * Exports
  , module Test.Sandwich.Contexts
  , module Test.Sandwich.Expectations
  , module Test.Sandwich.Logging
  , module Test.Sandwich.Misc
  , module Test.Sandwich.Nodes
  , module Test.Sandwich.Options
  , module Test.Sandwich.ParallelN
  , module Test.Sandwich.TH
  ) where

import Control.Concurrent.Async
import Control.Concurrent.STM
import qualified Control.Exception as E
import Control.Exception.Safe
import Control.Monad
import Control.Monad.Free
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Either
import Data.Function
import Data.IORef
import qualified Data.List as L
import Data.Maybe
import Data.String.Interpolate
import qualified Data.Text as T
import Options.Applicative
import qualified Options.Applicative as OA
import System.Environment
import System.FilePath
import Test.Sandwich.ArgParsing
import Test.Sandwich.Contexts
import Test.Sandwich.Expectations
import Test.Sandwich.Formatters.Common.Count
import Test.Sandwich.Golden.Update
import Test.Sandwich.Internal.Running
import Test.Sandwich.Interpreters.FilterTreeModule
import Test.Sandwich.Interpreters.RunTree
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.Logging
import Test.Sandwich.Misc
import Test.Sandwich.Nodes
import Test.Sandwich.Options
import Test.Sandwich.ParallelN
import Test.Sandwich.RunTree
import Test.Sandwich.Shutdown
import Test.Sandwich.Signals
import Test.Sandwich.TH
import Test.Sandwich.TestTimer
import Test.Sandwich.Types.ArgParsing
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Test.Sandwich.Types.TestTimer


-- | Run the spec with the given 'Options'.
runSandwich :: Options -> CoreSpec -> IO ()
runSandwich :: Options -> CoreSpec -> IO ()
runSandwich Options
options CoreSpec
spec = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Maybe (CommandLineOptions ())
-> Options -> CoreSpec -> IO (ExitReason, Int)
runSandwich' forall a. Maybe a
Nothing Options
options CoreSpec
spec

-- | Run the spec, configuring the options from the command line.
runSandwichWithCommandLineArgs :: Options -> TopSpecWithOptions -> IO ()
runSandwichWithCommandLineArgs :: Options -> TopSpecWithOptions -> IO ()
runSandwichWithCommandLineArgs Options
baseOptions = forall a.
Typeable a =>
Options -> Parser a -> TopSpecWithOptions' a -> IO ()
runSandwichWithCommandLineArgs' Options
baseOptions (forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | Run the spec, configuring the options from the command line and adding user-configured command line options.
-- The options will become available as a test context, which you can access by calling 'getCommandLineOptions'.
runSandwichWithCommandLineArgs' :: forall a. (Typeable a) => Options -> Parser a -> TopSpecWithOptions' a -> IO ()
runSandwichWithCommandLineArgs' :: forall a.
Typeable a =>
Options -> Parser a -> TopSpecWithOptions' a -> IO ()
runSandwichWithCommandLineArgs' Options
baseOptions Parser a
userOptionsParser TopSpecWithOptions' a
spec = do
  (CommandLineOptions a
clo, Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
individualTestParser, [(NodeModuleInfo, Text)]
modulesAndShorthands) <- forall a.
Typeable a =>
Parser a
-> TopSpecWithOptions' a
-> IO
     (CommandLineOptions a,
      Mod FlagFields (Maybe IndividualTestModule)
      -> Parser (Maybe IndividualTestModule),
      [(NodeModuleInfo, Text)])
parseCommandLineArgs' Parser a
userOptionsParser TopSpecWithOptions' a
spec
  (Options
options, Int
repeatCount) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Options -> CommandLineOptions a -> IO (Options, Int)
addOptionsFromArgs Options
baseOptions CommandLineOptions a
clo

  if | forall a. CommandLineOptions a -> Maybe Bool
optPrintGoldenFlags CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser ParserInfo CommandLineGoldenOptions
goldenOptionsWithInfo
     | forall a. CommandLineOptions a -> Maybe Bool
optPrintHedgehogFlags CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser ParserInfo CommandLineHedgehogOptions
hedgehogOptionsWithInfo
     | forall a. CommandLineOptions a -> Maybe Bool
optPrintQuickCheckFlags CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser ParserInfo CommandLineQuickCheckOptions
quickCheckOptionsWithInfo
     | forall a. CommandLineOptions a -> Maybe Bool
optPrintSlackFlags CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser ParserInfo CommandLineSlackOptions
slackOptionsWithInfo
     | forall a. CommandLineOptions a -> Maybe Bool
optPrintWebDriverFlags CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser ParserInfo CommandLineWebdriverOptions
webDriverOptionsWithInfo
     | forall a. CommandLineOptions a -> Maybe Bool
optListAvailableTests CommandLineOptions a
clo forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall a. [String] -> IO a -> IO a
withArgs [String
"--help"] forall a b. (a -> b) -> a -> b
$
           forall a. ParserInfo a -> IO a
OA.execParser forall a b. (a -> b) -> a -> b
$ forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (Mod FlagFields (Maybe IndividualTestModule)
-> Parser (Maybe IndividualTestModule)
individualTestParser forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> forall a. Parser (a -> a)
helper) forall a b. (a -> b) -> a -> b
$
             forall a. InfoMod a
fullDesc forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
header String
"Pass one of these flags to run an individual test module."
                      forall a. Semigroup a => a -> a -> a
<> forall a. String -> InfoMod a
progDesc String
"If a module has a \"*\" next to its name, then we detected that it has its own main function. If you pass the option name suffixed by -main then we'll just directly invoke the main function."
     | CommandLineGoldenOptions -> Maybe Bool
optUpdateGolden (forall a. CommandLineOptions a -> CommandLineGoldenOptions
optGoldenOptions CommandLineOptions a
clo) forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just Bool
True -> do
         Maybe String -> IO ()
updateGolden (CommandLineGoldenOptions -> Maybe String
optGoldenDir (forall a. CommandLineOptions a -> CommandLineGoldenOptions
optGoldenOptions CommandLineOptions a
clo))
     | Bool
otherwise -> do
         -- Awkward, but we need a specific context type to call countItNodes
         let totalTests :: Int
totalTests = forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes (TopSpecWithOptions' a
spec :: SpecFree (LabelValue "commandLineOptions" (CommandLineOptions a) :> BaseContext) IO ())

         Int -> Int -> IO (ExitReason, Int) -> IO ()
runWithRepeat Int
repeatCount Int
totalTests forall a b. (a -> b) -> a -> b
$
           case forall a. CommandLineOptions a -> Maybe IndividualTestModule
optIndividualTestModule CommandLineOptions a
clo of
             Maybe IndividualTestModule
Nothing -> Maybe (CommandLineOptions ())
-> Options -> CoreSpec -> IO (ExitReason, Int)
runSandwich' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandLineOptions a
clo { optUserOptions :: ()
optUserOptions = () }) Options
options forall a b. (a -> b) -> a -> b
$
               forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold :: Int
nodeOptionsVisibilityThreshold = Int
systemVisibilityThreshold }) String
"command line options" forall {a}. Label "commandLineOptions" (CommandLineOptions a)
commandLineOptions (forall (f :: * -> *) a. Applicative f => a -> f a
pure CommandLineOptions a
clo) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) TopSpecWithOptions' a
spec
             Just (IndividualTestModuleName String
x) -> Maybe (CommandLineOptions ())
-> Options -> CoreSpec -> IO (ExitReason, Int)
runSandwich' (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CommandLineOptions a
clo { optUserOptions :: ()
optUserOptions = () }) Options
options forall a b. (a -> b) -> a -> b
$ forall context (m :: * -> *).
String
-> Free (SpecCommand context m) ()
-> Free (SpecCommand context m) ()
filterTreeToModule String
x forall a b. (a -> b) -> a -> b
$
               forall intro (l :: Symbol) context (m :: * -> *).
(HasCallStack, Typeable intro) =>
NodeOptions
-> String
-> Label l intro
-> ExampleT context m intro
-> (intro -> ExampleT context m ())
-> SpecFree (LabelValue l intro :> context) m ()
-> SpecFree context m ()
introduce' (NodeOptions
defaultNodeOptions { nodeOptionsVisibilityThreshold :: Int
nodeOptionsVisibilityThreshold = Int
systemVisibilityThreshold }) String
"command line options" forall {a}. Label "commandLineOptions" (CommandLineOptions a)
commandLineOptions (forall (f :: * -> *) a. Applicative f => a -> f a
pure CommandLineOptions a
clo) (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ()) TopSpecWithOptions' a
spec
             Just (IndividualTestMainFn IO ()
x) -> do
               let individualTestFlagStrings :: [Text]
individualTestFlagStrings = [[ forall a. a -> Maybe a
Just (Text
"--" forall a. Semigroup a => a -> a -> a
<> Text
shorthand), forall a b. a -> b -> a
const (Text
"--" forall a. Semigroup a => a -> a -> a
<> Text
shorthand forall a. Semigroup a => a -> a -> a
<> Text
"-main") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (IO ())
nodeModuleInfoFn ]
                                               | (NodeModuleInfo {String
Maybe (IO ())
nodeModuleInfoFn :: NodeModuleInfo -> Maybe (IO ())
nodeModuleInfoModuleName :: NodeModuleInfo -> String
nodeModuleInfoModuleName :: String
nodeModuleInfoFn :: Maybe (IO ())
..}, Text
shorthand) <- [(NodeModuleInfo, Text)]
modulesAndShorthands]
                                             forall a b. a -> (a -> b) -> b
& forall a. Monoid a => [a] -> a
mconcat
                                             forall a b. a -> (a -> b) -> b
& forall a. [Maybe a] -> [a]
catMaybes
               [String]
baseArgs <- IO [String]
getArgs
               forall a. [String] -> IO a -> IO a
withArgs ([String]
baseArgs forall a. Eq a => [a] -> [a] -> [a]
L.\\ (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> String
T.unpack [Text]
individualTestFlagStrings)) forall a b. (a -> b) -> a -> b
$
                 forall (m :: * -> *) a.
MonadCatch m =>
m a -> m (Either SomeException a)
tryAny IO ()
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                   Left SomeException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ExitReason
NormalExit, Int
1)
                   Right ()
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (ExitReason
NormalExit, Int
0)

-- | Run the spec with optional custom 'CommandLineOptions'. When finished, return the exit reason and number of failures.
runSandwich' :: Maybe (CommandLineOptions ()) -> Options -> CoreSpec -> IO (ExitReason, Int)
runSandwich' :: Maybe (CommandLineOptions ())
-> Options -> CoreSpec -> IO (ExitReason, Int)
runSandwich' Maybe (CommandLineOptions ())
maybeCommandLineOptions Options
options CoreSpec
spec' = do
  BaseContext
baseContext <- Options -> IO BaseContext
baseContextFromOptions Options
options

  -- Wrap the spec in a finalizer for the test timer, when one is present
  let spec :: CoreSpec
spec = case BaseContext -> TestTimer
baseContextTestTimer BaseContext
baseContext of
        TestTimer
NullTestTimer -> CoreSpec
spec'
        TestTimer
_ -> forall context (m :: * -> *).
HasCallStack =>
NodeOptions
-> String
-> ExampleT context m ()
-> SpecFree context m ()
-> SpecFree context m ()
after' (NodeOptions
defaultNodeOptions { nodeOptionsRecordTime :: Bool
nodeOptionsRecordTime = Bool
False
                                        , nodeOptionsVisibilityThreshold :: Int
nodeOptionsVisibilityThreshold = Int
systemVisibilityThreshold
                                        , nodeOptionsCreateFolder :: Bool
nodeOptionsCreateFolder = Bool
False }) String
"Finalize test timer" (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall context. HasTestTimer context => context -> TestTimer
getTestTimer forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestTimer -> IO ()
finalizeSpeedScopeTestTimer) CoreSpec
spec'

  [RunNode BaseContext]
rts <- BaseContext -> Options -> CoreSpec -> IO [RunNode BaseContext]
startSandwichTree' BaseContext
baseContext Options
options CoreSpec
spec

  [Async ()]
formatterAsyncs <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Options -> [SomeFormatter]
optionsFormatters Options
options) forall a b. (a -> b) -> a -> b
$ \(SomeFormatter f
f) -> forall a. IO a -> IO (Async a)
async forall a b. (a -> b) -> a -> b
$ do
    let loggingFn :: LoggingT IO a -> IO a
loggingFn = case BaseContext -> Maybe String
baseContextRunRoot BaseContext
baseContext of
          Maybe String
Nothing -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (\Loc
_ Text
_ LogLevel
_ LogStr
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
          Just String
rootPath -> forall (m :: * -> *) a.
MonadBaseControl IO m =>
String -> LoggingT m a -> m a
runFileLoggingT (String
rootPath String -> String -> String
</> (forall f. Formatter f => f -> String
formatterName f
f) String -> String -> String
<.> String
"log")

    forall {a}. LoggingT IO a -> IO a
loggingFn forall a b. (a -> b) -> a -> b
$
      forall f (m :: * -> *).
(Formatter f, MonadLoggerIO m, MonadUnliftIO m, MonadCatch m) =>
f
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter f
f [RunNode BaseContext]
rts Maybe (CommandLineOptions ())
maybeCommandLineOptions BaseContext
baseContext

  IORef ExitReason
exitReasonRef <- forall a. a -> IO (IORef a)
newIORef ExitReason
NormalExit

  let shutdown :: Signal -> IO ()
shutdown Signal
sig = do
        let Text
signalName :: T.Text =
              if | Signal
sig forall a. Eq a => a -> a -> Bool
== Signal
sigINT -> Text
"sigINT"
                 | Signal
sig forall a. Eq a => a -> a -> Bool
== Signal
sigTERM -> Text
"sigTERM"
                 | Bool
otherwise -> [i|signal #{sig}|]
        String -> IO ()
putStrLn [i|Shutting down due to #{signalName}...|]
        forall a. IORef a -> a -> IO ()
writeIORef IORef ExitReason
exitReasonRef ExitReason
SignalExit
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RunNode BaseContext]
rts forall context. RunNode context -> IO ()
cancelNode

  ()
_ <- Signal -> (Signal -> IO ()) -> IO ()
installHandler Signal
sigINT Signal -> IO ()
shutdown
  ()
_ <- Signal -> (Signal -> IO ()) -> IO ()
installHandler Signal
sigTERM Signal -> IO ()
shutdown

  -- Wait for the tree to finish
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall context. RunNode context -> IO Result
waitForTree [RunNode BaseContext]
rts

  -- Wait for all formatters to finish
  [Either SomeException ()]
finalResults :: [Either E.SomeException ()] <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Async ()]
formatterAsyncs forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => IO a -> IO (Either e a)
E.try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Async a -> IO a
wait
  let failures :: [SomeException]
failures = forall a b. [Either a b] -> [a]
lefts [Either SomeException ()]
finalResults
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SomeException]
failures) forall a b. (a -> b) -> a -> b
$
    String -> IO ()
putStrLn [i|Some formatters failed: '#{failures}'|]

  -- Run finalizeFormatter method on formatters
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Options -> [SomeFormatter]
optionsFormatters Options
options) forall a b. (a -> b) -> a -> b
$ \(SomeFormatter f
f) -> do
    let loggingFn :: LoggingT IO a -> IO a
loggingFn = case BaseContext -> Maybe String
baseContextRunRoot BaseContext
baseContext of
          Maybe String
Nothing -> forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a.
LoggingT m a -> (Loc -> Text -> LogLevel -> LogStr -> IO ()) -> m a
runLoggingT (\Loc
_ Text
_ LogLevel
_ LogStr
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ())
          Just String
rootPath -> forall (m :: * -> *) a.
MonadBaseControl IO m =>
String -> LoggingT m a -> m a
runFileLoggingT (String
rootPath String -> String -> String
</> (forall f. Formatter f => f -> String
formatterName f
f) String -> String -> String
<.> String
"log")

    forall {a}. LoggingT IO a -> IO a
loggingFn forall a b. (a -> b) -> a -> b
$ forall f (m :: * -> *).
(Formatter f, MonadIO m, MonadLogger m, MonadCatch m) =>
f -> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter f
f [RunNode BaseContext]
rts BaseContext
baseContext

  [RunNodeFixed BaseContext]
fixedTree <- forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts
  let failed :: Int
failed = forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isFailedItBlock [RunNodeFixed BaseContext]
fixedTree
  ExitReason
exitReason <- forall a. IORef a -> IO a
readIORef IORef ExitReason
exitReasonRef
  forall (m :: * -> *) a. Monad m => a -> m a
return (ExitReason
exitReason, Int
failed)


-- | Count the it nodes
countItNodes :: Free (SpecCommand context m) r -> Int
countItNodes :: forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes (Free x :: SpecCommand context m (Free (SpecCommand context m) r)
x@(It'' {})) = Int
1 forall a. Num a => a -> a -> a
+ forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) r)
x)
countItNodes (Free (IntroduceWith'' {String
Maybe SrcLoc
Free (SpecCommand context m) r
SpecFree (LabelValue l intro :> context) m ()
NodeOptions
Label l intro
(intro -> ExampleT context m [Result]) -> ExampleT context m ()
introduceAction :: ()
subspecAugmented :: ()
contextLabel :: ()
label :: forall context (m :: * -> *) next.
SpecCommand context m next -> String
nodeOptions :: forall context (m :: * -> *) next.
SpecCommand context m next -> NodeOptions
location :: forall context (m :: * -> *) next.
SpecCommand context m next -> Maybe SrcLoc
next :: Free (SpecCommand context m) r
subspecAugmented :: SpecFree (LabelValue l intro :> context) m ()
introduceAction :: (intro -> ExampleT context m [Result]) -> ExampleT context m ()
contextLabel :: Label l intro
label :: String
nodeOptions :: NodeOptions
location :: Maybe SrcLoc
next :: forall context (m :: * -> *) next.
SpecCommand context m next -> next
..})) = forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes Free (SpecCommand context m) r
next forall a. Num a => a -> a -> a
+ forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes SpecFree (LabelValue l intro :> context) m ()
subspecAugmented
countItNodes (Free (Introduce'' {String
Maybe SrcLoc
Free (SpecCommand context m) r
SpecFree (LabelValue l intro :> context) m ()
NodeOptions
Label l intro
ExampleT context m intro
intro -> ExampleT context m ()
cleanup :: ()
allocate :: ()
next :: Free (SpecCommand context m) r
subspecAugmented :: SpecFree (LabelValue l intro :> context) m ()
cleanup :: intro -> ExampleT context m ()
allocate :: ExampleT context m intro
contextLabel :: Label l intro
label :: String
nodeOptions :: NodeOptions
location :: Maybe SrcLoc
subspecAugmented :: ()
contextLabel :: ()
label :: forall context (m :: * -> *) next.
SpecCommand context m next -> String
nodeOptions :: forall context (m :: * -> *) next.
SpecCommand context m next -> NodeOptions
location :: forall context (m :: * -> *) next.
SpecCommand context m next -> Maybe SrcLoc
next :: forall context (m :: * -> *) next.
SpecCommand context m next -> next
..})) = forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes Free (SpecCommand context m) r
next forall a. Num a => a -> a -> a
+ forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes SpecFree (LabelValue l intro :> context) m ()
subspecAugmented
countItNodes (Free SpecCommand context m (Free (SpecCommand context m) r)
x) = forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes (forall context (m :: * -> *) next.
SpecCommand context m next -> next
next SpecCommand context m (Free (SpecCommand context m) r)
x) forall a. Num a => a -> a -> a
+ forall context (m :: * -> *) r.
Free (SpecCommand context m) r -> Int
countItNodes (forall context (m :: * -> *) next.
SpecCommand context m next -> SpecFree context m ()
subspec SpecCommand context m (Free (SpecCommand context m) r)
x)
countItNodes (Pure r
_) = Int
0