From 7352e6132d1ce00809b9b2b85bea8eac2c7bf1b7 Mon Sep 17 00:00:00 2001
From: Son Ho
Date: Tue, 7 Dec 2021 17:45:07 +0100
Subject: Update the formatting for the logger

---
 src/Logging.ml | 130 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 128 insertions(+), 2 deletions(-)

(limited to 'src/Logging.ml')

diff --git a/src/Logging.ml b/src/Logging.ml
index b1512af7..a1060014 100644
--- a/src/Logging.ml
+++ b/src/Logging.ml
@@ -1,3 +1,129 @@
-let _ = Easy_logging.Logging.make_logger "MainLogger" Debug [ Cli Debug ]
+module H = Easy_logging.Handlers
+module L = Easy_logging.Logging
 
-let log = Easy_logging.Logging.get_logger "MainLogger"
+let _ = L.make_logger "MainLogger" Debug [ Cli Debug ]
+
+let log = L.get_logger "MainLogger"
+
+(** Terminal colors - TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+type color =
+  | Default
+  | Black
+  | Red
+  | Green
+  | Yellow
+  | Blue
+  | Magenta
+  | Cyan
+  | Gray
+  | White
+  | LRed
+  | LGreen
+  | LYellow
+  | LBlue
+  | LMagenta
+  | LCyan
+  | LGray
+
+(** Terminal styles - TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+type format = Bold | Underline | Invert | Fg of color | Bg of color
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let to_fg_code c =
+  match c with
+  | Default -> 39
+  | Black -> 30
+  | Red -> 31
+  | Green -> 32
+  | Yellow -> 33
+  | Blue -> 34
+  | Magenta -> 35
+  | Cyan -> 36
+  | Gray -> 90
+  | White -> 97
+  | LRed -> 91
+  | LGreen -> 92
+  | LYellow -> 93
+  | LBlue -> 94
+  | LMagenta -> 95
+  | LCyan -> 96
+  | LGray -> 37
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let to_bg_code c =
+  match c with
+  | Default -> 49
+  | Black -> 40
+  | Red -> 41
+  | Green -> 42
+  | Yellow -> 43
+  | Blue -> 44
+  | Magenta -> 45
+  | Cyan -> 46
+  | Gray -> 100
+  | White -> 107
+  | LRed -> 101
+  | LGreen -> 102
+  | LYellow -> 103
+  | LBlue -> 104
+  | LMagenta -> 105
+  | LCyan -> 106
+  | LGray -> 47
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let style_to_codes s =
+  match s with
+  | Bold -> (1, 21)
+  | Underline -> (4, 24)
+  | Invert -> (7, 27)
+  | Fg c -> (to_fg_code c, to_fg_code Default)
+  | Bg c -> (to_bg_code c, to_bg_code Default)
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let level_to_color (lvl : L.level) =
+  match lvl with
+  | L.Flash -> LMagenta
+  | Error -> LRed
+  | Warning -> LYellow
+  | Info -> LBlue
+  | Trace -> Cyan
+  | Debug -> Green
+  | NoLevel -> Default
+
+(** [format styles str] formats [str] to the given [styles] -
+    TODO: comes from easy_logging (did not manage to reuse the module directl)
+*)
+let rec format styles str =
+  match styles with
+  | (_ as s) :: styles' ->
+      let set, reset = style_to_codes s in
+      Printf.sprintf "\027[%dm%s\027[%dm" set (format styles' str) reset
+  | [] -> str
+
+(** TODO: comes from easy_logging (did not manage to reuse the module directly) *)
+let format_tags (tags : string list) =
+  match tags with
+  | [] -> ""
+  | _ ->
+      let elems_str = String.concat " | " tags in
+      "[" ^ elems_str ^ "] "
+
+(* Change the formatters *)
+let _ =
+  (* TODO: comes from easy_logging *)
+  let formatter (item : L.log_item) : string =
+    let item_level_fmt =
+      format [ Fg (level_to_color item.level) ] (L.show_level item.level)
+    and item_msg_fmt =
+      match item.level with
+      | Flash -> format [ Fg Black; Bg LMagenta ] item.msg
+      | _ -> item.msg
+    in
+
+    Format.pp_set_max_indent Format.str_formatter 200;
+    Format.sprintf "@[[%-15s] %s%s@]" item_level_fmt (format_tags item.tags)
+      item_msg_fmt
+  in
+  (* There should be exactly one handler *)
+  let handlers = log#get_handlers in
+  List.map (fun h -> H.set_formatter h formatter) handlers
-- 
cgit v1.2.3