diff options
| author | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 22:09:11 -0300 |
|---|---|---|
| committer | Marcos Magueta <maguetamarcos@gmail.com> | 2026-09-26 22:09:11 -0300 |
| commit | 320954996e921d7b34eb61f462799b5c6ab8ee09 (patch) | |
| tree | 16697bc161faf27f0b4c1ba57f6fcc24d240801b /lib/condition.ml | |
| parent | b555c28c7e6c315fc0394baf213ecb08b21ed959 (diff) | |
| download | Sakura-320954996e921d7b34eb61f462799b5c6ab8ee09.tar.gz Sakura-320954996e921d7b34eb61f462799b5c6ab8ee09.zip | |
new shrunk API for RNT on sakura
Diffstat (limited to 'lib/condition.ml')
| -rw-r--r-- | lib/condition.ml | 49 |
1 files changed, 12 insertions, 37 deletions
diff --git a/lib/condition.ml b/lib/condition.ml index c565b59..e4d4384 100644 --- a/lib/condition.ml +++ b/lib/condition.ml @@ -1,56 +1,31 @@ -class type serializable = object - method as_sexp : Sexplib.Sexp.t - method as_string : string -end +type properties = (string, Value.t) BatMap.t +type ps = properties -> properties -class literal (expr : Sexplib.Sexp.t) : serializable = - object - method as_sexp = expr - method as_string = Sexplib.Sexp.to_string_hum expr - end +type condition = + {name: string; message: string; backtrace: Printexc.raw_backtrace; properties: properties} -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 ( |=| ) 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 64; + backtrace= Printexc.get_callstack 256; properties= parent |> Option.map (fun {properties; _} -> properties) |> Option.value ~default:BatMap.empty |> props } -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 open Sexplib.Sexp in - let properties' = - properties - |> BatMap.to_seq - |> BatSeq.map (fun (k, v) -> List [Atom k; v#as_sexp]) - |> BatList.of_seq - in - List (Atom name :: Atom message :: properties') +let complement props ({properties; _} as condition) = {condition with properties= props properties} -let to_string {name; message; properties; backtrace} = +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 ^ ": " ^ v#as_string) + |> 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' |
