{-# LANGUAGE MultiWayIf #-}

-- | The failure report formatter is like the print formatter, but it only shows failures.
--
-- Documentation can be found <https://codedownio.github.io/sandwich/docs/formatters/failure_report here>.

module Test.Sandwich.Formatters.FailureReport (
  defaultFailureReportFormatter
  , FailureReportFormatter

  -- * Options
  , failureReportUseColor
  , failureReportLogLevel
  , failureReportIncludeCallStacks
  , failureReportIndentSize
  , failureReportVisibilityThreshold
  ) where

import Control.Monad
import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Monad.Logger
import Control.Monad.Reader
import Data.Foldable
import Data.Function
import qualified Data.Map as M
import Data.Maybe
import qualified Data.Sequence as Seq
import Data.String.Interpolate
import qualified Data.Text as T
import System.IO
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.RunTree
import Test.Sandwich.Types.Spec


data FailureReportFormatter = FailureReportFormatter {
  FailureReportFormatter -> Bool
failureReportUseColor :: Bool
  , FailureReportFormatter -> Maybe LogLevel
failureReportLogLevel :: Maybe LogLevel
  , FailureReportFormatter -> Bool
failureReportIncludeCallStacks :: Bool
  , FailureReportFormatter -> Int
failureReportIndentSize :: Int
  , FailureReportFormatter -> Int
failureReportVisibilityThreshold :: Int
  , FailureReportFormatter -> IncludeTimestamps
failureReportIncludeTimestamps :: IncludeTimestamps
  } deriving (Int -> FailureReportFormatter -> ShowS
[FailureReportFormatter] -> ShowS
FailureReportFormatter -> String
(Int -> FailureReportFormatter -> ShowS)
-> (FailureReportFormatter -> String)
-> ([FailureReportFormatter] -> ShowS)
-> Show FailureReportFormatter
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FailureReportFormatter -> ShowS
showsPrec :: Int -> FailureReportFormatter -> ShowS
$cshow :: FailureReportFormatter -> String
show :: FailureReportFormatter -> String
$cshowList :: [FailureReportFormatter] -> ShowS
showList :: [FailureReportFormatter] -> ShowS
Show)

defaultFailureReportFormatter :: FailureReportFormatter
defaultFailureReportFormatter :: FailureReportFormatter
defaultFailureReportFormatter = FailureReportFormatter {
  failureReportUseColor :: Bool
failureReportUseColor = Bool
True
  , failureReportLogLevel :: Maybe LogLevel
failureReportLogLevel = LogLevel -> Maybe LogLevel
forall a. a -> Maybe a
Just LogLevel
LevelWarn
  , failureReportIncludeCallStacks :: Bool
failureReportIncludeCallStacks = Bool
True
  , failureReportIndentSize :: Int
failureReportIndentSize = Int
4
  , failureReportVisibilityThreshold :: Int
failureReportVisibilityThreshold = Int
50
  , failureReportIncludeTimestamps :: IncludeTimestamps
failureReportIncludeTimestamps = IncludeTimestamps
IncludeTimestampsNever
  }

instance Formatter FailureReportFormatter where
  formatterName :: FailureReportFormatter -> String
formatterName FailureReportFormatter
_ = String
"failure-report-formatter"
  runFormatter :: forall (m :: * -> *).
(MonadLoggerIO m, MonadUnliftIO m, MonadCatch m) =>
FailureReportFormatter
-> [RunNode BaseContext]
-> Maybe (CommandLineOptions ())
-> BaseContext
-> m ()
runFormatter FailureReportFormatter
_ [RunNode BaseContext]
_ Maybe (CommandLineOptions ())
_ BaseContext
_ = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  finalizeFormatter :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
FailureReportFormatter
-> [RunNode BaseContext] -> BaseContext -> m ()
finalizeFormatter = FailureReportFormatter
-> [RunNode BaseContext] -> BaseContext -> m ()
forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
FailureReportFormatter
-> [RunNode BaseContext] -> BaseContext -> m ()
printFailureReport

printFailureReport :: (MonadIO m, MonadLogger m, MonadCatch m) => FailureReportFormatter -> [RunNode BaseContext] -> BaseContext -> m ()
printFailureReport :: forall (m :: * -> *).
(MonadIO m, MonadLogger m, MonadCatch m) =>
FailureReportFormatter
-> [RunNode BaseContext] -> BaseContext -> m ()
printFailureReport frf :: FailureReportFormatter
frf@(FailureReportFormatter {Bool
Int
Maybe LogLevel
IncludeTimestamps
failureReportUseColor :: FailureReportFormatter -> Bool
failureReportLogLevel :: FailureReportFormatter -> Maybe LogLevel
failureReportIncludeCallStacks :: FailureReportFormatter -> Bool
failureReportIndentSize :: FailureReportFormatter -> Int
failureReportVisibilityThreshold :: FailureReportFormatter -> Int
failureReportIncludeTimestamps :: FailureReportFormatter -> IncludeTimestamps
failureReportUseColor :: Bool
failureReportLogLevel :: Maybe LogLevel
failureReportIncludeCallStacks :: Bool
failureReportIndentSize :: Int
failureReportVisibilityThreshold :: Int
failureReportIncludeTimestamps :: IncludeTimestamps
..}) [RunNode BaseContext]
rts BaseContext
_bc = do
  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
$ String -> IO ()
putStrLn [i|\n\nFailure report:|]

  let pf :: PrintFormatter
pf = PrintFormatter {
        printFormatterUseColor :: Bool
printFormatterUseColor = Bool
failureReportUseColor
        , printFormatterLogLevel :: Maybe LogLevel
printFormatterLogLevel = Maybe LogLevel
failureReportLogLevel
        , printFormatterVisibilityThreshold :: Int
printFormatterVisibilityThreshold = Int
forall a. Bounded a => a
maxBound
        , printFormatterIncludeCallStacks :: Bool
printFormatterIncludeCallStacks = Bool
failureReportIncludeCallStacks
        , printFormatterIndentSize :: Int
printFormatterIndentSize = Int
failureReportIndentSize
        , printFormatterIncludeTimestamps :: IncludeTimestamps
printFormatterIncludeTimestamps = IncludeTimestamps
failureReportIncludeTimestamps
        }

  let extractFromNode :: RunNodeWithStatus context s l t -> (Int, (Text, Int))
extractFromNode RunNodeWithStatus context s l t
node = let RunNodeCommonWithStatus {s
l
t
Bool
Int
String
Maybe String
Maybe SrcLoc
Seq Int
runTreeLabel :: String
runTreeId :: Int
runTreeAncestors :: Seq Int
runTreeToggled :: t
runTreeOpen :: t
runTreeStatus :: s
runTreeVisible :: Bool
runTreeFolder :: Maybe String
runTreeVisibilityLevel :: Int
runTreeRecordTime :: Bool
runTreeLogs :: l
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
..} = RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
forall s l t context.
RunNodeWithStatus context s l t -> RunNodeCommonWithStatus s l t
runNodeCommon RunNodeWithStatus context s l t
node in (Int
runTreeId, (String -> Text
T.pack String
runTreeLabel, Int
runTreeVisibilityLevel))
  let idToLabel :: Map Int (Text, Int)
idToLabel = [(Int, (Text, Int))] -> Map Int (Text, Int)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(Int, (Text, Int))] -> Map Int (Text, Int))
-> [(Int, (Text, Int))] -> Map Int (Text, Int)
forall a b. (a -> b) -> a -> b
$ [[(Int, (Text, Int))]] -> [(Int, (Text, Int))]
forall a. Monoid a => [a] -> a
mconcat [(forall context1.
 RunNodeWithStatus
   context1 (Var Status) (Var (Seq LogEntry)) (Var Bool)
 -> (Int, (Text, Int)))
-> RunNode BaseContext -> [(Int, (Text, Int))]
forall s l t a context.
(forall context1. RunNodeWithStatus context1 s l t -> a)
-> RunNodeWithStatus context s l t -> [a]
extractValues RunNodeWithStatus
  context1 (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> (Int, (Text, Int))
forall context1.
RunNodeWithStatus
  context1 (Var Status) (Var (Seq LogEntry)) (Var Bool)
-> (Int, (Text, Int))
forall {context} {s} {l} {t}.
RunNodeWithStatus context s l t -> (Int, (Text, Int))
extractFromNode RunNode BaseContext
node | RunNode BaseContext
node <- [RunNode BaseContext]
rts]

  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
$ 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_ (FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode BaseContext
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation FailureReportFormatter
frf Map Int (Text, Int)
idToLabel) [RunNode BaseContext]
rts) (PrintFormatter
pf, Int
0, Handle
stdout)

runWithIndentation :: FailureReportFormatter -> M.Map Int (T.Text, Int) -> RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation :: forall context.
FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation frf :: FailureReportFormatter
frf@(FailureReportFormatter {Bool
Int
Maybe LogLevel
IncludeTimestamps
failureReportUseColor :: FailureReportFormatter -> Bool
failureReportLogLevel :: FailureReportFormatter -> Maybe LogLevel
failureReportIncludeCallStacks :: FailureReportFormatter -> Bool
failureReportIndentSize :: FailureReportFormatter -> Int
failureReportVisibilityThreshold :: FailureReportFormatter -> Int
failureReportIncludeTimestamps :: FailureReportFormatter -> IncludeTimestamps
failureReportUseColor :: Bool
failureReportLogLevel :: Maybe LogLevel
failureReportIncludeCallStacks :: Bool
failureReportIndentSize :: Int
failureReportVisibilityThreshold :: Int
failureReportIncludeTimestamps :: IncludeTimestamps
..}) Map Int (Text, Int)
idToLabel 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

  case RunNode context
node of
    RunNodeIt {} -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    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 :: ()
..} -> [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 (FailureReportFormatter
-> Map Int (Text, Int)
-> RunNodeWithStatus
     (LabelValue lab intro :> context)
     (Var Status)
     (Var (Seq LogEntry))
     (Var Bool)
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation FailureReportFormatter
frf Map Int (Text, Int)
idToLabel)
    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 :: ()
..} -> [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 (FailureReportFormatter
-> Map Int (Text, Int)
-> RunNodeWithStatus
     (LabelValue lab intro :> context)
     (Var Status)
     (Var (Seq LogEntry))
     (Var Bool)
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation FailureReportFormatter
frf Map Int (Text, Int)
idToLabel)
    RunNode context
_ -> [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) (FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
forall context.
FailureReportFormatter
-> Map Int (Text, Int)
-> RunNode context
-> ReaderT (PrintFormatter, Int, Handle) IO ()
runWithIndentation FailureReportFormatter
frf Map Int (Text, Int)
idToLabel)

  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 Result
result of
    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 ()
    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 ()
    Failure (ChildrenFailed {}) -> () -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall a. a -> ReaderT (PrintFormatter, Int, Handle) IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Failure FailureReason
reason -> do
      String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"

      let ancestorIds :: Seq Int
ancestorIds = Seq Int
runTreeAncestors
      let ancestorNames :: Seq Text
ancestorNames = (Int -> (Text, Int)) -> Seq Int -> Seq (Text, Int)
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Int
k -> (Text, Int) -> Maybe (Text, Int) -> (Text, Int)
forall a. a -> Maybe a -> a
fromMaybe (Text
"?", Int
0) (Maybe (Text, Int) -> (Text, Int))
-> Maybe (Text, Int) -> (Text, Int)
forall a b. (a -> b) -> a -> b
$ Int -> Map Int (Text, Int) -> Maybe (Text, Int)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Int
k Map Int (Text, Int)
idToLabel) Seq Int
ancestorIds
                        Seq (Text, Int)
-> (Seq (Text, Int) -> Seq (Text, Int)) -> Seq (Text, Int)
forall a b. a -> (a -> b) -> b
& ((Text, Int) -> Bool) -> Seq (Text, Int) -> Seq (Text, Int)
forall a. (a -> Bool) -> Seq a -> Seq a
Seq.filter (\(Text
_, Int
visibilityLevel) -> Int
visibilityLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
failureReportVisibilityThreshold)
                        Seq (Text, Int) -> (Seq (Text, Int) -> Seq Text) -> Seq Text
forall a b. a -> (a -> b) -> b
& ((Text, Int) -> Text) -> Seq (Text, Int) -> Seq Text
forall a b. (a -> b) -> Seq a -> Seq b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text, Int) -> Text
forall a b. (a, b) -> a
fst
      let label :: String
label = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
", " (Seq Text -> [Text]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq Text
ancestorNames)

      case FailureReason
reason of
        Pending {} -> do
          String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pYellowLn String
label
        FailureReason
_ -> do
          -- TODO: get full list of ancestor labels joined on ", "
          String -> ReaderT (PrintFormatter, Int, Handle) IO ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
String -> m ()
pRedLn String
label
          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