Migrate the DDL over

2 files changed, 17 insertions, 34 deletions

diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml
index a052ba2..de64cf5 100644
--- a/lib/ddl/executor.ml
+++ b/lib/ddl/executor.ml
@@ -1,31 +1,21 @@
 module Make (NT : Nt.S) = struct
-  type error =
-    | ParseError of string
-    | NtError of Nt.error
-    | RelationNotFound 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) ]
-    | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
-    | MultigroupNotFound s -> List [ Atom "multigroup-not-found"; Atom s ]
-    | UnqualifiedName s -> List [ Atom "unqualified-name"; Atom s ]
+  module Error = struct
+    open Condition
+    (* TODO: more structure *)
+    let relation_not_found name = condition "relation-not-found" ("name" |=| (of_string name))
+    let multigroup_not_found name = condition "multigroup-not-found" ("name" |=| (of_string name))
+  end
 
   let ( let* ) = Result.bind
-  let wrap_nt r = Result.map_error (fun e -> NtError e) r
 
-  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_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t =
     function
@@ -38,7 +28,7 @@ module Make (NT : Nt.S) = struct
      prefix.  The executor parses the FQN, resolves the mg in the branch
      cache, advances it through NT, and returns a single-element delta. *)
   let execute (ctx : Sublanguage_context.t) (stmt : Ast.statement) :
-      (Sublanguage_types.transition_delta * string, error) result =
+      (Sublanguage_types.transition_delta * string, Condition.t) result =
     let bh = ctx.write_handle in
     let branch_name = ctx.branch#name in
     match stmt with
@@ -46,7 +36,7 @@ module Make (NT : Nt.S) = struct
         ctx.branch#add_multigroup ~name;
         (match ctx.branch#mg_of name with
          | Some mg -> Ok ([ (name, mg) ], "Multigroup created: " ^ name)
-         | None    -> Error (MultigroupNotFound name))
+         | None    -> Error (Error.multigroup_not_found name))
     | Ast.CreateRelation { name; schema = schema_pairs } ->
         let* fqn = parse_fqn name in
         let* mg = lookup_mg ctx fqn.mg in
@@ -58,7 +48,6 @@ module Make (NT : Nt.S) = struct
         let* _bh, new_mg =
           NT.create_relation bh mg
             ~branch_name ~mg_name:fqn.mg ~name:fqn.name ~schema
-          |> wrap_nt
         in
         ctx.branch#set_mg ~name:fqn.mg new_mg;
         Ok ([ (fqn.mg, new_mg) ], "Relation created: " ^ name)
@@ -66,7 +55,7 @@ module Make (NT : Nt.S) = struct
         let* fqn = parse_fqn name in
         let* mg = lookup_mg ctx fqn.mg in
         let* _bh, new_mg =
-          NT.retract_relation bh mg ~name:fqn.name |> wrap_nt
+          NT.retract_relation bh mg ~name:fqn.name
         in
         ctx.branch#set_mg ~name:fqn.mg new_mg;
         Ok ([ (fqn.mg, new_mg) ], "Relation retracted: " ^ name)
@@ -74,12 +63,12 @@ module Make (NT : Nt.S) = struct
         let* fqn = parse_fqn name in
         let* mg = lookup_mg ctx fqn.mg in
         (match mg#get_relation fqn.name with
-         | None -> Error (RelationNotFound name)
+         | None -> Error (Error.relation_not_found name)
          | Some rel ->
              let* _bh, new_mg =
                NT.clear_relation bh mg
                  ~branch_name ~mg_name:fqn.mg
-                 (rel :> Relation.relation) |> wrap_nt
+                 (rel :> Relation.relation)
              in
              ctx.branch#set_mg ~name:fqn.mg new_mg;
              Ok ([ (fqn.mg, new_mg) ], "Relation cleared: " ^ name))
@@ -94,7 +83,7 @@ module Make (NT : Nt.S) = struct
             ~schema:Schema.empty ~provenance:None ~lineage:None
             ~constraints:None
         in
-        let* _bh, new_mg = NT.register_domain bh mg domain |> wrap_nt in
+        let* _bh, new_mg = NT.register_domain bh mg domain in
         ctx.branch#set_mg ~name:fqn.mg new_mg;
         Ok ([ (fqn.mg, new_mg) ], "Domain registered: " ^ name)
 end
diff --git a/lib/ddl/sublanguage.ml b/lib/ddl/sublanguage.ml
index a7910c5..33145c4 100644
--- a/lib/ddl/sublanguage.ml
+++ b/lib/ddl/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 = "ddl"
   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