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
# 1 "src/base/misc/owl_log.ml"
(** Log module provides logging functionality. *)
[@@@warning "-37"]
type color =
| Red
| Green
| Yellow
| Blue
| Magenta
| Cyan
type level =
| DEBUG
| INFO
| WARN
| ERROR
| FATAL
let _level_to_int = function
| DEBUG -> 0
| INFO -> 1
| WARN -> 2
| ERROR -> 3
| FATAL -> 4
let _color_to_str = function
| Red -> "\027[31m"
| Green -> "\027[32m"
| Yellow -> "\027[33m"
| Blue -> "\027[34m"
| Magenta -> "\027[35m"
| Cyan -> "\027[36m"
let _level = ref INFO
let _output = ref stdout
let _colorful = ref true
let set_level x = _level := x
let set_output x = _output := x
let set_color x = _colorful := x
let _shall_print x = _level_to_int x >= _level_to_int !_level
let _shall_paint c s =
match !_colorful with
| true -> _color_to_str c ^ s ^ "\027[0m"
| false -> s
let _level_to_str = function
| DEBUG -> _shall_paint Cyan "DEBUG"
| INFO -> _shall_paint Green "INFO"
| WARN -> _shall_paint Yellow "WARN"
| ERROR -> _shall_paint Red "ERROR"
| FATAL -> _shall_paint Magenta "FATAL"
let make_prefix lvl =
let ts = Unix.gettimeofday () in
let tm = Unix.localtime ts in
Printf.sprintf
"%04d-%02d-%02d %02d:%02d:%02d.%03d %s : "
(tm.Unix.tm_year + 1900)
(tm.Unix.tm_mon + 1)
tm.Unix.tm_mday
tm.Unix.tm_hour
tm.Unix.tm_min
tm.Unix.tm_sec
(modf ts |> fst |> ( *. ) 1000. |> int_of_float)
(_level_to_str lvl)
let _log lvl fmt =
match _shall_print lvl with
| true -> Printf.fprintf !_output ("%s" ^^ fmt ^^ "\n%!") (make_prefix lvl)
| false -> Printf.ifprintf !_output fmt
let info fmt = _log INFO fmt
let debug fmt = _log DEBUG fmt
let warn fmt = _log WARN fmt
let error fmt = _log ERROR fmt
let fatal fmt = _log FATAL fmt