aboutsummaryrefslogtreecommitdiffstats
path: root/lib/condition.ml
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 22:09:11 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-09-26 22:09:11 -0300
commit320954996e921d7b34eb61f462799b5c6ab8ee09 (patch)
tree16697bc161faf27f0b4c1ba57f6fcc24d240801b /lib/condition.ml
parentb555c28c7e6c315fc0394baf213ecb08b21ed959 (diff)
downloadSakura-320954996e921d7b34eb61f462799b5c6ab8ee09.tar.gz
Sakura-320954996e921d7b34eb61f462799b5c6ab8ee09.zip
new shrunk API for RNT on sakura
Diffstat (limited to 'lib/condition.ml')
-rw-r--r--lib/condition.ml49
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'