summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/Logging.ml130
1 files changed, 128 insertions, 2 deletions
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