
  0 | module Evince.Reporter.Console
  1 | 
  2 | import Data.List
  3 | import Data.String
  4 | import Evince.Core
  5 | import Evince.Diff
  6 | import Evince.Report
  7 | import Evince.Reporter
  8 | 
  9 | -- ANSI escape sequences
 10 | esc : String -> String -> String
 11 | esc code text = "\x1b[" ++ code ++ "m" ++ text ++ "\x1b[0m"
 12 | 
 13 | green : String -> String
 14 | green = esc "32"
 15 | 
 16 | red : String -> String
 17 | red = esc "31"
 18 | 
 19 | yellow : String -> String
 20 | yellow = esc "33"
 21 | 
 22 | indent : Nat -> String
 23 | indent Z     = ""
 24 | indent (S k) = "  " ++ indent k
 25 | 
 26 | formatDuration : Integer -> String
 27 | formatDuration nanos =
 28 |   let ms = nanos `div` 1000000
 29 |   in if ms >= 1000
 30 |        then nanosToSeconds nanos ++ "s"
 31 |        else show ms ++ "ms"
 32 | 
 33 | printDescribe : String -> Nat -> IO ()
 34 | printDescribe label level = putStrLn $ indent level ++ label
 35 | 
 36 | printPending : String -> Maybe String -> Nat -> IO ()
 37 | printPending label Nothing level =
 38 |   putStrLn $ indent level ++ yellow ("○ " ++ label ++ " (pending)")
 39 | printPending label (Just reason) level =
 40 |   putStrLn $ indent level ++ yellow ("○ " ++ label ++ " (" ++ reason ++ ")")
 41 | 
 42 | printTestDone : RunConfig -> TestReport -> Nat -> IO ()
 43 | printTestDone cfg report level =
 44 |   case report.outcome of
 45 |     Passed elapsed => do
 46 |       let label = lastLabel report.path
 47 |       let timing = if cfg.showTiming then " (" ++ formatDuration elapsed ++ ")" else ""
 48 |       putStrLn $ indent level ++ green ("✓ " ++ label) ++ timing
 49 |     Failed info elapsed => do
 50 |       let label = lastLabel report.path
 51 |       let timing = if cfg.showTiming then " (" ++ formatDuration elapsed ++ ")" else ""
 52 |       let locStr = maybe "" (\l => " (" ++ show l ++ ")") report.loc
 53 |       putStrLn $ indent level ++ red ("✗ " ++ label) ++ locStr ++ timing
 54 |       let detailIndent = indent (S level)
 55 |       case failureDiff info of
 56 |         Just (reason, diffs) => do
 57 |           putStrLn $ detailIndent ++ red reason
 58 |           for_ diffs $ \d => putStrLn $ detailIndent ++ case d of
 59 |             LineSame _    => renderLineDiffPlain d
 60 |             LineRemoved _ => red (renderLineDiffPlain d)
 61 |             LineAdded _   => green (renderLineDiffPlain d)
 62 |         Nothing => for_ (lines (show info)) $ \line =>
 63 |           putStrLn $ detailIndent ++ red line
 64 |     Skipped reason => printPending (lastLabel report.path) reason level
 65 |   where
 66 |     lastLabel : List String -> String
 67 |     lastLabel [] = ""
 68 |     lastLabel [x] = x
 69 |     lastLabel (_ :: xs) = lastLabel xs
 70 | 
 71 | printSummary : RunConfig -> Summary -> IO ()
 72 | printSummary cfg s = do
 73 |   putStrLn ""
 74 |   let parts = [ green (show s.passed ++ " passing")
 75 |               , red (show s.failed ++ " failing")
 76 |               , yellow (show s.pending ++ " pending")
 77 |               ]
 78 |   let timing = if cfg.showTiming then " (" ++ formatDuration s.duration ++ ")" else ""
 79 |   putStrLn $ "  " ++ concat (intersperse ", " parts) ++ timing
 80 | 
 81 | ||| Create a console reporter that prints colored test results to stdout.
 82 | export
 83 | consoleReporter : RunConfig -> Reporter
 84 | consoleReporter cfg = MkReporter $ \case
 85 |   SuiteStarted           => pure ()
 86 |   GroupStarted label lvl  => printDescribe label lvl
 87 |   GroupDone _             => pure ()
 88 |   TestDone report lvl     => printTestDone cfg report lvl
 89 |   PendingTest label reason lvl => printPending label reason lvl
 90 |   SuiteDone summary       => printSummary cfg summary
 91 |