Be able to include timestamps in print formatter and failure report formatter

sandwich/src/Test/Sandwich/Formatters/FailureReport.hs

@@ -46,6 +46,7 @@ data FailureReportFormatter = FailureReportFormatter {
   , failureReportIncludeCallStacks :: Bool
   , failureReportIndentSize :: Int
   , failureReportVisibilityThreshold :: Int
+  , failureReportIncludeTimestamps :: IncludeTimestamps
   } deriving (Show)
 
 defaultFailureReportFormatter :: FailureReportFormatter
@@ -55,6 +56,7 @@ defaultFailureReportFormatter = FailureReportFormatter {
   , failureReportIncludeCallStacks = True
   , failureReportIndentSize = 4
   , failureReportVisibilityThreshold = 50
+  , failureReportIncludeTimestamps = IncludeTimestampsNever
   }
 
 instance Formatter FailureReportFormatter where
@@ -72,6 +74,7 @@ printFailureReport frf@(FailureReportFormatter {..}) rts _bc = do
         , printFormatterVisibilityThreshold = maxBound
         , printFormatterIncludeCallStacks = failureReportIncludeCallStacks
         , printFormatterIndentSize = failureReportIndentSize
+        , printFormatterIncludeTimestamps = failureReportIncludeTimestamps
         }
 
   let extractFromNode node = let RunNodeCommonWithStatus {..} = runNodeCommon node in (runTreeId, (T.pack runTreeLabel, runTreeVisibilityLevel))

sandwich/src/Test/Sandwich/Formatters/Print.hs

@@ -27,7 +27,7 @@ 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.Printing as Printing
 import Test.Sandwich.Formatters.Print.Types
 import Test.Sandwich.Formatters.Print.Util
 import Test.Sandwich.Interpreters.RunTree.Util
@@ -76,16 +76,34 @@ runWithIndentation :: RunNode context -> ReaderT (PrintFormatter, Int, Handle) I
 runWithIndentation node@(RunNodeIt {..}) = do
   let common@(RunNodeCommonWithStatus {..}) = runNodeCommon
 
+  (PrintFormatter {..}, _, _) <- ask
+
   result <- liftIO $ waitForTree node
 
+  let printTiming = liftIO (readTVarIO runTreeStatus) >>= \case
+        Done {..} -> p [i| (#{diffUTCTime statusEndTime statusStartTime})|]
+        _ -> return () -- Shouldn't happen
+
   -- Print the main header
   case result of
-    Success -> pGreenLn runTreeLabel
-    DryRun -> pin runTreeLabel
-    Cancelled -> pin runTreeLabel
+    Success -> do
+      pGreen runTreeLabel
+      when (printFormatterIncludeTimestamps == IncludeTimestampsAlways) printTiming
+      p "\n"
+    DryRun -> do
+      Printing.pi runTreeLabel
+      when (printFormatterIncludeTimestamps == IncludeTimestampsAlways) printTiming
+      p "\n"
+    Cancelled -> do
+      Printing.pi runTreeLabel
+      when (printFormatterIncludeTimestamps == IncludeTimestampsAlways) printTiming
+      p "\n"
     (Failure (Pending _ _)) -> pYellowLn runTreeLabel
     (Failure reason) -> do
-      pRedLn runTreeLabel
+      pRed runTreeLabel
+      when (printFormatterIncludeTimestamps /= IncludeTimestampsNever) printTiming
+      p "\n"
+
       withBumpIndent $ printFailureReason reason
 
   finishPrinting common result

sandwich/src/Test/Sandwich/Formatters/Print/Printing.hs

@@ -25,9 +25,14 @@ pc color msg = printWithColor (Just (SetRGBColor Foreground color)) msg
 pn msg = printWithColor Nothing (msg <> "\n")
 pcn color msg = printWithColor (Just (SetRGBColor Foreground color)) (msg <> "\n")
 
-pGreenLn msg = printIndentedWithColor (Just (SetColor Foreground Dull Green)) (msg <> "\n")
-pYellowLn msg = printIndentedWithColor (Just (SetColor Foreground Dull Yellow)) (msg <> "\n")
-pRedLn msg = printIndentedWithColor (Just (SetColor Foreground Dull Red)) (msg <> "\n") -- Tried solarizedRed here but it was too orange
+pGreen msg = printIndentedWithColor (Just (SetColor Foreground Dull Green)) msg
+pGreenLn msg = pGreen (msg <> "\n")
+
+pYellow msg = printIndentedWithColor (Just (SetColor Foreground Dull Yellow)) msg
+pYellowLn msg = pYellow (msg <> "\n")
+
+pRed msg = printIndentedWithColor (Just (SetColor Foreground Dull Red)) msg -- Tried solarizedRed here but it was too orange
+pRedLn msg = pRed (msg <> "\n")
 
 printIndentedWithColor maybeColor msg = do
   (PrintFormatter {}, indent, h) <- ask

sandwich/src/Test/Sandwich/Formatters/Print/Types.hs

@@ -14,8 +14,16 @@ data PrintFormatter = PrintFormatter {
   -- ^ Whether to include callstacks with failures.
   , printFormatterIndentSize :: Int
   -- ^ The indentation unit in spaces. Defaults to 4.
+  , printFormatterIncludeTimestamps :: IncludeTimestamps
+  -- ^ Whether to include timestamps in output. Defaults to 'IncludeTimestampsNever'.
   } deriving (Show)
 
+data IncludeTimestamps =
+  IncludeTimestampsAlways
+  | IncludeTimestampsNever
+  | IncludeTimestampsFailuresOnly
+  deriving (Show, Eq)
+
 defaultPrintFormatter :: PrintFormatter
 defaultPrintFormatter = PrintFormatter {
   printFormatterUseColor = True
@@ -23,4 +31,5 @@ defaultPrintFormatter = PrintFormatter {
   , printFormatterVisibilityThreshold = 50
   , printFormatterIncludeCallStacks = True
   , printFormatterIndentSize = 4
+  , printFormatterIncludeTimestamps = IncludeTimestampsNever
   }