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

3 files changed, 16 insertions, 32 deletions

diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml
index 0a77dff..084fb71 100644
--- a/lib/icl/executor.ml
+++ b/lib/icl/executor.ml
@@ -1,31 +1,19 @@
 module Make (NT : Nt.S) = struct
-  type error =
-    | ParseError of string
-    | NtError of Nt.error
-    | ConversionError of string
-    | MultigroupNotFound of string
-    | UnqualifiedName of string
-
-  let sexp_of_error e =
-    let open Sexplib.Sexp in
-    match e with
-    | ParseError s -> List [ Atom "parse-error"; Atom s ]
-    | NtError e -> List [ Atom "nt-error"; Atom (Nt.string_of_error e) ]
-    | ConversionError s -> List [ Atom "conversion-error"; Atom s ]
-    | MultigroupNotFound s -> List [ Atom "multigroup-not-found"; Atom s ]
-    | UnqualifiedName s -> List [ Atom "unqualified-name"; Atom s ]
+  module Error = struct
+    open Condition
+    let multigroup_not_found name = condition "multigroup-not-found" "Multigroup not found" ("name" |=| (of_string name))
+  end
 
   let ( let* ) = Result.bind
-  let wrap_nt = Result.map_error (fun e -> NtError e)
 
-  let parse_fqn (s : string) : (Qualified_name.t, error) result =
-    Qualified_name.try_parse s |> Result.map_error (fun s -> UnqualifiedName s)
+  let parse_fqn (s : string) : (Qualified_name.t, Condition.t) result =
+    Qualified_name.try_parse s
 
   let lookup_mg (ctx : Sublanguage_context.t) (mg_name : string) :
-      (Management.Multigroup.multigroup, error) result =
+      (Management.Multigroup.multigroup, Condition.t) result =
     match ctx.branch#mg_of mg_name with
     | Some mg -> Ok mg
-    | None -> Error (MultigroupNotFound mg_name)
+    | None -> Error (Error.multigroup_not_found mg_name)
 
   let convert_binding_expr : Ast.binding_expr -> Constraint.binding_expr =
     function
@@ -52,7 +40,7 @@ module Make (NT : Nt.S) = struct
         Constraint.forall ~variable ~quantifier (convert_body body)
 
   let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) :
-      (Sublanguage_types.transition_delta * string, error) result =
+      (Sublanguage_types.transition_delta * string, Condition.t) result =
     match stmt with
     | Ast.RegisterConstraint { constraint_name; relation_name; body } ->
         let* fqn = parse_fqn relation_name in
@@ -61,7 +49,6 @@ module Make (NT : Nt.S) = struct
         let* _bh, new_mg =
           NT.register_constraint ctx.write_handle mg
             ~constraint_name ~relation_name:fqn.name ~body:runtime_body
-          |> wrap_nt
         in
         ctx.branch#set_mg ~name:fqn.mg new_mg;
         Ok ([ (fqn.mg, new_mg) ], "Constraint registered: " ^ constraint_name)
diff --git a/lib/icl/parser.ml b/lib/icl/parser.ml
index 5678b47..a4df914 100644
--- a/lib/icl/parser.ml
+++ b/lib/icl/parser.ml
@@ -1,13 +1,16 @@
-type error = ParseError of string
+module Error = struct
+  open Condition
+  let parse_error msg = condition "parse-error" msg empty
+end
 
 let of_sexp sexp =
   match Ast.statement_of_sexp sexp with
   | stmt -> Ok stmt
-  | exception exn -> Error (ParseError (Printexc.to_string exn))
+  | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
 
 let of_string s =
   match Sexplib.Sexp.of_string s |> Ast.statement_of_sexp with
   | stmt -> Ok stmt
-  | exception exn -> Error (ParseError (Printexc.to_string exn))
+  | exception exn -> Error (Error.parse_error (Printexc.to_string exn))
 
 let to_string stmt = Ast.sexp_of_statement stmt |> Sexplib.Sexp.to_string_hum
diff --git a/lib/icl/sublanguage.ml b/lib/icl/sublanguage.ml
index ae2c359..19f15ce 100644
--- a/lib/icl/sublanguage.ml
+++ b/lib/icl/sublanguage.ml
@@ -3,20 +3,14 @@ module Make (NT : Nt.S) = struct
 
   type configuration = unit
   type ast = Ast.statement
-  type error = Exec.error
 
   let name = "icl"
   let parse _ = Ok ()
 
-  let parse_sexp sexp =
-    match Parser.of_sexp sexp with
-    | Ok r -> Ok r
-    | Error (Parser.ParseError s) -> Error (Exec.ParseError s)
+  let parse_sexp sexp = Parser.of_sexp sexp
 
   let execute ctx ast =
     match Exec.execute ctx ast with
     | Ok (delta, _msg) -> Ok (Sublanguage_types.Transition delta)
     | Error e -> Error e
-
-  let sexp_of_error = Exec.sexp_of_error
 end