ohlog/lib/pretty_print.ml

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