{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}

-- | The print formatter prints all results from the test tree from top to bottom, as they become available.
--
-- Documentation can be found <https://codedownio.github.io/sandwich/docs/formatters/print here>.

module Test.Sandwich.Formatters.Print (
  defaultPrintFormatter

  -- * Options
  , printFormatterUseColor
  , printFormatterLogLevel
  , printFormatterIncludeCallStacks
  , printFormatterIndentSize
  , printFormatterVisibilityThreshold
  ) where

import Control.Concurrent.STM
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.String.Interpolate
import Data.Time.Clock
import System.IO
import Test.Sandwich.Formatters.Common.Count
import Test.Sandwich.Formatters.Common.Util
import Test.Sandwich.Formatters.Print.Common
import Test.Sandwich.Formatters.Print.FailureReason
import Test.Sandwich.Formatters.Print.Printing
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Print.Util
import Test.Sandwich.Interpreters.RunTree.Util
import Test.Sandwich.RunTree
import Test.Sandwich.Types.ArgParsing
import Test.Sandwich.Types.RunTree
import Test.Sandwich.Types.Spec
import Test.Sandwich.Util


instance Formatter PrintFormatter where
  formatterName :: PrintFormatter -> String
formatterName PrintFormatter
_ = String
"print-formatter"
  runFormatter :: PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter = PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m) =>
PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp
  finalizeFormatter :: PrintFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter PrintFormatter
_ [RunNode BaseContext]
_ BaseContext
_ = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

runApp :: (MonadIO m, MonadLogger m) => PrintFormatter -> [RunNode BaseContext] -> Maybe (CommandLineOptions ()) -> BaseContext -> m ()
runApp :: PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp pf :: PrintFormatter
pf@(PrintFormatter {Bool
Int
Maybe LogLevel
printFormatterIndentSize :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterVisibilityThreshold :: Int
printFormatterLogLevel :: Maybe LogLevel
printFormatterUseColor :: Bool
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterUseColor :: PrintFormatter -> Bool
..}) [RunNode BaseContext]
rts Maybe (CommandLineOptions ())
_maybeCommandLineOptions BaseContext
bc = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let total :: Int
total = (forall context1.
 RunNodeWithStatus
   context1 (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> [RunNode BaseContext] -> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus
  context1 (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Bool
forall context s l t. RunNodeWithStatus context s l t -> Bool
isItBlock [RunNode BaseContext]
rts

  UTCTime
startTime <- IO UTCTime
getCurrentTime

  String -> IO ()
putStrLn String
"\n"
  String -> IO ()
putStrLn [i|Beginning suite of #{total} tests\n|]

  Maybe String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => Maybe a -> (a -> m b) -> m ()
whenJust (BaseContext -> Maybe String
baseContextRunRoot BaseContext
bc) ((String -> IO ()) -> IO ()) -> (String -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \String
runRoot ->
    String -> IO ()
putStrLn [i|Run root: #{runRoot}\n|]

  ReaderT (PrintFormatter, Int, Handle) IO ()
-> (PrintFormatter, Int, Handle) -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ((RunNode BaseContext
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> [RunNode BaseContext]
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RunNode BaseContext -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation [RunNode BaseContext]
rts) (PrintFormatter
pf, Int
2, Handle
stdout)
  String -> IO ()
putStrLn String
"\n"

  [RunNodeFixed BaseContext]
fixedTree <- STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext]
forall a. STM a -> IO a
atomically (STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext])
-> STM [RunNodeFixed BaseContext] -> IO [RunNodeFixed BaseContext]
forall a b. (a -> b) -> a -> b
$ (RunNode BaseContext -> STM (RunNodeFixed BaseContext))
-> [RunNode BaseContext] -> STM [RunNodeFixed BaseContext]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RunNode BaseContext -> STM (RunNodeFixed BaseContext)
forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts
  let failed :: Int
failed = (forall context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeFixed BaseContext] -> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool
forall context l t. RunNodeWithStatus context Status l t -> Bool
isFailedItBlock [RunNodeFixed BaseContext]
fixedTree
  let pending :: Int
pending = (forall context1.
 RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeFixed BaseContext] -> Int
forall s l t context.
(forall context1. RunNodeWithStatus context1 s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere forall context1.
RunNodeWithStatus context1 Status (Seq LogEntry) Bool -> Bool
forall context l t. RunNodeWithStatus context Status l t -> Bool
isPendingItBlock [RunNodeFixed BaseContext]
fixedTree

  UTCTime
endTime <- IO UTCTime
getCurrentTime
  let timeDiff :: String
timeDiff = NominalDiffTime -> String
formatNominalDiffTime (NominalDiffTime -> String) -> NominalDiffTime -> String
forall a b. (a -> b) -> a -> b
$ UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime UTCTime
endTime UTCTime
startTime

  if | Int
failed Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> String -> IO ()
putStr [i|All tests passed in #{timeDiff}.|]
     | Bool
otherwise -> String -> IO ()
putStr [i|#{failed} failed of #{total} in #{timeDiff}.|]
  case Int
pending of
    Int
0 -> String -> IO ()
putStrLn String
""
    Int
_ -> String -> IO ()
putStrLn [i| (#{pending} pending)|]


runWithIndentation :: RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation :: RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation node :: RunNode context
node@(RunNodeIt {ExampleT context IO ()
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeExample :: forall context s l t.
RunNodeWithStatus context s l t -> ExampleT context IO ()
runNodeCommon :: forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeExample :: ExampleT context IO ()
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
..}) = do
  let common :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
common@(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
..}) = RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon

  Result
result <- IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result)
-> IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result
forall a b. (a -> b) -> a -> b
$ RunNode context -> IO Result
forall context. RunNode context -> IO Result
waitForTree RunNode context
node

  -- Print the main header
  case Result
result of
    Result
Success -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pGreenLn String
runTreeLabel
    Result
DryRun -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pin String
runTreeLabel
    Result
Cancelled -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pin String
runTreeLabel
    (Failure (Pending Maybe CallStack
_ Maybe String
_)) -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pYellowLn String
runTreeLabel
    (Failure FailureReason
reason) -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pRedLn String
runTreeLabel
      ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) c b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason FailureReason
reason

  RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Result -> ReaderT (PrintFormatter, Int, Handle) IO ()
finishPrinting RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
common Result
result
runWithIndentation RunNode context
node = do
  let common :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
common@(RunNodeCommonWithStatus {Bool
Int
String
Maybe String
Maybe SrcLoc
Var Bool
Var (Seq LogEntry)
Var Status
Seq Int
runTreeLoc :: Maybe SrcLoc
runTreeLogs :: Var (Seq LogEntry)
runTreeRecordTime :: Bool
runTreeVisibilityLevel :: Int
runTreeFolder :: Maybe String
runTreeVisible :: Bool
runTreeStatus :: Var Status
runTreeOpen :: Var Bool
runTreeToggled :: Var Bool
runTreeAncestors :: Seq Int
runTreeId :: Int
runTreeLabel :: String
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
..}) = RunNode context
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node

  (PrintFormatter {Bool
Int
Maybe LogLevel
printFormatterIndentSize :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterVisibilityThreshold :: Int
printFormatterLogLevel :: Maybe LogLevel
printFormatterUseColor :: Bool
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterUseColor :: PrintFormatter -> Bool
..}, Int
_, Handle
_) <- ReaderT
  (PrintFormatter, Int, Handle) IO (PrintFormatter, Int, Handle)
forall r (m :: * -> *). MonadReader r m => m r
ask

  ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
childPrintFn <- case Int
runTreeVisibilityLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
printFormatterVisibilityThreshold of
    Bool
True -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pin String
runTreeLabel
      (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT
     (PrintFormatter, Int, Handle)
     IO
     (ReaderT (PrintFormatter, Int, Handle) IO ()
      -> ReaderT (PrintFormatter, Int, Handle) IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) c b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent
    Bool
False -> (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT
     (PrintFormatter, Int, Handle)
     IO
     (ReaderT (PrintFormatter, Int, Handle) IO ()
      -> ReaderT (PrintFormatter, Int, Handle) IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> a
id

  case RunNode context
node of
    RunNodeIntroduce {[RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
ExampleT context IO intro
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
intro -> ExampleT context IO ()
runNodeCleanup :: ()
runNodeAlloc :: ()
runNodeChildrenAugmented :: ()
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeAlloc :: ExampleT context IO intro
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon :: forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..} -> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
childPrintFn (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
-> (RunNodeWithStatus
      (LabelValue lab intro :> context)
      (Var Status)
      (Var (Seq LogEntry))
      (Var Bool)
    -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeChildrenAugmented RunNodeWithStatus
  (LabelValue lab intro :> context)
  (Var Status)
  (Var (Seq LogEntry))
  (Var Bool)
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation
    RunNodeIntroduceWith {[RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
(intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: ()
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildrenAugmented :: ()
runNodeCommon :: forall context s l t.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
..} -> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
childPrintFn (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
-> (RunNodeWithStatus
      (LabelValue lab intro :> context)
      (Var Status)
      (Var (Seq LogEntry))
      (Var Bool)
    -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeChildrenAugmented RunNodeWithStatus
  (LabelValue lab intro :> context)
  (Var Status)
  (Var (Seq LogEntry))
  (Var Bool)
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation
    RunNode context
_ -> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
childPrintFn (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ [RunNode context]
-> (RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (RunNode context -> [RunNode context]
forall context s l t.
RunNodeWithStatus context s l t
-> [RunNodeWithStatus context s l t]
runNodeChildren RunNode context
node) RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation

  Result
result <- IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result)
-> IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result
forall a b. (a -> b) -> a -> b
$ RunNode context -> IO Result
forall context. RunNode context -> IO Result
waitForTree RunNode context
node

  -- Print the failure reason
  case Int
runTreeVisibilityLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
printFormatterVisibilityThreshold of
    Bool
True -> do
      case Result
result of
        Failure FailureReason
r -> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) c b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (ReaderT (PrintFormatter, Int, Handle) IO ()
 -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b. (a -> b) -> a -> b
$ FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason FailureReason
r
        Result
Cancelled -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Result
Success -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Result
DryRun -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Result -> ReaderT (PrintFormatter, Int, Handle) IO ()
finishPrinting RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
common Result
result
    Bool
False -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- TODO: print failure info even though node should be hidden?