1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
|
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
-- : dep rainbow
module Biz.Log
( Lvl (..),
good,
pass,
info,
warn,
fail,
-- Debugging
mark,
-- Operators
(~&),
(~?),
-- | Low-level
msg,
br,
)
where
import Alpha hiding (pass)
import qualified Data.Text as Text
import Rainbow (chunk, fore, green, magenta, putChunk, red, white, yellow)
import System.IO.Unsafe (unsafePerformIO)
data Lvl = Good | Pass | Info | Warn | Fail | Mark
msg :: Lvl -> [Text] -> IO ()
msg lvl labels = putChunk <| fore color <| clear <> txt <> "\r"
where
txt = chunk <| Text.intercalate gap (label : labels)
(color, label) = case lvl of
Good -> (green, "good")
Pass -> (green, "pass")
Info -> (white, "info")
Warn -> (yellow, "warn")
Fail -> (red, "fail")
Mark -> (magenta, "mark")
clear = "\ESC[2K"
gap :: Text
gap = ": "
br :: IO ()
br = putChunk "\n"
good, pass, info, warn, fail :: [Text] -> IO ()
good = msg Good
pass = msg Pass
info = msg Info
warn = msg Warn
fail = msg Fail
-- | Like 'Debug.trace' but follows the patterns in this module
mark :: Show a => Text -> a -> a
mark label val =
unsafePerformIO <| do
msg Mark [label, tshow val]
pure val
-- | Pipelined version of 'mark'.
--
-- @
-- mark label val = val ~| label
-- @
(~&) :: Show a => a -> Text -> a
(~&) val label = mark label val
-- | Conditional mark.
(~?) :: Show a => a -> (a -> Bool) -> Text -> a
(~?) val test label = if test val then mark label val else val
|
