{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | 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.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 as 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 :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m, MonadCatch m) =>
PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter = PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
forall (m :: * -> *).
MonadIO m =>
PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp
  finalizeFormatter :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
PrintFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter PrintFormatter
_ [RunNode BaseContext]
_ BaseContext
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

runApp :: (MonadIO m) => PrintFormatter -> [RunNode BaseContext] -> Maybe (CommandLineOptions ()) -> BaseContext -> m ()
runApp :: forall (m :: * -> *).
MonadIO m =>
PrintFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runApp PrintFormatter
pf [RunNode BaseContext]
rts Maybe (CommandLineOptions ())
_maybeCommandLineOptions BaseContext
bc = IO () -> m ()
forall a. IO a -> m a
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 ctx.
 RunNodeWithStatus ctx (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> Bool)
-> [RunNode BaseContext] -> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> Bool
forall ctx.
RunNodeWithStatus ctx (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)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM RunNode BaseContext -> STM (RunNodeFixed BaseContext)
forall context. RunNode context -> STM (RunNodeFixed context)
fixRunTree [RunNode BaseContext]
rts
  let failed :: Int
failed = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeFixed BaseContext] -> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall {context} {l} {t}.
RunNodeWithStatus context Status l t -> Bool
isFailedItBlock [RunNodeFixed BaseContext]
fixedTree
  let pending :: Int
pending = (forall ctx.
 RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool)
-> [RunNodeFixed BaseContext] -> Int
forall s l t context.
(forall ctx. RunNodeWithStatus ctx s l t -> Bool)
-> [RunNodeWithStatus context s l t] -> Int
countWhere RunNodeWithStatus ctx Status (Seq LogEntry) Bool -> Bool
forall ctx.
RunNodeWithStatus ctx 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 :: forall context.
RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation node :: RunNode context
node@(RunNodeIt {ExampleT context IO ()
RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeExample :: ExampleT context IO ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeExample :: forall s l t context.
RunNodeWithStatus context s l t -> ExampleT context IO ()
..}) = 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
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
..}) = RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeCommon

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

  Result
result <- IO Result -> ReaderT (PrintFormatter, Int, Handle) IO Result
forall a. IO a -> ReaderT (PrintFormatter, Int, Handle) IO a
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

  let printTiming :: ReaderT (PrintFormatter, Int, Handle) IO ()
printTiming = IO Status -> ReaderT (PrintFormatter, Int, Handle) IO Status
forall a. IO a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Var Status -> IO Status
forall a. TVar a -> IO a
readTVarIO Var Status
runTreeStatus) ReaderT (PrintFormatter, Int, Handle) IO Status
-> (Status -> ReaderT (PrintFormatter, Int, Handle) IO ())
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a b.
ReaderT (PrintFormatter, Int, Handle) IO a
-> (a -> ReaderT (PrintFormatter, Int, Handle) IO b)
-> ReaderT (PrintFormatter, Int, Handle) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Done {Maybe UTCTime
UTCTime
Result
statusStartTime :: UTCTime
statusSetupFinishTime :: Maybe UTCTime
statusTeardownStartTime :: Maybe UTCTime
statusEndTime :: UTCTime
statusResult :: Result
statusStartTime :: Status -> UTCTime
statusSetupFinishTime :: Status -> Maybe UTCTime
statusTeardownStartTime :: Status -> Maybe UTCTime
statusEndTime :: Status -> UTCTime
statusResult :: Status -> Result
..} -> String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p [i| (#{diffUTCTime statusEndTime statusStartTime})|]
        Status
_ -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- Shouldn't happen

  -- Print the main header
  case Result
result of
    Result
Success -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pGreen String
runTreeLabel
      Bool
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IncludeTimestamps
printFormatterIncludeTimestamps IncludeTimestamps -> IncludeTimestamps -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeTimestamps
IncludeTimestampsAlways) ReaderT (PrintFormatter, Int, Handle) IO ()
printTiming
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
    Result
DryRun -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
Printing.pi String
runTreeLabel
      Bool
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IncludeTimestamps
printFormatterIncludeTimestamps IncludeTimestamps -> IncludeTimestamps -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeTimestamps
IncludeTimestampsAlways) ReaderT (PrintFormatter, Int, Handle) IO ()
printTiming
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
    Result
Cancelled -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
Printing.pi String
runTreeLabel
      Bool
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IncludeTimestamps
printFormatterIncludeTimestamps IncludeTimestamps -> IncludeTimestamps -> Bool
forall a. Eq a => a -> a -> Bool
== IncludeTimestamps
IncludeTimestampsAlways) ReaderT (PrintFormatter, Int, Handle) IO ()
printTiming
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
    (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 ()
pRed String
runTreeLabel
      Bool
-> ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (IncludeTimestamps
printFormatterIncludeTimestamps IncludeTimestamps -> IncludeTimestamps -> Bool
forall a. Eq a => a -> a -> Bool
/= IncludeTimestamps
IncludeTimestampsNever) ReaderT (PrintFormatter, Int, Handle) IO ()
printTiming
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"

      ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall c (m :: * -> *) 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
runTreeLabel :: forall s l t. RunNodeCommonWithStatus s l t -> String
runTreeId :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeAncestors :: forall s l t. RunNodeCommonWithStatus s l t -> Seq Int
runTreeToggled :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeOpen :: forall s l t. RunNodeCommonWithStatus s l t -> t
runTreeStatus :: forall s l t. RunNodeCommonWithStatus s l t -> s
runTreeVisible :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeFolder :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe String
runTreeVisibilityLevel :: forall s l t. RunNodeCommonWithStatus s l t -> Int
runTreeRecordTime :: forall s l t. RunNodeCommonWithStatus s l t -> Bool
runTreeLogs :: forall s l t. RunNodeCommonWithStatus s l t -> l
runTreeLoc :: forall s l t. RunNodeCommonWithStatus s l t -> Maybe SrcLoc
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: Var Bool
runTreeOpen :: Var Bool
runTreeStatus :: Var Status
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: Var (Seq LogEntry)
runTreeLoc :: Maybe SrcLoc
..}) = RunNode context
-> RunNodeCommonWithStatus
     (Var Status) (Var (Seq LogEntry)) (Var Bool)
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNode context
node

  (PrintFormatter {Bool
Int
Maybe LogLevel
IncludeTimestamps
printFormatterUseColor :: PrintFormatter -> Bool
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterIncludeTimestamps :: PrintFormatter -> IncludeTimestamps
printFormatterUseColor :: Bool
printFormatterLogLevel :: Maybe LogLevel
printFormatterVisibilityThreshold :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterIndentSize :: Int
printFormatterIncludeTimestamps :: IncludeTimestamps
..}, 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 a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReaderT (PrintFormatter, Int, Handle) IO ()
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall c (m :: * -> *) 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 a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
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 ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeAlloc :: ExampleT context IO intro
runNodeCleanup :: intro -> ExampleT context IO ()
runNodeChildrenAugmented :: ()
runNodeAlloc :: ()
runNodeCleanup :: ()
..} -> 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 ()
runNodeCommon :: forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeChildrenAugmented :: ()
runNodeCommon :: RunNodeCommonWithStatus
  (Var Status) (Var (Seq LogEntry)) (Var Bool)
runNodeChildrenAugmented :: [RunNodeWithStatus
   (LabelValue lab intro :> context)
   (Var Status)
   (Var (Seq LogEntry))
   (Var Bool)]
runNodeIntroduceAction :: (intro -> ExampleT context IO [Result]) -> ExampleT context IO ()
runNodeIntroduceAction :: ()
..} -> 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 s l t context.
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 a. IO a -> ReaderT (PrintFormatter, Int, Handle) IO a
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 c (m :: * -> *) 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 a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Result
Success -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Result
DryRun -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
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 -> case Result
result of
        Failure FailureReason
r -> do
          String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pRedLn (String
"^ " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
runTreeLabel)
          FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
printFailureReason FailureReason
r
          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
        Result
_ -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()