package nloge

  1. Overview
  2. Docs

Source file level.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
(** [t] represents syslog-style levels *)
type t =
  [ `Emergency
  | `Alert
  | `Critical
  | `Error
  | `Warning
  | `Notice
  | `Info
  | `Debug
  ]
[@@deriving eq, ord]

(** [Get] refers to the current logging level. *)
type _ Effect.t += Get : t Effect.t

let get_level () = Effect.perform Get

(** [parse]s upper, lower, and initial capital letter cases.

    {[parse "DEBUG" = parse "debug" = parse "Debug" = Some `Debug]} *)
let parse : string -> t option = function
  | "Emergency" | "EMERGENCY" | "emergency" -> Some `Emergency
  | "Alert" | "ALERT" | "alert" -> Some `Alert
  | "Critical" | "CRITICAL" | "critical" -> Some `Critical
  | "Error" | "ERROR" | "error" -> Some `Error
  | "Warning" | "WARNING" | "warning" -> Some `Warning
  | "Notice" | "NOTICE" | "notice" -> Some `Notice
  | "Info" | "INFO" | "info" -> Some `Info
  | "Debug" | "DEBUG" | "debug" -> Some `Debug
  | _ -> None
;;

(** [pp] prints level with upper capital

    {[pp Format.std_formatter `Debug (* -> DEBUG *)]} *)
let pp fmt (t : t) =
  Format.fprintf fmt
  @@
  match t with
  | `Emergency -> "EMERGENCY"
  | `Alert -> "ALERT"
  | `Critical -> "CRITICAL"
  | `Error -> "ERROR"
  | `Warning -> "WARNING"
  | `Notice -> "NOTICE"
  | `Info -> "INFO"
  | `Debug -> "DEBUG"
;;

let show t =
  let b = Buffer.create 16 in
  let fmt = Format.formatter_of_buffer b in
  Fun.protect ~finally:(fun () -> Format.pp_print_flush fmt ()) (fun () -> pp fmt t);
  Fun.protect ~finally:(fun () -> Buffer.clear b) (fun () -> Buffer.contents b)
;;