src/dune

@@ -27,6 +27,7 @@
   ptime
   logs
   logs.fmt
+  logs.threaded
   fmt.tty))
 
 (library ; crockford base32

src/mte.ml

@@ -26,45 +26,44 @@ let log_level_color = function
   | Info -> `Blue
   | Debug -> `Magenta
 
-let reporter ppf : Logs.reporter =
+let reporter : Logs.reporter =
+  let open Fmt in
+  let pp_header ppf v =
+    let color = fst v |> log_level_color in
+    let pp = styled (`Fg color) Logs.pp_header in
+    pf ppf "%a" pp v
+  in
+  let pp_src ppf v =
+    let pp = using Logs.Src.name (styled `Cyan string) in
+    if 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 = stderr in
     let k _ppf = over (); k () in
-    let with_detail h tags k ppf user_fmt =
-      let detail =
-        Option.bind tags (Logs.Tag.find detail_tag) |> Option.value ~default:""
-      in
+    let with_detail h tags k user_fmt =
+      let detail = Option.bind tags (Logs.Tag.find detail_tag) in
       let dt =
         Ptime.sub_span (Ptime_clock.now ()) time_anchor
         |> Option.get
         |> Ptime.to_float_s
       in
-      let open Fmt in
-      let pp_header ppf v =
-        let color = fst v |> log_level_color in
-        let pp = styled (`Fg color) Logs.pp_header in
-        pf ppf "%a" pp v
-      in
-      let pp_src ppf src =
-        match Logs.Src.equal Logs.default src with
-        | true -> ()
-        | false -> pf ppf "%a: " (styled `Cyan string) (Logs.Src.name src)
-      in
-      let k ppf = kpf k ppf "%a@." (styled `Green (fmt " (%s)")) detail 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"
         (styled `Faint (styled (`Fg `White) (fmt "%04.02f")))
         dt pp_header (lvl, h) pp_src src
     in
-    msgf @@ fun ?header ?tags fmt -> with_detail header tags k ppf fmt
+    msgf @@ fun ?header ?tags fmt -> with_detail header tags k fmt
   in
   { report }
 
 let () =
   Fmt_tty.setup_std_outputs ~style_renderer:`Ansi_tty ~utf_8:true ();
-  Logs.set_reporter (reporter Fmt.stderr);
+  Logs.set_reporter reporter;
   Logs.set_level ~all:false (Some Logs.Debug);
   Logs.Src.set_level Logs.default (Some Logs.Debug);
-  (*Logs_threaded.enable ();*)
+  Logs_threaded.enable ();
   Printexc.record_backtrace true;
   ()