talircd/lib/logging/pretty.ml

116 lines
2.7 KiB
OCaml

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 <- max 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