blob: 2759854c235061a2a680ff4466906803c315d3b2 (
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
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
|
module H = Easy_logging.Handlers
module L = Easy_logging.Logging
let _ = L.make_logger "MainLogger" Debug [ Cli Debug ]
(** The main logger *)
let log = L.get_logger "MainLogger"
(** Below, we create subgloggers for various submodules, so that we can precisely
toggle logging on/off, depending on which information we need *)
(** Logger for Interpreter *)
let interpreter_log = L.get_logger "MainLogger.Interpreter"
(** Logger for InterpreterStatements *)
let statements_log = L.get_logger "MainLogger.Interpreter.Statements"
(** Logger for InterpreterExpressions *)
let expressions_log = L.get_logger "MainLogger.Interpreter.Expressions"
(** Logger for InterpreterExpansion *)
let expansion_log = L.get_logger "MainLogger.Interpreter.Expansion"
(** Logger for InterpreterBorrows *)
let borrows_log = L.get_logger "MainLogger.Interpreter.Borrows"
(** Logger for Invariants *)
let invariants_log = L.get_logger "MainLogger.Interpreter.Invariants"
(** 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
|
