0 | ||| ANSI-coloured console output for log4types.
 1 | |||
 2 | ||| Severity-coloured bracketed tags and coloured `key=value` text for
 3 | ||| development-time console logging. Colour codes are emitted only when
 4 | ||| stdout is a terminal; redirected output stays plain.
 5 | module Log4Types.ANSI
 6 |
 7 | import Data.String
 8 | import System.File
 9 | import public Control.ANSI
10 | import Log4Types.Core
11 | import Log4Types.Format
12 | import Log4Types.IO
13 | import Log4Types.Message
14 |
15 | %default total
16 |
17 | ||| Pick an ANSI colour for a severity level.
18 | |||
19 | ||| Debug is green, Info blue, Warning yellow, Error red - matching the
20 | ||| conventions used by most CLI tools.
21 | public export
22 | severityColor : Severity -> Color
23 | severityColor Debug   = Green
24 | severityColor Info    = Blue
25 | severityColor Warning = Yellow
26 | severityColor Error   = Red
27 |
28 | ||| Format a severity as a coloured bracketed tag.
29 | |||
30 | ||| The output is the same bracketed text as `fmtSeverity` (e.g. `[ERROR]`)
31 | ||| wrapped in ANSI escape sequences for the matching colour.
32 | public export
33 | fmtColouredSeverity : Severity -> String
34 | fmtColouredSeverity sev = show $ colored (severityColor sev) (fmtSeverity sev)
35 |
36 | ||| Render fields as `fmtFields` does, except a top-level "severity" field
37 | ||| naming a severity level, which renders as its coloured bracketed tag.
38 | public export
39 | fmtColouredFields : List (String, LogParamValue) -> String
40 | fmtColouredFields = unwords . map fmtColouredField
41 |   where
42 |     fmtColouredField : (String, LogParamValue) -> String
43 |     fmtColouredField ("severity", StrVal "Debug")   = fmtColouredSeverity Debug
44 |     fmtColouredField ("severity", StrVal "Info")    = fmtColouredSeverity Info
45 |     fmtColouredField ("severity", StrVal "Warning") = fmtColouredSeverity Warning
46 |     fmtColouredField ("severity", StrVal "Error")   = fmtColouredSeverity Error
47 |     fmtColouredField field                          = fmtFields [field]
48 |
49 | ||| True when stdout is connected to a terminal.
50 | |||
51 | ||| Used to decide whether ANSI colour codes should be emitted. When the
52 | ||| output is redirected to a file or pipe, colours are suppressed.
53 | export
54 | stdoutIsTTY : HasIO io => io Bool
55 | stdoutIsTTY = isTTY stdout
56 |
57 | ||| Render a Msg as a single line: coloured severity tag, message text,
58 | ||| and any structured fields as `key=value` pairs.
59 | public export
60 | fmtColouredMsg : Msg -> String
61 | fmtColouredMsg = fmtMsgWith fmtColouredSeverity
62 |
63 | ||| Pick a Msg formatter based on TTY availability.
64 | |||
65 | ||| When `True`, returns the coloured formatter `fmtColouredMsg`.
66 | ||| When `False`, falls back to plain `show` so redirected output stays clean.
67 | public export
68 | fmtMsgForTTY : (isTTY : Bool) -> Msg -> String
69 | fmtMsgForTTY True  = fmtColouredMsg
70 | fmtMsgForTTY False = show
71 |
72 | ||| A log action that writes Msg values to stdout with ANSI colouring
73 | ||| when stdout is a terminal, and plain text otherwise.
74 | export
75 | colouredLogStdout : HasIO io => io (LogAction io Msg)
76 | colouredLogStdout = do
77 |   tty <- stdoutIsTTY
78 |   pure $ cmap (fmtMsgForTTY tty) logStringStdout
79 |