iitalics
/
talircd
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

split logging facilities into separate files

This commit is contained in:
tali 2024-01-31 18:14:09 -05:00
parent 3033fc87b2
commit 36d49a2f5d
4 changed files with 140 additions and 144 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
lib/logging/core.ml Normal file
View File

@ -0,0 +1,19 @@
type level =
| TRACE (* 0 *)
| DEBUG (* 1 *)
| INFO (* 2 *)
| WARN (* 3 *)
| ERROR (* 4 *)
external int_of_level : level -> int = "%identity"
type writer =
ts:Time.t ->
ns:string ->
lvl:level ->
string ->
unit
let ( +++ ) w1 w2 ~ts ~ns ~lvl msg =
w1 ~ts ~ns ~lvl msg;
w2 ~ts ~ns ~lvl msg

145
lib/logging/logging.ml
View File

@ -1,32 +1,4 @@
type level = include Core
| TRACE (* 0 *)
| DEBUG (* 1 *)
| INFO (* 2 *)
| WARN (* 3 *)
| ERROR (* 4 *)
external int_of_level : level -> int = "%identity"
module Time = struct
(* TODO: abstract this? *)
type t = Ptime.t
let stamp = Ptime_clock.now
let pp = Ptime.pp_rfc3339 ()
?tz_offset_s:(Ptime_clock.current_tz_offset_s ())
let to_string x =
Format.asprintf "%a" pp x
end
type writer =
ts:Time.t ->
ns:string ->
lvl:level ->
string ->
unit
let ( +++ ) w1 w2 ~ts ~ns ~lvl msg =
w1 ~ts ~ns ~lvl msg;
w2 ~ts ~ns ~lvl msg
type logger = { type logger = {
namespace : string; namespace : string;
@ -115,121 +87,6 @@ let rec add_writer_rec min_level writer parent_logger logger =
let[@inline] add_writer ?(min_level = WARN) writer = let[@inline] add_writer ?(min_level = WARN) writer =
add_writer_rec (int_of_level min_level) writer root_logger root_logger.child add_writer_rec (int_of_level min_level) writer root_logger root_logger.child
module Pretty = struct
type t = {
mutex : Mutex.t;
bp : Buffer.t;
mutable align_to : int;
out : out_channel;
flags : int;
}
type config = {
color : bool;
timestamp : bool;
namespace : bool;
level : bool;
}
let _fl_c = 1 (* color *)
let _fl_t = 2 (* timestamp *)
let _fl_n = 4 (* namespace *)
let _fl_l = 8 (* level *)
let _fl_ct = _fl_c + _fl_t
let _fl_cl = _fl_c + _fl_l
let header = function
| TRACE -> "TRACE"
| DEBUG -> "DEBUG"
| INFO -> "INFO"
| WARN -> "WARN"
| ERROR -> "ERROR"
let ansi_header = function
| TRACE -> "\x1b[34m"
| DEBUG -> "\x1b[36m"
| INFO -> "\x1b[32m"
| WARN -> "\x1b[33m"
| ERROR -> "\x1b[31m"
let ansi_dim = "\x1b[2m"
let ansi_bold = "\x1b[1m"
let ansi_off = "\x1b[0m"
let pr_timestamp bp ts =
Buffer.add_string bp (Time.to_string ts)
let pr_spaces bp n =
for _ = 1 to n do
Buffer.add_char bp ' '
done
let rec pr_lines_rec indent bp s i =
match String.index_from s i '\n' with
| exception Not_found ->
Buffer.add_substring bp s i (String.length s - i)
| k ->
Buffer.add_substring bp s i (k + 1 - i);
pr_spaces bp indent;
pr_lines_rec indent bp s (k + 1)
let pr_lines ~indent bp s =
pr_lines_rec indent bp s 0
let make (out : out_channel) (cfg : config) = {
mutex = Mutex.create ();
bp = Buffer.create 512;
align_to = 0;
out;
flags = (if cfg.color then _fl_c else 0) +
(if cfg.timestamp then _fl_t else 0) +
(if cfg.namespace then _fl_n else 0) +
(if cfg.level then _fl_l else 0)
}
let pr_msg bp msg ts ns lvl ~align ~indent ~f =
begin
if f _fl_ct then Buffer.add_string bp ansi_dim;
if f _fl_t then Printf.bprintf bp "%a " pr_timestamp ts;
if f _fl_ct then Buffer.add_string bp ansi_off;
if f _fl_n then Printf.bprintf bp "%s " ns;
if f _fl_n then pr_spaces bp (align bp);
if f _fl_cl then Buffer.add_string bp (ansi_header lvl);
if f _fl_l then Printf.bprintf bp "%-5s " (header lvl);
if f _fl_cl then Buffer.add_string bp ansi_off;
if f _fl_c then Buffer.add_string bp ansi_bold;
pr_lines bp msg ~indent:(indent bp);
if f _fl_c then Buffer.add_string bp ansi_off;
Buffer.add_string bp "\n";
end
let writer t ~ts ~ns ~lvl msg =
let f mask = t.flags land mask = mask in
let align bp =
let n = t.align_to - Buffer.length bp in
t.align_to <- Buffer.length bp;
n
in
let indent bp =
Buffer.length bp
- (if f _fl_c then 4 else 0)
- (if f _fl_ct then 8 else 0)
- (if f _fl_cl then 9 else 0)
in
begin
Mutex.lock t.mutex;
pr_msg t.bp msg ts ns lvl ~align ~indent ~f;
Buffer.output_buffer t.out t.bp;
flush t.out;
Buffer.clear t.bp;
Mutex.unlock t.mutex
end
end
let init_pretty_writer let init_pretty_writer
?min_level ?min_level
?(color = true) ?(color = true)

115
lib/logging/pretty.ml Normal file
View File

@ -0,0 +1,115 @@
open Core
type t = {
mutex : Mutex.t;
bp : Buffer.t;
mutable align_to : int;
out : out_channel;
flags : int;
}
type config = {
color : bool;
timestamp : bool;
namespace : bool;
level : bool;
}
let _fl_c = 1 (* color *)
let _fl_t = 2 (* timestamp *)
let _fl_n = 4 (* namespace *)
let _fl_l = 8 (* level *)
let _fl_ct = _fl_c + _fl_t
let _fl_cl = _fl_c + _fl_l
let header = function
| TRACE -> "TRACE"
| DEBUG -> "DEBUG"
| INFO -> "INFO"
| WARN -> "WARN"
| ERROR -> "ERROR"
let ansi_header = function
| TRACE -> "\x1b[34m"
| DEBUG -> "\x1b[36m"
| INFO -> "\x1b[32m"
| WARN -> "\x1b[33m"
| ERROR -> "\x1b[31m"
let ansi_dim = "\x1b[2m"
let ansi_bold = "\x1b[1m"
let ansi_off = "\x1b[0m"
let pr_timestamp bp ts =
Buffer.add_string bp (Time.to_string ts)
let pr_spaces bp n =
for _ = 1 to n do
Buffer.add_char bp ' '
done
let rec pr_lines_rec indent bp s i =
match String.index_from s i '\n' with
| exception Not_found ->
Buffer.add_substring bp s i (String.length s - i)
| k ->
Buffer.add_substring bp s i (k + 1 - i);
pr_spaces bp indent;
pr_lines_rec indent bp s (k + 1)
let pr_lines ~indent bp s =
pr_lines_rec indent bp s 0
let make (out : out_channel) (cfg : config) = {
mutex = Mutex.create ();
bp = Buffer.create 512;
align_to = 0;
out;
flags = (if cfg.color then _fl_c else 0) +
(if cfg.timestamp then _fl_t else 0) +
(if cfg.namespace then _fl_n else 0) +
(if cfg.level then _fl_l else 0)
}
let pr_msg bp msg ts ns lvl ~align ~indent ~f =
begin
if f _fl_ct then Buffer.add_string bp ansi_dim;
if f _fl_t then Printf.bprintf bp "%a " pr_timestamp ts;
if f _fl_ct then Buffer.add_string bp ansi_off;
if f _fl_n then Printf.bprintf bp "%s " ns;
if f _fl_n then pr_spaces bp (align bp);
if f _fl_cl then Buffer.add_string bp (ansi_header lvl);
if f _fl_l then Printf.bprintf bp "%-5s " (header lvl);
if f _fl_cl then Buffer.add_string bp ansi_off;
if f _fl_c then Buffer.add_string bp ansi_bold;
pr_lines bp msg ~indent:(indent bp);
if f _fl_c then Buffer.add_string bp ansi_off;
Buffer.add_string bp "\n";
end
let writer t ~ts ~ns ~lvl msg =
let f mask = t.flags land mask = mask in
let align bp =
let n = t.align_to - Buffer.length bp in
t.align_to <- Buffer.length bp;
n
in
let indent bp =
Buffer.length bp
- (if f _fl_c then 4 else 0)
- (if f _fl_ct then 8 else 0)
- (if f _fl_cl then 9 else 0)
in
begin
Mutex.lock t.mutex;
pr_msg t.bp msg ts ns lvl ~align ~indent ~f;
Buffer.output_buffer t.out t.bp;
flush t.out;
Buffer.clear t.bp;
Mutex.unlock t.mutex
end

5
lib/logging/time.ml Normal file
View File

@ -0,0 +1,5 @@
type t = Ptime.t
let stamp = Ptime_clock.now
let pp = Ptime.pp_rfc3339 ()
?tz_offset_s:(Ptime_clock.current_tz_offset_s ())
let to_string x = Format.asprintf "%a" pp x