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, 40 insertions, 30 deletions

diff --git a/lib/management/branch.ml b/lib/management/branch.ml
index ea9d525..4ba0983 100644
--- a/lib/management/branch.ml
+++ b/lib/management/branch.ml
@@ -12,7 +12,12 @@ let branch_key name = "branch:" ^ name
 let head_key = "head"
 let names_key = "branch_names"
 
-module Make (Storage : Physical.S with type error = string) = struct
+module Make (Storage : Physical.S) = struct
+  module Error = struct
+    open Condition
+    let branch_not_found name = condition "branch-not-found" "Branch not found" ("name" |=| (of_string name))
+  end
+
   let load_names storage =
     match Storage.load_raw storage names_key with
     | Ok (Some bytes) -> (Marshal.from_bytes bytes 0 : string list)
@@ -56,7 +61,7 @@ module Make (Storage : Physical.S with type error = string) = struct
         let record = { name; tip } in
         let bytes = Marshal.to_bytes record [] in
         Storage.store_raw storage (branch_key name) bytes
-    | Ok None -> Error ("Branch not found: " ^ name)
+    | Ok None -> Error (Error.branch_not_found name)
     | Error e -> Error e
 
   let list storage =
@@ -70,7 +75,7 @@ module Make (Storage : Physical.S with type error = string) = struct
         names
     in
     Ok branches
-(* 
+(*
   let branch_relation storage : Relation.t =
     let schema =
       Schema.empty |> Schema.add "name" "string" |> Schema.add "hash" "string"
diff --git a/lib/management/multigroup.ml b/lib/management/multigroup.ml
index f115d97..b908302 100644
--- a/lib/management/multigroup.ml
+++ b/lib/management/multigroup.ml
@@ -13,6 +13,7 @@ class multigroup ~name:(init_name : Conventions.Name.t) =
     method relations = relations
     method timestamp = timestamp
 
+    (* TODO: a variant returning (Relation.relation, Condition.t) result *)
     method get_relation rel_name = BatMap.String.find_opt rel_name relations
     method get_relation_names = BatMap.String.fold (fun n _ acc -> n :: acc) relations []
     method has_relation rel_name = BatMap.String.mem rel_name relations
diff --git a/lib/management/physical.ml b/lib/management/physical.ml
index 0f26bca..7c6f6b2 100644
--- a/lib/management/physical.ml
+++ b/lib/management/physical.ml
@@ -12,38 +12,37 @@ module type BACKEND = sig
   include Configuration.CONFIGURABLE
 
   type connection
-  type error
 
-  val connect : configuration -> (connection, error) result
+  val connect : configuration -> (connection, Condition.t) result
   (** Connect to the storage backend *)
 
   val disconnect : connection -> unit
   (** Disconnect from the backend *)
 
-  val get : connection -> Conventions.Hash.t -> (bytes option, error) result
+  val get : connection -> Conventions.Hash.t -> (bytes option, Condition.t) result
   (** Get a value by its hash. Returns None if not found. *)
 
-  val put : connection -> Conventions.Hash.t -> bytes -> (unit, error) result
+  val put : connection -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result
   (** Store a value at its hash *)
 
-  val exists : connection -> Conventions.Hash.t -> (bool, error) result
+  val exists : connection -> Conventions.Hash.t -> (bool, Condition.t) result
   (** Check if a hash exists *)
 
-  val begin_transaction : connection -> (unit, error) result
+  val begin_transaction : connection -> (unit, Condition.t) result
   (** Begin a transaction *)
 
-  val commit : connection -> (unit, error) result
+  val commit : connection -> (unit, Condition.t) result
   (** Commit a transaction *)
 
-  val rollback : connection -> (unit, error) result
+  val rollback : connection -> (unit, Condition.t) result
   (** Rollback a transaction *)
 
   val get_many :
-    connection -> Conventions.Hash.t list -> (bytes option list, error) result
+    connection -> Conventions.Hash.t list -> (bytes option list, Condition.t) result
   (** Batch get multiple values *)
 
   val put_many :
-    connection -> (Conventions.Hash.t * bytes) list -> (unit, error) result
+    connection -> (Conventions.Hash.t * bytes) list -> (unit, Condition.t) result
   (** Batch put multiple values *)
 end
 
@@ -52,43 +51,41 @@ module type S = sig
   include Configuration.CONFIGURABLE
 
   type t
-  type error
 
-  val create : configuration -> (t, error) result
+  val create : configuration -> (t, Condition.t) result
   (** Create a storage instance from a backend connection *)
 
   val close : t -> unit
   (** Close the storage *)
 
   val store_attribute :
-    t -> Conventions.AbstractValue.t -> (Conventions.Hash.t, error) result
+    t -> Conventions.AbstractValue.t -> (Conventions.Hash.t, Condition.t) result
   (** Store an attribute value, returns its hash *)
 
   val load_attribute :
     t ->
     Conventions.Hash.t ->
-    (Conventions.AbstractValue.t option, error) result
+    (Conventions.AbstractValue.t option, Condition.t) result
   (** Load an attribute value by hash *)
 
-  val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, error) result
+  val store_raw : t -> Conventions.Hash.t -> bytes -> (unit, Condition.t) result
   (** Store raw bytes at a hash *)
 
-  val load_raw : t -> Conventions.Hash.t -> (bytes option, error) result
+  val load_raw : t -> Conventions.Hash.t -> (bytes option, Condition.t) result
   (** Load raw bytes by hash *)
 
-  val exists : t -> Conventions.Hash.t -> (bool, error) result
+  val exists : t -> Conventions.Hash.t -> (bool, Condition.t) result
   (** Check if a hash exists *)
 
-  val with_transaction : t -> (unit -> ('a, error) result) -> ('a, error) result
+  val with_transaction : t -> (unit -> ('a, Condition.t) result) -> ('a, Condition.t) result
   (** Execute a function within a transaction *)
 end
 
 (** Functor to create storage operations from a backend *)
 module Make (B : BACKEND) :
-  S with type error = B.error and type configuration = B.configuration = struct
+  S with type configuration = B.configuration = struct
   type configuration = B.configuration
   type t = B.connection
-  type error = B.error
 
   let parse = B.parse
   let create config = B.connect config
@@ -123,7 +120,7 @@ end
 
 (** In-memory backend for testing and development *)
 module MemoryBackend :
-  BACKEND with type error = string and type configuration = unit = struct
+  BACKEND with type configuration = unit = struct
   type configuration = unit
 
   type connection = {
@@ -132,15 +129,22 @@ module MemoryBackend :
     mutable transaction_buffer : (string * bytes) list;
   }
 
-  type error = string
+  module Error = struct
+    open Condition
+    (* TODO: more structure *)
+    let parse_error msg = condition "parse-error" msg empty
+    let already_in_transaction = condition "already-in-transaction" "Already inside a transaction" empty
+    let not_in_transaction = condition "not-in-transaction" "Not inside a transaction" empty
+  end
 
   let parse sexp =
     match sexp with
     | Sexplib.Sexp.List [] -> Ok ()
     | _ ->
         Error
-          (Printf.sprintf "memory backend takes no configuration, got: %s"
-             (Sexplib.Sexp.to_string sexp))
+          (Error.parse_error
+             (Printf.sprintf "memory backend takes no configuration, got: %s"
+                (Sexplib.Sexp.to_string sexp)))
 
   let connect () =
     Ok
@@ -166,7 +170,7 @@ module MemoryBackend :
   let exists conn hash = Ok (Hashtbl.mem conn.data hash)
 
   let begin_transaction conn =
-    if conn.in_transaction then Error "Already in transaction"
+    if conn.in_transaction then Error Error.already_in_transaction
     else begin
       conn.in_transaction <- true;
       conn.transaction_buffer <- [];
@@ -174,7 +178,7 @@ module MemoryBackend :
     end
 
   let commit conn =
-    if not conn.in_transaction then Error "Not in transaction"
+    if not conn.in_transaction then Error Error.not_in_transaction
     else begin
       List.iter
         (fun (hash, value) -> Hashtbl.replace conn.data hash value)
@@ -185,7 +189,7 @@ module MemoryBackend :
     end
 
   let rollback conn =
-    if not conn.in_transaction then Error "Not in transaction"
+    if not conn.in_transaction then Error Error.not_in_transaction
     else begin
       conn.in_transaction <- false;
       conn.transaction_buffer <- [];