This commit is contained in:
swrup 2026-02-18 17:26:53 +01:00
parent 1e30753ba9
commit 84472e93dd
160 changed files with 18460 additions and 90 deletions

View file

@ -0,0 +1,62 @@
module Log_reporter = struct
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 = Ptime_clock.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 "%04.02f")) 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 (Ptime_clock.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 }
(* TODO logs
- vif shouldn't use/set the default reporter
- Log.err all `Internal_server_error response *)
let setup () =
let level = Some Logs.Info in
Logs.set_level ~all:false level;
Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
Logs.Src.set_level Logs.default level;
Logs_threaded.enable ();
Logs.set_reporter reporter;
()
end