package devkit

  1. Overview
  2. Docs

Source file logger.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

type level = [`Debug | `Info | `Warn | `Error | `Critical | `Nothing]
type facil = { name : string; mutable show : int; }
let int_level = function
  | `Debug -> 0
  | `Info -> 1
  | `Warn -> 2
  | `Error -> 3
  | `Critical -> 4
  | `Nothing -> 100
let set_filter facil level = facil.show <- int_level level
let get_level facil = match facil.show with
  | 0 -> `Debug
  | 1 -> `Info
  | 2 -> `Warn
  | 3 -> `Error
  | x when x = 100 -> `Nothing
  | _ -> `Critical (* ! *)
let allowed facil level = level <> `Nothing && int_level level >= facil.show

let string_level = function
  | `Debug -> "debug"
  | `Info -> "info"
  | `Warn -> "warn"
  | `Error -> "error"
  | `Critical -> "critical"
  | `Nothing -> "nothing"

let level = function
  | "info" -> `Info
  | "debug" -> `Debug
  | "warn" -> `Warn
  | "error" -> `Error
  | "critical" -> `Critical
  | "nothing" -> `Nothing
  | s -> Exn.fail "unrecognized level %s" s

module Pairs = struct
  type pair = string*string
  type t = pair list
end

type target = {
  format : level -> facil -> Time.t -> Pairs.t -> string -> string;
  mutable output : level -> facil -> string -> unit;
}

(** A logger *)
type t = {
  put : level -> facil -> Time.t -> Pairs.t -> string -> unit;
  allowed : facil -> level -> bool;
}

let put_simple (t:target) : t = {
  allowed;
  put = fun level facil ts pairs str ->
    if allowed facil level then
      t.output level facil (t.format level facil ts pairs str)
}