content: {-# 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 _ = "print-formatter"
    runFormatter = runApp
    finalizeFormatter _ _ _ = return ()
  
  runApp :: (MonadIO m) => PrintFormatter -> [RunNode BaseContext] -> Maybe (CommandLineOptions ()) -> BaseContext -> m ()
  runApp pf rts _maybeCommandLineOptions bc = liftIO $ do
    let total = countWhere isItBlock rts
  
    startTime <- getCurrentTime
  
    putStrLn "\n"
    putStrLn [i|Beginning suite of #{total} tests\n|]
  
    whenJust (baseContextRunRoot bc) $ \runRoot ->
      putStrLn [i|Run root: #{runRoot}\n|]
  
    runReaderT (mapM_ runWithIndentation rts) (pf, 2, stdout)
    putStrLn "\n"
  
    fixedTree <- atomically $ mapM fixRunTree rts
    let failed = countWhere isFailedItBlock fixedTree
    let pending = countWhere isPendingItBlock fixedTree
  
    endTime <- getCurrentTime
    let timeDiff = formatNominalDiffTime $ diffUTCTime endTime startTime
  
    if | failed == 0 -> putStr [i|All tests passed in #{timeDiff}.|]
       | otherwise -> putStr [i|#{failed} failed of #{total} in #{timeDiff}.|]
    case pending of
      0 -> putStrLn ""
      _ -> putStrLn [i| (#{pending} pending)|]
  
  
  runWithIndentation :: RunNode context -> ReaderT (PrintFormatter, Int, Handle) IO ()
  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 -> 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
        pRed runTreeLabel
        when (printFormatterIncludeTimestamps /= IncludeTimestampsNever) printTiming
        p "\n"
  
        withBumpIndent $ printFailureReason reason
  
    finishPrinting common result
  runWithIndentation node = do
    let common@(RunNodeCommonWithStatus {..}) = runNodeCommon node
  
    (PrintFormatter {..}, _, _) <- ask
  
    childPrintFn <- case runTreeVisibilityLevel <= printFormatterVisibilityThreshold of
      True -> do
        pin runTreeLabel
        return withBumpIndent
      False -> return id
  
    case node of
      RunNodeIntroduce {..} -> childPrintFn $ forM_ runNodeChildrenAugmented runWithIndentation
      RunNodeIntroduceWith {..} -> childPrintFn $ forM_ runNodeChildrenAugmented runWithIndentation
      _ -> childPrintFn $ forM_ (runNodeChildren node) runWithIndentation
  
    result <- liftIO $ waitForTree node
  
    -- Print the failure reason
    case runTreeVisibilityLevel <= printFormatterVisibilityThreshold of
      True -> do
        case result of
          Failure r -> withBumpIndent $ printFailureReason r
          Cancelled -> return ()
          Success -> return ()
          DryRun -> return ()
        finishPrinting common result
      False -> case result of
          Failure r -> do
            pRedLn ("^ " <> runTreeLabel)
            printFailureReason r
            finishPrinting common result
          _ -> return ()
  