Source file logs_sem.ml

(** This file implements a Log_fmt like module that introduced
    semantic tags instead of ansi colors *)

let pp_header ~pp_h ppf (l, h) = match l with
| Logs.App ->
    begin match h with
    | None -> ()
    | Some h -> Format.fprintf ppf "[%a] " PPUtils.app_pp h
    end
| Logs.Error ->
    pp_h ppf PPUtils.err_pp (match h with None -> "ERROR" | Some h -> h)
| Logs.Warning ->
    pp_h ppf PPUtils.warn_pp (match h with None -> "WARNING" | Some h -> h)
| Logs.Info ->
    pp_h ppf PPUtils.info_pp (match h with None -> "INFO" | Some h -> h)
| Logs.Debug ->
    pp_h ppf PPUtils.debug_pp (match h with None -> "DEBUG" | Some h -> h)

let pp_exec_header =
  let x = match Array.length Sys.argv with
  | 0 -> Filename.basename Sys.executable_name
  | _n -> Filename.basename Sys.argv.(0)
  in
  let pp_h ppf style h = Fmt.pf ppf "%s: [%a] " x style h in
  pp_header ~pp_h

let reporter ?(pp_header = pp_exec_header) ?app ?dst () =
  Logs.format_reporter ~pp_header ?app ?dst ()
[@@warning "-unused-value-declaration"]

let pp_header =
  let pp_h ppf style h = Fmt.pf ppf "[%a]" style h in
  pp_header ~pp_h