Format

4 files changed, 37 insertions, 48 deletions

diff --git a/lib/ddl/ast.ml b/lib/ddl/ast.ml
index e1e5bad..86af755 100644
--- a/lib/ddl/ast.ml
+++ b/lib/ddl/ast.ml
@@ -1,16 +1,12 @@
 open Sexplib.Std
 
-type cardinality_spec =
-  | Finite of int
-  | AlephZero
-  | Continuum
-  | ConstrainedFinite
+type cardinality_spec = Finite of int | AlephZero | Continuum | ConstrainedFinite
 [@@deriving sexp]
 
 type statement =
   | CreateMultigroup of string
-  | CreateRelation of { name : string; schema : (string * string) list }
+  | CreateRelation of {name: string; schema: (string * string) list}
   | RetractRelation of string
   | ClearRelation of string
-  | RegisterDomain of { name : string; cardinality : cardinality_spec }
+  | RegisterDomain of {name: string; cardinality: cardinality_spec}
 [@@deriving sexp]
diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml
index a47c911..c16ff1f 100644
--- a/lib/ddl/executor.ml
+++ b/lib/ddl/executor.ml
@@ -1,15 +1,17 @@
 module Make (NT : Nt.S) = struct
   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))
+    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 parse_fqn (s : string) : (Qualified_name.t, Condition.t) result =
-    Qualified_name.try_parse 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, Condition.t) result =
@@ -17,8 +19,7 @@ module Make (NT : Nt.S) = struct
     | Some mg -> Ok mg
     | None -> Error (Error.multigroup_not_found mg_name)
 
-  let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t =
-    function
+  let convert_cardinality : Ast.cardinality_spec -> Conventions.Cardinality.t = function
     | Ast.Finite n -> Conventions.Cardinality.Finite n
     | Ast.AlephZero -> Conventions.Cardinality.AlephZero
     | Ast.Continuum -> Conventions.Cardinality.Continuum
@@ -32,57 +33,49 @@ module Make (NT : Nt.S) = struct
     let bh = ctx.write_handle in
     let branch_name = ctx.branch#name in
     match stmt with
-    | Ast.CreateMultigroup name ->
+    | Ast.CreateMultigroup name -> (
         ctx.branch#add_multigroup ~name;
-        (match ctx.branch#mg_of name with
-         | Some mg -> Ok ([ (name, mg) ], "Multigroup created: " ^ name)
-         | None    -> Error (Error.multigroup_not_found name))
-    | Ast.CreateRelation { name; schema = schema_pairs } ->
+        match ctx.branch#mg_of name with
+        | Some mg -> Ok ([name, mg], "Multigroup created: " ^ 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
         let schema =
-          List.fold_left
-            (fun s (attr, dom) -> Schema.add attr dom s)
-            Schema.empty schema_pairs
-        in
-        let* _bh, new_mg =
-          NT.create_relation bh mg ~branch_name ~name:fqn.name ~schema
+          List.fold_left (fun s (attr, dom) -> Schema.add attr dom s) Schema.empty schema_pairs
         in
+        let* _bh, new_mg = NT.create_relation bh mg ~branch_name ~name:fqn.name ~schema in
         ctx.branch#set_mg ~name:fqn.mg new_mg;
-        Ok ([ (fqn.mg, new_mg) ], "Relation created: " ^ name)
+        Ok ([fqn.mg, new_mg], "Relation created: " ^ name)
     | Ast.RetractRelation name ->
         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
-        in
+        let* _bh, new_mg = 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)
-    | Ast.ClearRelation name ->
+        Ok ([fqn.mg, new_mg], "Relation retracted: " ^ name)
+    | Ast.ClearRelation name -> (
         let* fqn = parse_fqn name in
         let* mg = lookup_mg ctx fqn.mg in
-        (match mg#get_relation fqn.name with
-         | 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)
-             in
-             ctx.branch#set_mg ~name:fqn.mg new_mg;
-             Ok ([ (fqn.mg, new_mg) ], "Relation cleared: " ^ name))
-    | Ast.RegisterDomain { name; cardinality } ->
+        match mg#get_relation fqn.name with
+        | 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)
+            in
+            ctx.branch#set_mg ~name:fqn.mg new_mg;
+            Ok ([fqn.mg, new_mg], "Relation cleared: " ^ name) )
+    | Ast.RegisterDomain {name; cardinality} ->
         let* fqn = parse_fqn name in
         let* mg = lookup_mg ctx fqn.mg in
         let domain : Relation.domain =
-          new Relation.domain ~name:fqn.name
+          new Relation.domain
+            ~name:fqn.name
             ~generator:(fun _ -> Generator.Error "not enumerable via DDL")
             ~membership_criteria:(fun _ -> true)
-            ~cardinality:(convert_cardinality cardinality)
-            ~schema:Schema.empty ~provenance:None ~lineage:None
-            ~constraints:None
+            ~cardinality:(convert_cardinality cardinality) ~schema:Schema.empty ~provenance:None
+            ~lineage:None ~constraints:None
         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)
+        Ok ([fqn.mg, new_mg], "Domain registered: " ^ name)
 end
diff --git a/lib/ddl/parser.ml b/lib/ddl/parser.ml
index a4df914..094b0fd 100644
--- a/lib/ddl/parser.ml
+++ b/lib/ddl/parser.ml
@@ -1,5 +1,6 @@
 module Error = struct
   open Condition
+
   let parse_error msg = condition "parse-error" msg empty
 end
 
diff --git a/lib/ddl/sublanguage.ml b/lib/ddl/sublanguage.ml
index 33145c4..da3ba3a 100644
--- a/lib/ddl/sublanguage.ml
+++ b/lib/ddl/sublanguage.ml
@@ -6,7 +6,6 @@ module Make (NT : Nt.S) = struct
 
   let name = "ddl"
   let parse _ = Ok ()
-
   let parse_sexp sexp = Parser.of_sexp sexp
 
   let execute ctx ast =