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 383fca2
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 0 deletions.
24 changes: 24 additions & 0 deletions src/Debugger.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,24 @@
include DebuggerSigs

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

let emit_loctext t = Effect.perform @@ Debug t
let emit ?loc s = emit_loctext @@ Loctext.make ?loc s
let emitf ?loc = Loctext.kmakef ?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 (Loctext.make ?loc s);
Fun.protect f
~finally:(fun () -> trace_close_loctext (Loctext.make ?loc s))
let tracef ?loc =
Text.kmakef @@ fun t f ->
trace_open_loctext (Range.locate_opt loc t);
Fun.protect f ~finally:(fun () -> trace_close_loctext (Range.locate_opt loc t))
end
3 changes: 3 additions & 0 deletions src/Debugger.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
include module type of DebuggerSigs

module Make () : S
7 changes: 7 additions & 0 deletions src/DebuggerSigs.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 383fca2

Please sign in to comment.