make pretty logging configurable

lib/logging/logging.ml

@@ -111,13 +111,22 @@ module Pretty = struct
     bp : Buffer.t;
     mutable align_to : int;
     out : out_channel;
+    flags : int;
   }
 
-  (* TODO: config these per writer *)
-  let _color = true
-  let _timestamp = true
-  let _namespace = true
-  let _level = true
+  type config = {
+    color : bool;
+    timestamp : bool;
+    namespace : bool;
+    level : bool;
+  }
+
+  let _fl_c = 1 (* color *)
+  let _fl_t = 2 (* timestamp *)
+  let _fl_n = 4 (* namespace *)
+  let _fl_l = 8 (* level *)
+  let _fl_ct = _fl_c + _fl_t
+  let _fl_cl = _fl_c + _fl_l
 
   let header = function
     | TRACE -> "TRACE"
@@ -133,9 +142,9 @@ module Pretty = struct
     | WARN  -> "\x1b[33m"
     | ERROR -> "\x1b[31m"
 
-  let ansi_dim = "\x1b[2m"
+  let ansi_dim  = "\x1b[2m"
   let ansi_bold = "\x1b[1m"
-  let ansi_off = "\x1b[0m"
+  let ansi_off  = "\x1b[0m"
 
   let pr_timestamp bp ts =
     let ts_ms = int_of_float (ts *. 1000.0) mod 1000 in
@@ -161,51 +170,53 @@ module Pretty = struct
   let pr_lines ~indent bp s =
     pr_lines_rec indent bp s 0
 
-  let make (out : out_channel) = {
+  let make (out : out_channel) (cfg : config) = {
     mutex = Mutex.create ();
     bp = Buffer.create 512;
     align_to = 0;
     out;
+    flags = (if cfg.color     then _fl_c else 0) +
+            (if cfg.timestamp then _fl_t else 0) +
+            (if cfg.namespace then _fl_n else 0) +
+            (if cfg.level     then _fl_l else 0)
   }
 
-  let pr_msg bp msg ts ns lvl ~align ~indent =
+  let pr_msg bp msg ts ns lvl ~align ~indent ~f =
     begin
-      if _timestamp && _color then Buffer.add_string bp ansi_dim;
-      if _timestamp then Printf.bprintf bp "%a " pr_timestamp ts;
-      if _timestamp && _color then Buffer.add_string bp ansi_off;
+      if f _fl_ct then Buffer.add_string bp ansi_dim;
+      if f _fl_t  then Printf.bprintf bp "%a " pr_timestamp ts;
+      if f _fl_ct then Buffer.add_string bp ansi_off;
 
-      if _namespace then Printf.bprintf bp "%s " ns;
-      if _namespace then pr_spaces bp (align bp);
+      if f _fl_n then Printf.bprintf bp "%s " ns;
+      if f _fl_n then pr_spaces bp (align bp);
 
-      if _level && _color then Buffer.add_string bp (ansi_header lvl);
-      if _level then Printf.bprintf bp "%-5s " (header lvl);
-      if _level && _color then Buffer.add_string bp ansi_off;
+      if f _fl_cl then Buffer.add_string bp (ansi_header lvl);
+      if f _fl_l then Printf.bprintf bp "%-5s " (header lvl);
+      if f _fl_cl then Buffer.add_string bp ansi_off;
 
-      if _color then Buffer.add_string bp ansi_bold;
+      if f _fl_c then Buffer.add_string bp ansi_bold;
       pr_lines bp msg ~indent:(indent bp);
-      if _color then Buffer.add_string bp ansi_off;
+      if f _fl_c then Buffer.add_string bp ansi_off;
 
       Buffer.add_string bp "\n";
     end
 
   let writer t ~ts ~ns ~lvl msg =
+    let f mask = t.flags land mask = mask in
     let align bp =
       let n = t.align_to - Buffer.length bp in
       t.align_to <- Buffer.length bp;
       n
     in
     let indent bp =
-      let subtract =
-        if _color then
-          4 + (if _timestamp then 8 else 0) + (if _level then 9 else 0)
-        else
-          0
-      in
-      Buffer.length bp - subtract
+      Buffer.length bp
+      - (if f _fl_c  then 4 else 0)
+      - (if f _fl_ct then 8 else 0)
+      - (if f _fl_cl then 9 else 0)
     in
     begin
       Mutex.lock t.mutex;
-      pr_msg t.bp msg ts ns lvl ~align ~indent;
+      pr_msg t.bp msg ts ns lvl ~align ~indent ~f;
       Buffer.output_buffer t.out t.bp;
       flush t.out;
       Buffer.clear t.bp;
@@ -213,7 +224,14 @@ module Pretty = struct
     end
 end
 
-let init_pretty_writer ?min_level out =
-  Pretty.make out |>
+let init_pretty_writer
+      ?min_level
+      ?(color = true)
+      ?(timestamp = true)
+      ?(namespace = true)
+      ?(level = true)
+      out
+  =
+  Pretty.make out { color; timestamp; namespace; level } |>
   Pretty.writer |>
   add_writer ?min_level

lib/logging/logging.mli

@@ -25,5 +25,9 @@ val logs : string -> (module Logs)
 val sublogs : logger -> string -> (module Logs)
 
 val init_pretty_writer :
-  ?min_level:level
-  -> out_channel -> unit
+  ?min_level:level ->
+  ?color:bool ->
+  ?timestamp:bool ->
+  ?namespace:bool ->
+  ?level:bool ->
+  out_channel -> unit