From 44223d1c9186ef83f430d1f248b5be8f326918b4 Mon Sep 17 00:00:00 2001
From: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
Date: Mon, 7 Aug 2023 10:11:06 +0100
Subject: [PATCH] log: add pretty printer module

Because the debug module doesn't use best practices, pretty-printers using the
Format module are not ergonomic to use when they are needed for constructing
loglines.

Provide a module for adapters, containing Mtime's spans for the time being.

Signed-off-by: Pau Ruiz Safont <pau.ruizsafont@cloud.com>
---
 ocaml/libs/log/debug.ml            | 2 ++
 ocaml/libs/log/debug.mli           | 4 ++++
 ocaml/libs/log/dune                | 2 ++
 ocaml/xapi-guard/lib/disk_cache.ml | 4 ++--
 4 files changed, 10 insertions(+), 2 deletions(-)

diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml
index b4a5721b9e3..a38051a3cfb 100644
--- a/ocaml/libs/log/debug.ml
+++ b/ocaml/libs/log/debug.ml
@@ -352,3 +352,5 @@ functor
       try f ()
       with e -> log_backtrace_internal ~level:Syslog.Debug ~msg:"debug" e ()
   end
+
+module Pp = struct let mtime_span () = Fmt.str "%a" Mtime.Span.pp end
diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli
index af1b214b2fe..f6301c3d587 100644
--- a/ocaml/libs/log/debug.mli
+++ b/ocaml/libs/log/debug.mli
@@ -88,3 +88,7 @@ module Make : functor (_ : BRAND) -> DEBUG
 val is_disabled : string -> Syslog.level -> bool
 (** [is_disabled brand level] returns [true] if logging for [brand] at [level]
     is disabled, * otherwise returns [false]. *)
+
+module Pp : sig
+  val mtime_span : unit -> Mtime.Span.t -> string
+end
diff --git a/ocaml/libs/log/dune b/ocaml/libs/log/dune
index b8b637e7bf5..fdfd739d082 100644
--- a/ocaml/libs/log/dune
+++ b/ocaml/libs/log/dune
@@ -6,6 +6,8 @@
    (names syslog_stubs))
  (libraries
    astring
+   fmt
+   mtime
    logs
    threads.posix
    xapi-backtrace
diff --git a/ocaml/xapi-guard/lib/disk_cache.ml b/ocaml/xapi-guard/lib/disk_cache.ml
index 5e8b9bb0650..9674a4ff01b 100644
--- a/ocaml/xapi-guard/lib/disk_cache.ml
+++ b/ocaml/xapi-guard/lib/disk_cache.ml
@@ -398,9 +398,9 @@ end = struct
     let* failed = retry true in
     ( if failed then
         let elapsed = Mtime_clock.count counter in
-        D.debug "%s: Pushed %s after trying for %s" __FUN
+        D.debug "%s: Pushed %s after trying for %a" __FUN
           (print_key (uuid, timestamp, key))
-          (Fmt.to_to_string Mtime.Span.pp elapsed)
+          Debug.Pp.mtime_span elapsed
     ) ;
     Lwt.return_unit