0 | ||| ANSI-coloured console output for log4types.
  1 | |||
  2 | ||| Severity-coloured bracketed tags and a coloured text renderer 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 System.File
  8 | import public Control.ANSI
  9 | import Log4Types.Core
 10 | import Log4Types.Format
 11 | import Log4Types.IO
 12 | import Log4Types.Message
 13 |
 14 | %default total
 15 |
 16 | ||| Pick an ANSI colour for a severity level.
 17 | |||
 18 | ||| Debug is green, Info blue, Warning yellow, Error red - matching the
 19 | ||| conventions used by most CLI tools.
 20 | public export
 21 | severityColor : Severity -> Color
 22 | severityColor Debug   = Green
 23 | severityColor Info    = Blue
 24 | severityColor Warning = Yellow
 25 | severityColor Error   = Red
 26 |
 27 | ||| Format a severity as a coloured bracketed tag.
 28 | |||
 29 | ||| The output is the same bracketed text as `fmtSeverity` (e.g. `[ERROR]`)
 30 | ||| wrapped in ANSI escape sequences for the matching colour.
 31 | public export
 32 | fmtColouredSeverity : Severity -> String
 33 | fmtColouredSeverity sev = show $ colored (severityColor sev) (fmtSeverity sev)
 34 |
 35 | ||| A LogRenderer that produces key=value text with a coloured severity tag
 36 | ||| when the renderer encounters a "severity" field.
 37 | |||
 38 | ||| Non-severity fields render exactly as `textRenderer` does.
 39 | public export
 40 | colouredTextRenderer : LogRenderer String
 41 | colouredTextRenderer = MkLogRenderer
 42 |   { addField  = \name, val, acc =>
 43 |       let field = if name == "severity"
 44 |                     then case val of
 45 |                            StrVal s => colourize s
 46 |                            _        => name ++ "=" ++ show val
 47 |                     else name ++ "=" ++ show val
 48 |       in if acc == "" then field else acc ++ " " ++ field
 49 |   , addNested = \name, build, acc =>
 50 |       let nested   = build ""
 51 |           prefixed = name ++ "." ++ nested
 52 |       in if acc == "" then prefixed else acc ++ " " ++ prefixed
 53 |   , empty     = ""
 54 |   , combine   = \a, b =>
 55 |       if a == "" then b
 56 |       else if b == "" then a
 57 |       else a ++ " " ++ b
 58 |   }
 59 |   where
 60 |     colourize : String -> String
 61 |     colourize "Debug"   = fmtColouredSeverity Debug
 62 |     colourize "Info"    = fmtColouredSeverity Info
 63 |     colourize "Warning" = fmtColouredSeverity Warning
 64 |     colourize "Error"   = fmtColouredSeverity Error
 65 |     colourize other     = "severity=\"" ++ other ++ "\""
 66 |
 67 | ||| True when stdout is connected to a terminal.
 68 | |||
 69 | ||| Used to decide whether ANSI colour codes should be emitted. When the
 70 | ||| output is redirected to a file or pipe, colours are suppressed.
 71 | export
 72 | stdoutIsTTY : HasIO io => io Bool
 73 | stdoutIsTTY = isTTY stdout
 74 |
 75 | ||| Render a Msg as a single line: coloured severity tag, message text,
 76 | ||| and any structured fields as `key=value` pairs.
 77 | public export
 78 | fmtColouredMsg : Msg -> String
 79 | fmtColouredMsg msg =
 80 |   let sevPart = fmtColouredSeverity msg.severity
 81 |       textPart = msg.text
 82 |       fieldsPart = foldl addFieldStr "" msg.fields
 83 |   in if fieldsPart == ""
 84 |        then sevPart ++ " " ++ textPart
 85 |        else sevPart ++ " " ++ textPart ++ " " ++ fieldsPart
 86 |   where
 87 |     addFieldStr : String -> (String, LogParamValue) -> String
 88 |     addFieldStr acc (k, v) =
 89 |       let part = k ++ "=" ++ show v
 90 |       in if acc == "" then part else acc ++ " " ++ part
 91 |
 92 | ||| Pick a Msg formatter based on TTY availability.
 93 | |||
 94 | ||| When `True`, returns the coloured formatter `fmtColouredMsg`.
 95 | ||| When `False`, falls back to plain `show` so redirected output stays clean.
 96 | public export
 97 | fmtMsgForTTY : (isTTY : Bool) -> Msg -> String
 98 | fmtMsgForTTY True  = fmtColouredMsg
 99 | fmtMsgForTTY False = show
100 |
101 | ||| A log action that writes Msg values to stdout with ANSI colouring
102 | ||| when stdout is a terminal, and plain text otherwise.
103 | export
104 | colouredLogStdout : HasIO io => io (LogAction io Msg)
105 | colouredLogStdout = do
106 |   tty <- stdoutIsTTY
107 |   pure $ cmap (fmtMsgForTTY tty) logStringStdout
108 |