diff options
Diffstat (limited to '')
| -rw-r--r-- | lib/ddl/executor.ml | 43 |
1 files changed, 16 insertions, 27 deletions
diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml index a052ba2..c61b02e 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" "Relation not found" ("name" |=| (of_string name)) + let multigroup_not_found name = condition "multigroup-not-found" "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 |