From 9dc0391443ca16bf1ab3114d002aad83872f8a73 Mon Sep 17 00:00:00 2001
From: Estevan Castilho <tevo@riajuu.net>
Date: Wed, 27 May 2026 23:24:12 +0000
Subject: Improve the error handling situation (#71)

* Sketches of a condition system

* `Condition.condition` -> `Condition.t`

* Migrate `NT` over

* Migrate `Branch` over

* Migrate `Sublanguage` et al. over

* Migrate the PRL over

* Migrate the DRL over

* Migrate the DML over

* Have `Qualified_name.try_parse` return a `Condition.t`

* Migrate the DDL over

* Migrate the VCL over

* Migrate the SCL over

* Migrate the ICL over

* Migrate the parsers over

* Just inherit the errors from NT and the sublanguages

* Migrate `Management.Physical` over

* Migrate `Configuration` over

* Migrate `Management.Branch` over

* Migrate `Transport` over

* Migrate `System` over

* Migrate `Server` over

* Include messages on on all conditions

* A prettier stringifier
---
 lib/condition.ml | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 lib/condition.ml

(limited to 'lib/condition.ml')

diff --git a/lib/condition.ml b/lib/condition.ml
new file mode 100644
index 0000000..44ef2ff
--- /dev/null
+++ b/lib/condition.ml
@@ -0,0 +1,49 @@
+
+class type serializable = object
+  method as_sexp : Sexplib.Sexp.t
+  method as_string : string
+end
+
+class literal (expr : Sexplib.Sexp.t) : serializable = object
+  method as_sexp = expr
+  method as_string = Sexplib.Sexp.to_string_hum expr
+end
+
+let of_sexp (expr : Sexplib.Sexp.t) = new literal expr
+let of_string (s : string) = new literal (Sexplib.Sexp.Atom s)
+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;
+           properties : (string, serializable) BatMap.t }
+
+let condition name message ?parent props =
+  { name;
+    message;
+    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 to_string { name; message; properties } =
+  let properties' =
+    properties
+    |> BatMap.to_seq
+    |> BatSeq.to_string ~sep:"\n" (fun (k, v) -> "\t" ^ k ^ ": " ^ v#as_string)
+  in
+  name ^ ": " ^ message ^ properties'
-- 
cgit v1.2.3