diff options
Diffstat (limited to 'lib/condition.ml')
| -rw-r--r-- | lib/condition.ml | 14 |
1 files changed, 10 insertions, 4 deletions
diff --git a/lib/condition.ml b/lib/condition.ml index 44ef2ff..83ae9b8 100644 --- a/lib/condition.ml +++ b/lib/condition.ml @@ -11,16 +11,19 @@ end let of_sexp (expr : Sexplib.Sexp.t) = new literal expr let of_string (s : string) = new literal (Sexplib.Sexp.Atom s) +let of_int (n : int) = of_string (Int.to_string n) let of_list (f : 'a -> serializable) (l : 'a list) : serializable = new literal (Sexplib.Sexp.List (List.map (fun e -> (f e)#as_sexp) l)) 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 +34,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 +43,13 @@ 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) + |> BatSeq.to_string + ~first:"" ~last:"" ~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' |