69 lines
2 KiB
OCaml
69 lines
2 KiB
OCaml
let detail_tag : string Logs.Tag.def =
|
|
Logs.Tag.def "Detail tag" ~doc:"" Fmt.string
|
|
|
|
let detail s = Logs.Tag.(empty |> add detail_tag s)
|
|
let time_anchor = Mirage_ptime.now () |> Ptime.to_span
|
|
|
|
let color_of_log_level = function
|
|
| Logs.App -> `White
|
|
| Error -> `Red
|
|
| Warning -> `Yellow
|
|
| Info -> `Blue
|
|
| Debug -> `Magenta
|
|
|
|
let reporter : Logs.reporter =
|
|
let open Fmt in
|
|
let pp_timestamp = styled `Faint (styled (`Fg `White) (fmt "%09.04f")) in
|
|
let pp_header ppf v =
|
|
let color = color_of_log_level (fst v) in
|
|
let pp = styled (`Fg color) Logs.pp_header in
|
|
pf ppf "%a" pp v
|
|
in
|
|
let pp_src_name =
|
|
let pp = using Logs.Src.name (styled `Cyan (fmt "%s: ")) in
|
|
fun ppf v -> if not @@ Logs.Src.equal Logs.default v then pp ppf v
|
|
in
|
|
let pp_detail = option (styled `Green (fmt " (%s)")) in
|
|
let report src lvl ~over k msgf =
|
|
let ppf =
|
|
match lvl with
|
|
| Logs.App -> stdout
|
|
| Error | Warning | Info | Debug -> stderr
|
|
in
|
|
let k _ppf = over (); k () in
|
|
let with_detail h tags k user_fmt =
|
|
let detail = Option.bind tags (Logs.Tag.find detail_tag) in
|
|
let timestamp =
|
|
Ptime.sub_span (Mirage_ptime.now ()) time_anchor
|
|
|> Option.map Ptime.to_float_s
|
|
|> Option.value ~default:0.
|
|
in
|
|
let k ppf = kpf k ppf "%a@." pp_detail detail in
|
|
let k ppf = kpf k ppf user_fmt in
|
|
kpf k ppf "%a %a %a" pp_timestamp timestamp pp_header (lvl, h) pp_src_name
|
|
src
|
|
in
|
|
msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
|
|
in
|
|
{ report }
|
|
|
|
(*
|
|
let set_level_secmods lvl =
|
|
let secmod_srcs = [ Secmod_rsa.src; Secmod_eddsa.src ] in
|
|
List.iter (fun src -> Logs.Src.set_level src lvl) secmod_srcs;
|
|
()
|
|
*)
|
|
|
|
let setup level =
|
|
(* set_level_secmods level; *)
|
|
(*
|
|
let l = Logs.Src.list () in
|
|
let l =
|
|
List.filter (fun src -> Logs.Src.name src = "mnet.happy_eyeballs") l
|
|
in
|
|
List.iter (fun src -> Logs.Src.set_level src None) l;
|
|
*)
|
|
Logs.set_level ~all:false level;
|
|
Logs.Src.set_level Logs.default level;
|
|
Logs.set_reporter reporter;
|
|
()
|