blob: cc0f7a748b35e9f85870c0f216f4a6f25b5bdfa4 (
plain) (
blame)
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
|
type properties = (string, Value.value) BatMap.t
type ps = properties -> properties
type condition =
{name: string; message: string; backtrace: Printexc.raw_backtrace; properties: properties}
let ( |=| ) name value = fun p -> BatMap.add name value p
let ( & ) l r = fun p -> r (l p)
let empty = fun p -> p
let condition name message ?parent props =
{ name;
message;
backtrace= Printexc.get_callstack 256;
properties=
parent
|> Option.map (fun {properties; _} -> properties)
|> Option.value ~default:BatMap.empty
|> props }
let to_string_hum {name; message; properties; backtrace} =
let properties' =
properties
|> BatMap.to_seq
|> BatSeq.to_string ~first:"" ~last:"" ~sep:"\n" (fun (k, v) ->
"\t" ^ k ^ ": " ^ Value.to_string v )
in
let backtrace' = Printexc.raw_backtrace_to_string backtrace in
name ^ ": " ^ message ^ "\n" ^ properties' ^ "\n\nBacktrace:\n" ^ backtrace'
|
