diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-05-29 23:57:39 +0000 |
|---|---|---|
| committer | Estevan Castilho <tevo@riajuu.net> | 2026-05-29 23:57:39 +0000 |
| commit | ed5fc6920a214910f4ed1676b9719d8a1e94bd36 (patch) | |
| tree | b887f6bceca0ab98ad7460a66b86443b6f131eba | |
| parent | a5e1d949d2ee8d82991cd48638137bbf57d40652 (diff) | |
| download | Sakura-ed5fc6920a214910f4ed1676b9719d8a1e94bd36.tar.gz Sakura-ed5fc6920a214910f4ed1676b9719d8a1e94bd36.zip | |
Record backtraces when instantiating conditions
| -rw-r--r-- | lib/condition.ml | 9 |
1 files changed, 6 insertions, 3 deletions
diff --git a/lib/condition.ml b/lib/condition.ml index 44ef2ff..1b32d63 100644 --- a/lib/condition.ml +++ b/lib/condition.ml @@ -16,11 +16,13 @@ let of_list (f : 'a -> serializable) (l : 'a list) : serializable = type t = { name : string; message : string; + backtrace : Printexc.raw_backtrace; properties : (string, serializable) BatMap.t } let condition name message ?parent props = { name; message; + backtrace = Printexc.get_callstack 64; properties = parent |> Option.map (fun { properties; _ } -> properties) @@ -31,7 +33,7 @@ let ( |=| ) name value = (fun p -> BatMap.add name value p) let ( & ) l r = (fun p -> r (l p)) let empty = (fun p -> p) -let to_sexp { name; message; properties } = +let to_sexp { name; message; properties; _ } = let open Sexplib.Sexp in let properties' = properties @@ -40,10 +42,11 @@ let to_sexp { name; message; properties } = |> BatList.of_seq in List (Atom name :: Atom message :: properties') -let to_string { name; message; properties } = +let to_string { name; message; properties; backtrace } = let properties' = properties |> BatMap.to_seq |> BatSeq.to_string ~sep:"\n" (fun (k, v) -> "\t" ^ k ^ ": " ^ v#as_string) in - name ^ ": " ^ message ^ properties' + let backtrace' = Printexc.raw_backtrace_to_string backtrace in + name ^ ": " ^ message ^ "\n" ^ properties' ^ "\n\nBacktrace:\n" ^ backtrace' |