blob: a1060014f257abf121f6578db3503eb1eb77570f (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
|
module H = Easy_logging.Handlers
module L = Easy_logging.Logging
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
|
