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