Source file `app_log.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
let header style c fmt () =
  Fmt.string fmt "[";
  Fmt.(styled style (const char c)) fmt ();
  Fmt.string fmt "]"

let app_log ?src pp_header f =
  Logs.app ?src (fun l ->
      f (fun ?header ?tags fmt -> l ?header ?tags ("%a " ^^ fmt) pp_header ()))

let status ?src f = app_log ?src (header `Yellow '-') f

let question ?src f = app_log ?src (header `Magenta '?') f

let success ?src f = app_log ?src (header `Green '+') f

let unhappy ?src f = app_log ?src (header `Red '!') f

let blank_line () = Logs.app (fun l -> l "")

let report_status status f =
  Logs.app (fun l ->
      f (fun ?header ?tags fmt ->
          l ?header ?tags ("%a " ^^ fmt) Text.Pp.status status))