package nloge

  1. Overview
  2. Docs

Source file emit.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
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(** {1:emit Emitting log}

  Nloge "emit"s logs to {!section-"writer"} by "perform"ing {!Emit}.
  *)

type 'a msgf = (('a, Format.formatter, unit, unit) format4 -> 'a) -> unit
type metadata = (string * Yojson.Safe.t) list
type 'a t = Level.t * string option * metadata * 'a msgf

(** [Emit] is aimed to emit log objects. {!section-"writer"} can be injected to handle the effect. *)
type _ Effect.t += Emit : 'a t -> unit Effect.t

type 'a logger =  ?metadata:metadata -> ?__LOC__:string -> 'a msgf -> unit

(** {2 Log functions} *)

(** [emit level ?metadata ?loc msgf] sends [msgf] message object with level [level].
    [metadata] and [loc] can be sent optionally.

    {[emit `Debug @@ fun m -> m "hello, %s" "world" (* -> hello, world *) ]} *)
let emit level msgf loc info = Effect.perform @@ Emit (level, loc, info, msgf)
(** And the following [emg], [alert], etc. are wrapper for [emit] with correspondng [level].
    {[debug ~metadata:["Key", `String "Val" ] ~__LOC__ @@ fun m -> m "the answer: %d" 42 ]}
 *)

let emg : 'a logger = fun ?(metadata = []) ?__LOC__ msgf -> emit `Emergency msgf __LOC__ metadata
let alert : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Alert msgf __LOC__ metadata
let crit : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Critical msgf __LOC__ metadata
let err : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Error msgf __LOC__ metadata
let warn : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Warning msgf __LOC__ metadata
let notice : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Notice msgf __LOC__ metadata
let info : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Info msgf __LOC__ metadata
let debug : 'a logger =  fun ?(metadata = []) ?__LOC__ msgf -> emit `Debug msgf __LOC__ metadata

(** {2 Utilities} *)

(** [make_emit_handler] is a utility to build a handler for {!Emit}. *)
let make_emit_handler f msgh =
  let open Effect.Deep in
  let effc : type a. a Effect.t -> ((a, 'r) continuation -> 'r) option = function
    | Emit (level, loc, json, msgf) ->
      Some
        (fun k ->
          let now = Time.now' () in
          msgf @@ Format.kasprintf (msgh now level loc json);
          Effect.Deep.continue k ())
    | _ -> None
  in
  try_with f () { effc }
(** {[
let plain_transformer f =
  Nloge.make_emit_handler f
  @@ fun now level loc metadata msg ->
  let json = Nloge.Trans.insert_info now level loc msg metadata in
  let len = List.length json in
  let k0 = Format.kasprintf (Nloge.write level) "%a:\n%s" Nloge.Level.pp level in
  let k, _ =
    ListLabels.fold_left json ~init:(k0, 0) ~f:(fun (k, idx) (label, v) ->
      let idx' = idx + 1 in
      let comma = if idx' = len then "" else "\n" in
      ( Format.kasprintf
          k
          "\t%-10s = %a%s%s"
          label
          (Yojson.Safe.pretty_print ~std:true)
          v
          comma
      , idx' ))
  in
  k "\n"
;;
]}
 *)
;;