include Core

type logger = {
  namespace : string;
  mutable child : logger;
  sibling : logger;
  mutable min_level : int;
  mutable writers : writer option;
}

let rec root_logger = {
  namespace = "";
  min_level = 0;
  child = root_logger;
  sibling = root_logger;
  writers = None;
}

let make_logger parent_logger ns =
  let namespace =
    if parent_logger == root_logger then ns
    else String.concat "." [parent_logger.namespace; ns];
  in
  let rec logger = {
    namespace;
    min_level = Int.max_int;
    child = logger;
    sibling = parent_logger.child;
    writers = None;
  } in
  parent_logger.child <- logger;
  logger

type 'a log_function =
  ((('a, Format.formatter, unit) format -> 'a) -> unit) -> unit

let write logger lvl msg =
  let ts = Time.stamp () in
  let ns = logger.namespace in
  Option.iter (fun w -> w ~ts ~ns ~lvl msg) logger.writers

let[@inline] logf logger lvl : _ log_function = fun logk ->
  if int_of_level lvl >= logger.min_level then
    logk (fun fmt ->
           Format.kasprintf (write logger lvl)
             ("@[<hov>" ^^ fmt))


module type Logs = sig
  val logger : logger
  val trace : _ log_function
  val debug : _ log_function
  val info  : _ log_function
  val warn  : _ log_function
  val error : _ log_function
  val log   : level -> _ log_function
end

let make_logs parent_logger ns =
  (module struct
    let logger = make_logger parent_logger ns
    let[@inline] trace k = logf logger TRACE k
    let[@inline] debug k = logf logger DEBUG k
    let[@inline] info  k = logf logger INFO  k
    let[@inline] warn  k = logf logger WARN  k
    let[@inline] error k = logf logger ERROR k
    let[@inline] log level k = logf logger level k
  end : Logs)

let logs ns = make_logs root_logger ns
let sublogs logger ns = make_logs logger ns

(* TODO: filters: namespace[*] => min_level *)

let rec add_writer_rec min_level writer parent_logger logger =
  if parent_logger != logger then
    begin
      logger.min_level <- min min_level logger.min_level;
      logger.writers <-
        (match logger.writers with
         | None -> Some writer
         | Some writer' -> Some (writer' +++ writer));
      add_writer_rec min_level writer logger logger.child;
      add_writer_rec min_level writer parent_logger logger.sibling
    end

let[@inline] add_writer ?(min_level = WARN) writer =
  add_writer_rec (int_of_level min_level) writer root_logger root_logger.child

let init_pretty_writer
      ?min_level
      ?(color = true)
      ?(timestamp = true)
      ?(namespace = true)
      ?(level = true)
      out
  =
  Pretty.make out { color; timestamp; namespace; level } |>
  Pretty.writer |>
  add_writer ?min_level

let init_journald_writer
      ?min_level
      ?path
      ()
  =
  Journald.make () ?path |>
  Journald.writer |>
  add_writer ?min_level