From 0b6aa16ca771aa36cf082412532c6d930c6b43ed Mon Sep 17 00:00:00 2001
From: Vincent Bernardoff <vb@luminar.eu.org>
Date: Sat, 14 Jan 2017 13:13:45 +0100
Subject: [PATCH] Shell: improve logging (prepend the current time)

---
 src/utils/logging.ml  | 17 ++++++++++-------
 src/utils/logging.mli |  1 +
 2 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/src/utils/logging.ml b/src/utils/logging.ml
index 173fbb3d7..b41340dbf 100644
--- a/src/utils/logging.ml
+++ b/src/utils/logging.ml
@@ -30,7 +30,7 @@ let log_f
     Format.ikfprintf (fun _ -> Lwt.return_unit) Format.std_formatter format
   else
     Format.kasprintf
-      (Lwt_log.log ?exn ~section ?location ?logger ~level)
+      (fun msg -> Lwt_log.log ?exn ~section ?location ?logger ~level msg)
       format
 
 let ign_log_f
@@ -39,8 +39,7 @@ let ign_log_f
     Format.ikfprintf (fun _ -> ()) Format.std_formatter format
   else
     Format.kasprintf
-      (fun s ->
-         Lwt_log.ign_log ?exn ~section ?location ?logger ~level s)
+      (fun msg -> Lwt_log.ign_log ?exn ~section ?location ?logger ~level msg)
       format
 
 module Make(S : sig val name: string end) : LOG = struct
@@ -87,8 +86,10 @@ module Client = struct
 end
 module Webclient = Make(struct let name = "webclient" end)
 
+let template = "$(date) $(name)[$(pid)]: $(message)"
+
 let default_logger () =
-  Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stderr ()
+  Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stderr ()
 
 type kind =
   | Null
@@ -96,6 +97,7 @@ type kind =
   | Stderr
   | File of string
   | Syslog
+  | Manual of Lwt_log.logger
 
 let init kind =
   let logger =
@@ -103,12 +105,13 @@ let init kind =
     | Stderr ->
         default_logger ()
     | Stdout ->
-        Lwt_log.channel ~close_mode:`Keep ~channel:Lwt_io.stdout ()
+        Lwt_log.channel ~template ~close_mode:`Keep ~channel:Lwt_io.stdout ()
     | File file_name ->
-        Lwt_main.run (Lwt_log.file ~file_name ())
+        Lwt_main.run (Lwt_log.file ~file_name ~template ())
     | Null ->
         Lwt_log.null
     | Syslog ->
         Printf.eprintf "Warning: log_kind \"syslog\" not yet implemented.\n%!";
-        default_logger () in
+        default_logger ()
+    | Manual logger -> logger in
   Lwt_log.default := logger
diff --git a/src/utils/logging.mli b/src/utils/logging.mli
index 155ffa2ff..fb999b7b0 100644
--- a/src/utils/logging.mli
+++ b/src/utils/logging.mli
@@ -54,5 +54,6 @@ type kind =
   | Stderr
   | File of string
   | Syslog
+  | Manual of Lwt_log.logger
 
 val init: kind -> unit