Skip to content

Commit

Permalink
feat(Logger): debugging interface
Browse files Browse the repository at this point in the history
  • Loading branch information
favonia committed Oct 8, 2024
1 parent 91d01f0 commit ba6e705
Show file tree
Hide file tree
Showing 3 changed files with 35 additions and 0 deletions.
25 changes: 25 additions & 0 deletions src/Logger.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,25 @@
include LoggerSigs

module Make () = struct
type 'a Effect.t +=
| Debug : Diagnostic.loctext -> unit Effect.t
| CallBegin : Diagnostic.loctext -> unit Effect.t
| CallEnd : Diagnostic.loctext -> unit Effect.t

let emit_loctext t = Effect.perform @@ Debug t
let emit ?loc s = emit_loctext @@ Diagnostic.loctext ?loc s
let emitf ?loc = Diagnostic.kloctextf ?loc emit_loctext

let trace_open_loctext t = Effect.perform @@ CallBegin t
let trace_close_loctext t = Effect.perform @@ CallEnd t

let trace ?loc s f =
trace_open_loctext (Diagnostic.loctext ?loc s);
Fun.protect f
~finally:(fun () -> trace_close_loctext (Diagnostic.loctext ?loc s))
let tracef ?loc =
Diagnostic.ktextf @@ fun t f ->
trace_open_loctext {Range.value = t; loc};
Fun.protect f
~finally:(fun () -> trace_close_loctext {Range.value = t; loc})
end
3 changes: 3 additions & 0 deletions src/Logger.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
include module type of LoggerSigs

module Make () : S
7 changes: 7 additions & 0 deletions src/LoggerSigs.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,7 @@
module type S =
sig
val emit : ?loc:Range.t -> string -> unit
val emitf : ?loc:Range.t -> ('a, Format.formatter, unit, unit) format4 -> 'a
val trace : ?loc:Range.t -> string -> (unit -> 'a) -> 'a
val tracef : ?loc:Range.t -> ('b, Format.formatter, unit, (unit -> 'a) -> 'a) format4 -> 'b
end

0 comments on commit ba6e705

Please sign in to comment.