116 lines
2.7 KiB
OCaml
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
|
|
|