diff options
| author | Estevan Castilho <tevo@riajuu.net> | 2026-05-27 23:24:12 +0000 |
|---|---|---|
| committer | GitHub <noreply@github.com> | 2026-05-27 23:24:12 +0000 |
| commit | 9dc0391443ca16bf1ab3114d002aad83872f8a73 (patch) | |
| tree | e4f78a2533e5e633b733c1ea21d0159aeca79b75 /lib/condition.ml | |
| parent | f9097a0562ea8b40d40a19059578a9280b945de4 (diff) | |
| download | Sakura-9dc0391443ca16bf1ab3114d002aad83872f8a73.tar.gz Sakura-9dc0391443ca16bf1ab3114d002aad83872f8a73.zip | |
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
Diffstat (limited to '')
| -rw-r--r-- | lib/condition.ml | 49 |
1 files changed, 49 insertions, 0 deletions
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' |
