Commits

Sebastien Mondet  committed d022701

Improve display in logger

  • Participants
  • Parent commits d5762af

Comments (0)

Files changed (2)

     let get_exn = get
     let get s ~index = try Some (get_exn s index) with _ -> None
     let sub_exn = sub
+    let find_index s ~char = try Some (rindex s char) with _ -> None 
   end
 
 end
   include Metadoc
   
   let print log_kind t =
-    let display formatted =
-      P.print_string 
-        (SmartPrint.to_string P.line_width P.indent formatted)
-    in
+    let convert_to_string formatted =
+      SmartPrint.to_string P.line_width P.indent formatted in
+    let display formatted = convert_to_string formatted |> P.print_string in
     let using_colors = P.with_color () in
     let no_color t = t in
     let normal_color = if using_colors then bold_green else no_color in
     let error_color = if using_colors then bold_red else no_color in
     let warning_color = if using_colors then bold_yellow else no_color in
     let debug_color = if using_colors then greyish else no_color in
-    let format_log ?(color_t=no_color) head t =
+    let format_log ?(color_h=no_color) ?(color_t=no_color) head t =
+      let colorless = head % t in
+      let has_newline =
+        String.find_index (convert_to_string colorless) ~char:'\n' <> None in
       display (
-        head % string " " 
-        % color_t (
-            group (braces (space ^-^ indent  t ^-^ space)) ^^ newline)
+        color_h (brakets head)
+        % string " " 
+        % (if has_newline
+          then color_t (n % indent t)
+          else color_t t)
+        % newline
       ) in
     match log_kind with
-    | `Normal -> format_log (normal_color (string P.name)) t
-    | `Error -> format_log (error_color (s P.name % s ": ERROR")) t
-    | `Warning -> format_log (warning_color (s P.name % s ": Warning")) t
+    | `Normal -> 
+      format_log ~color_h:normal_color (string P.name) t
+    | `Error -> 
+      format_log ~color_h:error_color (s P.name % s ": ERROR") t
+    | `Warning -> 
+      format_log ~color_h:warning_color (s P.name % s ": Warning") t
     | `Debug level when P.debug_level () >= level ->
-      format_log  (debug_color (s P.name %s  ": debug")) ~color_t:debug_color t
+      format_log  ~color_h:debug_color (s P.name %s  ": debug")
+        ~color_t:debug_color t
     | `Debug _ -> P.do_nothing ()
 
   let (@) t kind = print kind t
   end)
 
 let print_stuff () =
-  Log.(s "some stuff" % n @ normal);
-  Log.(s "some error" % n @ error);
-  Log.(s "debug level things" % n @ verbose);
+  Log.(s "some stuff"  @ normal);
+  Log.(s "some error"  @ error);
+  Log.(s "debug level things" @ verbose);
+  Log.(s "debug level things that are much longer than one line bla bla bla bla
+          bla bla bla bla bla bla bla bla bla bla bla " @ verbose);
   ()
 
 let () =