open Core type t = { mutex : Mutex.t option; out : out_channel; bp : Buffer.t; mutable align_to : int; } let make mutex out = { mutex; out; bp = Buffer.create 512; align_to = 0; } (* TODO: config colors *) (* TODO: config timestamp *) (* TODO: config namespace *) let level_header = function | TRACE -> "TRACE" | DEBUG -> "DEBUG" | INFO -> "INFO" | WARN -> "WARN" | ERROR -> "ERROR" let level_ansi = function | TRACE -> [Ansi.Fg (Some U)] | DEBUG -> [Ansi.Fg (Some C)] | INFO -> [Ansi.Fg (Some G)] | WARN -> [Ansi.Fg (Some Y)] | ERROR -> [Ansi.Fg (Some R)] let pr_timestamp bp ts = (* TODO: timestamp format options *) let ts_ms = int_of_float (ts *. 1000.0) mod 1000 in let tm = Unix.localtime ts in Printf.bprintf bp "%04d-%02d-%02d %02d:%02d:%02d.%03d" (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec ts_ms 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 writer t ~timestamp ~namespace ~level msg = begin Option.iter Mutex.lock t.mutex; Printf.bprintf t.bp "%a%a%a %s " Ansi.pr [Bold true] pr_timestamp timestamp Ansi.pr [Bold false] namespace; pr_spaces t.bp (t.align_to - Buffer.length t.bp); t.align_to <- Buffer.length t.bp; Printf.bprintf t.bp "%a%-5s%a " Ansi.pr (level_ansi level) (level_header level) Ansi.pr [Bold true; Fg None]; let indent = (* TODO: calculate this differently depending on color settings *) t.align_to - 3 in pr_lines t.bp msg ~indent; Printf.bprintf t.bp "%a\n" Ansi.pr [Bold false]; Buffer.output_buffer t.out t.bp; flush t.out; Buffer.clear t.bp; Option.iter Mutex.unlock t.mutex end