aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-04-20 21:55:07 -0300
committerGitHub <noreply@github.com>2026-04-20 21:55:07 -0300
commitfdc63e730f91a4605ed4ff96a908e1f5e822d1bb (patch)
tree36b0a66b81fc201a426171e190975289640cd579
parentd3708bb28adcd0220142f1890ab96bfd2df637d3 (diff)
downloadSakura-fdc63e730f91a4605ed4ff96a908e1f5e822d1bb.tar.gz
Sakura-fdc63e730f91a4605ed4ff96a908e1f5e822d1bb.zip
New Server & Manipulation refactor
Co-authored-by: Estevan Castilho <tevo@riajuu.net>
Diffstat
-rw-r--r--bin/main.ml17
-rw-r--r--bin/server.ml287
-rw-r--r--lib/algebra.ml2
-rw-r--r--lib/conventions.ml3
-rw-r--r--lib/dbms_language.ml37
-rw-r--r--lib/dcl/executor.ml147
-rw-r--r--lib/ddl/executor.ml8
-rw-r--r--lib/dml/executor.ml14
-rw-r--r--lib/envelope.ml16
-rw-r--r--lib/error.ml34
-rw-r--r--lib/icl/executor.ml8
-rw-r--r--lib/listener.ml188
-rw-r--r--lib/management/branch.ml4
-rw-r--r--lib/management/merge.ml1
-rw-r--r--lib/manipulation.ml388
-rw-r--r--lib/manipulation.mli137
-rw-r--r--lib/prelude/standard.ml15
-rw-r--r--lib/relation.ml2
-rw-r--r--lib/transport.ml41
-rw-r--r--test/test_relational_engine.ml638
20 files changed, 929 insertions, 1058 deletions
diff --git a/bin/main.ml b/bin/main.ml
deleted file mode 100644
index 6b2a068..0000000
--- a/bin/main.ml
+++ /dev/null
@@ -1,17 +0,0 @@
-let main () =
- let digest =
- Sha256.to_hex (Sha256.string "sakura")
- in
- print_endline digest
-
-let () =
- let tuple =
- Relational_engine.Tuple.make_materialized ~relation:"natural_less_than"
- ~attributes:
- (Relational_engine.Tuple.AttributeMap.of_list
- [ ("left", Obj.magic 0); ("right", Obj.magic 1) ])
- in
- print_endline @@ string_of_bool
- @@ Relational_engine.Prelude.Standard.less_than_natural.membership_criteria
- tuple;
- main ()
diff --git a/bin/server.ml b/bin/server.ml
index 82965dc..1d4d5b3 100644
--- a/bin/server.ml
+++ b/bin/server.ml
@@ -1,160 +1,21 @@
open Relational_engine
-let default_port = 7777
-let default_limit = 50
+module B = Management.Physical.Memory
+module T = Transport.TCP
+module Listener = Listener.Make(T)(B)
-(* TODO: AbstractValue carries no type tag of its own; we recover the OCaml
- runtime tag here via Obj introspection. This is fragile — it breaks the
- moment a domain stores a boxed integer or a custom block. The right fix is
- a typed value representation in Conventions. *)
-
-(* TODO: Generator.Error is silently treated as end-of-stream here, hiding
- real failures from the client. *)
-let materialize_generator gen limit =
- let rec go gen pos acc count =
- if count >= limit then (List.rev acc, true)
- else
- match gen (Some pos) with
- | Generator.Done -> (List.rev acc, false)
- | Generator.Error _ -> (List.rev acc, false)
- | Generator.Value (t, next) -> (
- let mat =
- match t with
- | Tuple.Materialized m -> Some m
- | Tuple.NonMaterialized _ -> None
- in
- match mat with
- | None -> go next (pos + 1) acc count
- | Some m -> go next (pos + 1) (m :: acc) (count + 1))
- in
- go gen 0 [] 0
-
-let materialize_relation storage (rel : Relation.t) limit =
- let gen = Algebra.Memory.to_generator storage rel in
- materialize_generator gen limit
-
-let short_hash (h : string) = String.sub h 0 (min 8 (String.length h))
-
-module BranchOps = Management.Branch.Make (Management.Physical.Memory)
-module Dispatch = Dbms_language.Memory
-
-let get_branch storage =
- match BranchOps.get_head storage with Ok (Some name) -> name | _ -> "--"
-
-let tuple_to_sexp (t : Tuple.materialized) =
- let open Sexplib.Sexp in
- List
- (Tuple.AttributeMap.bindings t.Tuple.attributes
- |> List.map (fun (k, attr) ->
- List
- [ Atom k; Conventions.AbstractValue.sexp_of_t attr.Attribute.value ])
- )
-
-let relation_to_sexp storage db_name db_hash (rel : Relation.t) limit =
- let open Sexplib.Sexp in
- let schema_sexp =
- List (List.map (fun (a, d) -> List [ Atom a; Atom d ]) rel.Relation.schema)
- in
- let tuples, truncated = materialize_relation storage rel limit in
- let rows_sexp = List (List.map tuple_to_sexp tuples) in
- to_string
- @@ List
- [
- Atom "relation";
- List [ Atom "name"; Atom rel.Relation.name ];
- List [ Atom "schema"; schema_sexp ];
- List [ Atom "rows"; rows_sexp ];
- List [ Atom "row_count"; Atom (string_of_int (List.length tuples)) ];
- List [ Atom "truncated"; Atom (string_of_bool truncated) ];
- List [ Atom "db_hash"; Atom (short_hash db_hash) ];
- List [ Atom "db_name"; Atom db_name ];
- List [ Atom "branch"; Atom (get_branch storage) ];
- ]
-
-let ok_response storage db_name db_hash msg =
- let open Sexplib.Sexp in
- to_string
- @@ List
- [
- Atom "ok";
- List [ Atom "message"; Atom msg ];
- List [ Atom "db_hash"; Atom (short_hash db_hash) ];
- List [ Atom "db_name"; Atom db_name ];
- List [ Atom "branch"; Atom (get_branch storage) ];
- ]
-
-let error_response storage db_name db_hash err_sexp =
- let open Sexplib.Sexp in
- to_string
- @@ List
- [
- Atom "error";
- err_sexp;
- List [ Atom "db_hash"; Atom (short_hash db_hash) ];
- List [ Atom "db_name"; Atom db_name ];
- List [ Atom "branch"; Atom (get_branch storage) ];
- ]
-
-let advance_head_branch storage new_hash =
- match BranchOps.get_head storage with
- | Ok (Some branch_name) ->
- ignore (BranchOps.update_tip storage ~name:branch_name ~tip:new_hash)
- | _ -> ()
-
-let dbms_dispatch =
- Dispatch.create
- [
- (module Drl.Sublanguage.Memory : Dispatch.SubS);
- (module Ddl.Sublanguage.Memory : Dispatch.SubS);
- (module Dml.Sublanguage.Memory : Dispatch.SubS);
- (module Icl.Sublanguage.Memory : Dispatch.SubS);
- (module Dcl.Sublanguage.Memory : Dispatch.SubS);
- (module Scl.Sublanguage.Memory : Dispatch.SubS);
- ]
-
-let cursor_to_sexp storage db_name db_hash cursor_id rows has_more =
- let open Sexplib.Sexp in
- let row_sexps = List.map tuple_to_sexp rows in
- let rows_sexp = List row_sexps in
- to_string
- @@ List
- [
- Atom "cursor";
- List [ Atom "id"; Atom cursor_id ];
- List [ Atom "rows"; rows_sexp ];
- List [ Atom "row_count"; Atom (string_of_int (List.length row_sexps)) ];
- List [ Atom "has_more"; Atom (string_of_bool has_more) ];
- List [ Atom "db_hash"; Atom (short_hash db_hash) ];
- List [ Atom "db_name"; Atom db_name ];
- List [ Atom "branch"; Atom (get_branch storage) ];
- ]
-
-let execute_command storage db_ref cmd =
- let db = !db_ref in
- let h = db.Management.Database.hash in
- let name = db.Management.Database.name in
- let ok = ok_response storage name in
- let err = error_response storage name in
- match Dispatch.execute dbms_dispatch storage db cmd with
- | Ok (Sublanguage.Query rel) ->
- relation_to_sexp storage name h rel default_limit
- | Ok (Sublanguage.Transition (new_db, msg)) ->
- db_ref := new_db;
- advance_head_branch storage new_db.Management.Database.hash;
- ok new_db.Management.Database.hash msg
- | Ok (Sublanguage.Cursor { cursor_id; rows; has_more }) ->
- cursor_to_sexp storage name h cursor_id rows has_more
- | Error e -> err h (Dispatch.sexp_of_dispatch_error e)
+module Memory = Manipulation.Make (B)
(* TODO: registration failures are silently ignored; a broken prelude
relation leaves the catalog in a partially-seeded state with no
indication to the user. *)
+(* TODO: think of a better way to initialize new databases *)
let register_prelude_relations storage db =
let open Prelude.Standard in
List.fold_left
(fun db (rel : Relation.t) ->
match
- Manipulation.Memory.create_immutable_relation storage db ~name:rel.name
+ Memory.create_immutable_relation storage db ~name:rel.name
~schema:rel.schema ~generator:(Option.get rel.generator)
~membership_criteria:rel.membership_criteria
~cardinality:rel.cardinality
@@ -163,7 +24,7 @@ let register_prelude_relations storage db =
| Error e ->
Printf.eprintf
"Warning: failed to register prelude relation %s: %s\n%!" rel.name
- (Manipulation.string_of_error e);
+ (Sexplib.Sexp.to_string (Error.sexp_of_error e));
db)
db
[
@@ -179,43 +40,27 @@ let register_prelude_relations storage db =
divide_natural;
]
-let print_with_time str =
- let now = Unix.gettimeofday () in
- let tm = Unix.localtime now in
- let orange = "\027[38;5;208m" in
- let reset = "\027[0m" in
- let formatted_time =
- Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.Unix.tm_year + 1900)
- (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
- tm.Unix.tm_sec
- in
- print_endline @@ Printf.sprintf "%s[%s]%s %s" orange formatted_time reset str
-
-(* TODO: single-threaded accept loop — one slow or hung client blocks all
- others. Should use threads or non-blocking I/O. *)
-let handle_client storage db_ref fd =
- let ic = Unix.in_channel_of_descr fd in
- let oc = Unix.out_channel_of_descr fd in
- try
- while true do
- let line = input_line ic in
- let line = String.trim line in
- if line <> "" then begin
- let response =
- try execute_command storage db_ref line
- with e ->
- let db = !db_ref in
- error_response storage db.Management.Database.name
- db.Management.Database.hash
- Sexplib.Sexp.(
- List [ Atom "uncaught-error"; Atom (Printexc.to_string e) ])
- in
- print_with_time response;
- output_string oc (response ^ "\n");
- flush oc
- end
- done
- with End_of_file | Unix.Unix_error _ -> ()
+(* let register_branch_relations storage db = *)
+(* (\* Register ephemeral sakura:branch and sakura:head relations backed by *)
+(* the raw branch registry — no stored tuples, no circularity. *\) *)
+(* let register db rel = *)
+(* match *)
+(* Memory.create_immutable_relation storage db *)
+(* ~name:rel.Relation.name ~schema:rel.Relation.schema *)
+(* ~generator:(Option.get rel.Relation.generator) *)
+(* ~membership_criteria:rel.Relation.membership_criteria *)
+(* ~cardinality:rel.Relation.cardinality *)
+(* with *)
+(* | Ok (db, _) -> db *)
+(* | Error e -> *)
+(* Printf.eprintf "Warning: failed to register %s: %s\n%!" *)
+(* rel.Relation.name *)
+(* (Manipulation.Error.string_of_error e); *)
+(* db *)
+(* in *)
+(* db *)
+(* |> Fun.flip register (BranchOps.branch_relation storage) *)
+(* |> Fun.flip register (BranchOps.head_relation storage) *)
let setup () =
let ( let* ) = Result.bind in
@@ -224,71 +69,27 @@ let setup () =
|> Result.map_error (Fun.const "Failed to create storage")
in
let* db =
- Manipulation.Memory.create_database storage ~name:"sakura"
+ Memory.create_database storage ~name:"sakura"
|> Result.map_error (Fun.const "Failed to create initial database")
in
Ok (storage, db)
-let register_branch_relations storage db =
- (* Register ephemeral sakura:branch and sakura:head relations backed by
- the raw branch registry — no stored tuples, no circularity. *)
- let register db rel =
- match
- Manipulation.Memory.create_immutable_relation storage db
- ~name:rel.Relation.name ~schema:rel.Relation.schema
- ~generator:(Option.get rel.Relation.generator)
- ~membership_criteria:rel.Relation.membership_criteria
- ~cardinality:rel.Relation.cardinality
- with
- | Ok (db, _) -> db
- | Error e ->
- Printf.eprintf "Warning: failed to register %s: %s\n%!"
- rel.Relation.name
- (Manipulation.string_of_error e);
- db
- in
- db
- |> Fun.flip register (BranchOps.branch_relation storage)
- |> Fun.flip register (BranchOps.head_relation storage)
-
-let warn_on_error fmt = function Ok () -> () | Error e -> Printf.eprintf fmt e
-let cursor_gc_max_age = 300.0 (* 5 minutes *)
-let cursor_gc_interval = 60.0 (* run GC at most once per minute *)
+let address = "127.0.0.1"
+let port = 7777
let () =
match setup () with
- | Error msg -> failwith msg
+ | Error msg -> Printf.eprintf "Couldn't initialize: %s" msg
| Ok (storage, db) ->
- let db =
- db
- |> register_prelude_relations storage
- |> register_branch_relations storage
- in
- (* Initialise cursor session registry for SCL *)
- let session_reg = Session.create () in
- Scl.Executor.set_sessions session_reg;
- (* Create default master branch in raw registry and set HEAD *)
- BranchOps.create storage ~name:"master" ~tip:db.Management.Database.hash
- |> warn_on_error "Warning: failed to create master branch: %s\n%!";
- BranchOps.checkout storage "master"
- |> warn_on_error "Warning: failed to checkout master: %s\n%!";
- let db_ref = ref db in
- let last_gc = ref 0.0 in
- let sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0 in
- Unix.setsockopt sock Unix.SO_REUSEADDR true;
- Unix.setsockopt sock Unix.SO_REUSEPORT true;
- Unix.bind sock (Unix.ADDR_INET (Unix.inet_addr_loopback, default_port));
- Unix.listen sock 5;
- Printf.printf "Sakura server listening on 127.0.0.1:%d\n" default_port;
- Printf.printf "Database hash: %s\n%!"
- (short_hash db.Management.Database.hash);
- while true do
- let client_fd, _addr = Unix.accept sock in
- handle_client storage db_ref client_fd;
- (try Unix.close client_fd with _ -> ());
- let now = Unix.gettimeofday () in
- if now -. !last_gc >= cursor_gc_interval then begin
- Session.gc session_reg ~max_age:cursor_gc_max_age;
- last_gc := now
- end
- done
+ let db =
+ db
+ |> register_prelude_relations storage
+ (* |> register_branch_relations storage *)
+ in
+ let transport =
+ T.create
+ { address_family = Unix.PF_INET;
+ address = Unix.ADDR_INET (Unix.inet_addr_of_string address, port) }
+ in
+ Printf.printf "Listening on %s:%d" address port; print_newline ();
+ Listener.run transport db storage
diff --git a/lib/algebra.ml b/lib/algebra.ml
index 30ed1a6..d8e766f 100644
--- a/lib/algebra.ml
+++ b/lib/algebra.ml
@@ -44,7 +44,7 @@ module Make (Storage : Management.Physical.S) = struct
in
Relation.make ~hash:None ~name ~schema ~tree:None ~constraints ~cardinality
~generator:(Some gen)
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "derived")
diff --git a/lib/conventions.ml b/lib/conventions.ml
index de04712..93dd579 100644
--- a/lib/conventions.ml
+++ b/lib/conventions.ml
@@ -25,7 +25,8 @@ end
module AbstractValue = struct
type t = Obj.t
- let hash (elem : t) = Sha256.to_hex (Sha256.string (Bytes.to_string (Marshal.to_bytes elem [])))
+ let hash (elem : t) =
+ Sha256.to_hex (Sha256.string (Bytes.to_string (Marshal.to_bytes elem [])))
let sexp_of_t (v : t) =
let open Sexplib.Sexp in
diff --git a/lib/dbms_language.ml b/lib/dbms_language.ml
deleted file mode 100644
index 47e5a99..0000000
--- a/lib/dbms_language.ml
+++ /dev/null
@@ -1,37 +0,0 @@
-(** Composable dispatch over sublanguages.
-
- All commands must use the tagged envelope format: (tag payload) where [tag]
- is the sublanguage name (drl, dml, ddl, icl, dcl, ...). Adding a new
- sublanguage is just extending the list passed to [create]. *)
-
-module Make (Storage : Management.Physical.S with type error = string) = struct
- module type SubS = Sublanguage.S with type storage = Storage.t
-
- type dispatch_error = NoMatch of Sexplib.Sexp.t
- type dispatch = (module SubS) list
-
- let create (langs : (module SubS) list) : dispatch = langs
-
- let execute (langs : dispatch) (storage : Storage.t)
- (db : Management.Database.t) (input : string) :
- (Sublanguage.result, dispatch_error) Result.t =
- let no_match s =
- Error (NoMatch Sexplib.Sexp.(List [ Atom "parse-error"; Atom s ]))
- in
- match Envelope.parse input with
- | Error msg -> no_match msg
- | Ok { tag; payload } -> (
- match List.find_opt (fun (module L : SubS) -> L.name = tag) langs with
- | None -> no_match ("unknown sublanguage: " ^ tag)
- | Some (module L) -> (
- match L.parse_sexp payload with
- | Error e -> Error (NoMatch (L.sexp_of_error e))
- | Ok ast -> (
- match L.execute storage db ast with
- | Ok result -> Ok result
- | Error e -> Error (NoMatch (L.sexp_of_error e)))))
-
- let sexp_of_dispatch_error (NoMatch sexp) = sexp
-end
-
-module Memory = Make (Management.Physical.Memory)
diff --git a/lib/dcl/executor.ml b/lib/dcl/executor.ml
index 8c2fbdc..a651067 100644
--- a/lib/dcl/executor.ml
+++ b/lib/dcl/executor.ml
@@ -4,16 +4,24 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
module MergeOps = Management.Merge.Make (Storage) (Ops)
type error =
- | ParseError of string
- | BranchError of string
- | MergeError of string
+ | ParseError of string
+ | BranchError of Error.t
+ | BranchNotFound of string
+ | NoDatabaseAtHash of Conventions.Hash.t
+ | StorageError of string
+ | MergeError of Error.t
+ | Conflict of string
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [ Atom "parse-error"; Atom s ]
- | BranchError s -> List [ Atom "branch-error"; Atom s ]
- | MergeError s -> List [ Atom "merge-error"; Atom s ]
+ | ParseError s -> List [Atom "parse-error"; Atom s]
+ | BranchError s -> List [Atom "branch-error"; Error.sexp_of_error s]
+ | BranchNotFound s -> List [Atom "branch-not-found"; Atom s]
+ | NoDatabaseAtHash s -> List [Atom "no-database-at-hash"; Atom s]
+ | StorageError s -> List [Atom "storage-error"; Atom s]
+ | MergeError s -> List [Atom "merge-error"; Error.sexp_of_error s]
+ | Conflict s -> List [Atom "conflict"; Atom s]
let convert_strategy : Ast.merge_strategy -> Management.Merge.strategy =
function
@@ -24,71 +32,68 @@ module Make (Storage : Management.Physical.S with type error = string) = struct
let execute (storage : Storage.t) (db : Management.Database.t)
(stmt : Ast.statement) : (Management.Database.t * string, error) result =
match stmt with
- | Ast.CreateBranch { name; hash } -> (
- let tip =
- match hash with Some h -> h | None -> db.Management.Database.hash
- in
- match Branch.create storage ~name ~tip with
- | Error e -> Error (BranchError e)
- | Ok () -> Ok (db, "Branch " ^ name ^ " created"))
- | Ast.Checkout branch_name -> (
- match Branch.get_tip storage branch_name with
- | Error e -> Error (BranchError e)
- | Ok None -> Error (BranchError ("Branch not found: " ^ branch_name))
- | Ok (Some tip) -> (
- match Branch.checkout storage branch_name with
- | Error e -> Error (BranchError e)
- | Ok () -> (
- match Ops.load_database storage tip with
- | Error e ->
- Error (BranchError (Manipulation.string_of_error e))
- | Ok None -> Error (BranchError ("No database at hash: " ^ tip))
- | Ok (Some loaded_db) -> Ok (loaded_db, "HEAD:" ^ branch_name)))
- )
- | Ast.GetHead -> (
- match Branch.get_head storage with
- | Error e -> Error (BranchError e)
- | Ok None -> Ok (db, "HEAD is unset")
- | Ok (Some name) -> Ok (db, "HEAD:" ^ name))
- | Ast.GetBranchTip name -> (
- match Branch.get_tip storage name with
- | Error e -> Error (BranchError e)
- | Ok None -> Error (BranchError ("Branch not found: " ^ name))
- | Ok (Some hash) -> Ok (db, "branch:" ^ name ^ "=" ^ hash))
- | Ast.UpdateBranchTip { name; hash } -> (
- match Branch.update_tip storage ~name ~tip:hash with
- | Error e -> Error (BranchError e)
- | Ok () -> Ok (db, "Branch " ^ name ^ " updated"))
- | Ast.Merge { left; right; strategy } -> (
- match (Branch.get_tip storage left, Branch.get_tip storage right) with
- | Error e, _ | _, Error e -> Error (BranchError e)
- | Ok None, _ -> Error (BranchError ("Branch not found: " ^ left))
- | _, Ok None -> Error (BranchError ("Branch not found: " ^ right))
- | Ok (Some left_tip), Ok (Some right_tip) -> (
- let strat = convert_strategy strategy in
- match
- MergeOps.merge ~storage ~strategy:strat ~left_tip ~right_tip
- with
- | Error e -> Error (MergeError (Manipulation.string_of_error e))
- | Ok (Management.Merge.Failed conflicts) ->
- let msgs =
- List.map
- (function
- | Management.Merge.TupleConflict { relation; hash } ->
- "tuple conflict in " ^ relation ^ " (" ^ hash ^ ")"
- | Management.Merge.SchemaConflict r ->
- "schema conflict in " ^ r
- | Management.Merge.ConstraintConflict r ->
- "constraint conflict in " ^ r)
- conflicts
- in
- Error (MergeError ("Merge failed: " ^ String.concat "; " msgs))
- | Ok (Management.Merge.Clean merged_db) ->
- let _ =
- Branch.update_tip storage ~name:left
- ~tip:merged_db.Management.Database.hash
- in
- Ok (merged_db, "Merged:" ^ right ^ "→" ^ left)))
+ | Ast.CreateBranch { name; hash } ->
+ let tip = match hash with
+ | Some h -> h
+ | None -> db.Management.Database.hash
+ in
+ (match Branch.create storage ~name ~tip with
+ | Error e -> Error (StorageError e)
+ | Ok () -> Ok (db, "Branch " ^ name ^ " created"))
+
+ | Ast.Checkout branch_name ->
+ (match Branch.get_tip storage branch_name with
+ | Error e -> Error (StorageError e)
+ | Ok None -> Error (BranchNotFound branch_name)
+ | Ok (Some tip) ->
+ (match Branch.checkout storage branch_name with
+ | Error e -> Error (StorageError e)
+ | Ok () ->
+ (match Ops.load_database storage tip with
+ | Error e -> Error (BranchError e)
+ | Ok None -> Error (NoDatabaseAtHash tip)
+ | Ok (Some loaded_db) ->
+ Ok (loaded_db, "HEAD:" ^ branch_name))))
+
+ | Ast.GetHead ->
+ (match Branch.get_head storage with
+ | Error e -> Error (StorageError e)
+ | Ok None -> Ok (db, "HEAD is unset")
+ | Ok (Some name) -> Ok (db, "HEAD:" ^ name))
+
+ | Ast.GetBranchTip name ->
+ (match Branch.get_tip storage name with
+ | Error e -> Error (StorageError e)
+ | Ok None -> Error (BranchNotFound name)
+ | Ok (Some hash) -> Ok (db, "branch:" ^ name ^ "=" ^ hash))
+
+ | Ast.UpdateBranchTip { name; hash } ->
+ (match Branch.update_tip storage ~name ~tip:hash with
+ | Error e -> Error (StorageError e)
+ | Ok () -> Ok (db, "Branch " ^ name ^ " updated"))
+
+ | Ast.Merge { left; right; strategy } ->
+ (match Branch.get_tip storage left, Branch.get_tip storage right with
+ | Error e, _ | _, Error e -> Error (StorageError e)
+ | Ok None, _ -> Error (BranchNotFound left)
+ | _, Ok None -> Error (BranchNotFound right)
+ | Ok (Some left_tip), Ok (Some right_tip) ->
+ let strat = convert_strategy strategy in
+ (match MergeOps.merge ~storage ~strategy:strat ~left_tip ~right_tip with
+ | Error e -> Error (MergeError e)
+ | Ok (Management.Merge.Failed conflicts) ->
+ let msgs = List.map (function
+ | Management.Merge.TupleConflict { relation; hash } ->
+ "tuple conflict in " ^ relation ^ " (" ^ hash ^ ")"
+ | Management.Merge.SchemaConflict r -> "schema conflict in " ^ r
+ | Management.Merge.ConstraintConflict r -> "constraint conflict in " ^ r
+ ) conflicts in
+ Error (Conflict ("Merge failed: " ^ String.concat "; " msgs))
+ | Ok (Management.Merge.Clean merged_db) ->
+ let _ = Branch.update_tip storage ~name:left
+ ~tip:merged_db.Management.Database.hash in
+ Ok (merged_db,
+ "Merged:" ^ right ^ "→" ^ left)))
end
module Memory = Make (Management.Physical.Memory)
diff --git a/lib/ddl/executor.ml b/lib/ddl/executor.ml
index d374ffe..9df878d 100644
--- a/lib/ddl/executor.ml
+++ b/lib/ddl/executor.ml
@@ -3,15 +3,15 @@ module Make (Storage : Management.Physical.S) = struct
type error =
| ParseError of string
- | ManipulationError of Manipulation.error
+ | ManipulationError of Error.t
| RelationNotFound of string
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [ Atom "parse-error"; Atom s ]
- | ManipulationError e -> Manipulation.sexp_of_error e
- | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
+ | ParseError s -> List [Atom "parse-error"; Atom s]
+ | ManipulationError e -> Error.sexp_of_error e
+ | RelationNotFound s -> List [Atom "relation-not-found"; Atom s]
let ( let* ) = Result.bind
let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
diff --git a/lib/dml/executor.ml b/lib/dml/executor.ml
index 08f1a26..85f9791 100644
--- a/lib/dml/executor.ml
+++ b/lib/dml/executor.ml
@@ -5,20 +5,18 @@ module Make (Storage : Management.Physical.S) = struct
type error =
| ParseError of string
- | ManipulationError of Manipulation.error
+ | ManipulationError of Error.t
| RelationNotFound of string
| AlgebraError of Algebra.error
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [ Atom "parse-error"; Atom s ]
- | ManipulationError e -> Manipulation.sexp_of_error e
- | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
- | AlgebraError (Algebra.StorageError s) ->
- List [ Atom "storage-error"; Atom s ]
- | AlgebraError (Algebra.GeneratorError s) ->
- List [ Atom "generator-error"; Atom s ]
+ | ParseError s -> List [Atom "parse-error"; Atom s]
+ | ManipulationError e -> Error.sexp_of_error e
+ | RelationNotFound s -> List [Atom "relation-not-found"; Atom s]
+ | AlgebraError (Algebra.StorageError s) -> List [Atom "storage-error"; Atom s]
+ | AlgebraError (Algebra.GeneratorError s) -> List [Atom "generator-error"; Atom s]
let ( let* ) = Result.bind
let wrap_manip r = Result.map_error (fun e -> ManipulationError e) r
diff --git a/lib/envelope.ml b/lib/envelope.ml
index bed8bc0..4b8bc46 100644
--- a/lib/envelope.ml
+++ b/lib/envelope.ml
@@ -6,12 +6,12 @@
type tagged = { tag : string; payload : Sexplib.Sexp.t }
-let parse (input : string) : (tagged, string) Result.t =
- match Sexplib.Sexp.of_string input with
+let parse (input : Sexplib.Sexp.t) : (tagged, Error.t) Result.t =
+ match input with
| Sexplib.Sexp.List (Sexplib.Sexp.Atom tag :: rest) ->
- let payload =
- match rest with [ single ] -> single | many -> Sexplib.Sexp.List many
- in
- Ok { tag; payload }
- | _ -> Error "expected (tag payload...)"
- | exception exn -> Error (Printexc.to_string exn)
+ let payload = match rest with
+ | [single] -> single
+ | many -> Sexplib.Sexp.List many
+ in
+ Ok { tag; payload }
+ | s -> Error (Error.MalformedExpression s)
diff --git a/lib/error.ml b/lib/error.ml
new file mode 100644
index 0000000..edaa85b
--- /dev/null
+++ b/lib/error.ml
@@ -0,0 +1,34 @@
+
+(** Error types for manipulation operations *)
+type t =
+ | RelationNotFound of string
+ | RelationAlreadyExists of string
+ | TupleNotFound of Conventions.Hash.t
+ | DuplicateTuple of Conventions.Hash.t
+ | ConstraintViolation of string
+ | StorageError of string
+ | UnrecognizedSublanguage of string
+ | MalformedExpression of Sexplib.Sexp.t
+ (* TODO: think of a better way to manage and serialize sublanguage errors *)
+ | SublanguageError of Sexplib.Sexp.t
+ | Conflict of { old_db : Management.Database.t; new_db : Management.Database.t}
+ | SyntaxError of string
+
+let sexp_of_error e =
+ let open Sexplib.Sexp in
+ let error e ps = List (Atom e :: ps) in
+ let (<+>) key value = List [Atom key; value] in
+ match e with
+ (* TODO: think of a subset of common attributes that every error should have (message, etc)? *)
+ | RelationNotFound s -> error "relation-not-found" ["relation" <+> (Atom s)]
+ | RelationAlreadyExists s -> error "relation-already-exists" ["relation" <+> (Atom s)]
+ | TupleNotFound h -> error "tuple-not-found" ["hash" <+> (Atom h)]
+ | DuplicateTuple h -> error "duplicate-tuple" ["hash" <+> (Atom h)]
+ | ConstraintViolation s -> error "constraint-violation" ["message" <+> (Atom s)]
+ | StorageError s -> error "storage-error" ["message" <+> (Atom s)]
+ | UnrecognizedSublanguage s -> error "unrecognized-sublanguage" ["tag" <+> (Atom s)]
+ | MalformedExpression s -> error "malformed-expression" ["expression" <+> s]
+ | SublanguageError s -> error "sublanguage-error" ["error" <+> s]
+ | SyntaxError s -> error "syntax-error" ["message" <+> (Atom s)]
+ | Conflict { old_db; new_db } -> error "conflict" ["old-hash" <+> (Atom old_db.hash);
+ "new-hash" <+> (Atom new_db.hash)]
diff --git a/lib/icl/executor.ml b/lib/icl/executor.ml
index 07d0978..6238906 100644
--- a/lib/icl/executor.ml
+++ b/lib/icl/executor.ml
@@ -3,15 +3,15 @@ module Make (Storage : Management.Physical.S) = struct
type error =
| ParseError of string
- | ManipulationError of Manipulation.error
+ | ManipulationError of Error.t
| ConversionError of string
let sexp_of_error e =
let open Sexplib.Sexp in
match e with
- | ParseError s -> List [ Atom "parse-error"; Atom s ]
- | ManipulationError e -> Manipulation.sexp_of_error e
- | ConversionError s -> List [ Atom "conversion-error"; Atom s ]
+ | ParseError s -> List [Atom "parse-error"; Atom s]
+ | ManipulationError e -> Error.sexp_of_error e
+ | ConversionError s -> List [Atom "conversion-error"; Atom s]
let wrap_manip = Result.map_error (fun e -> ManipulationError e)
diff --git a/lib/listener.ml b/lib/listener.ml
new file mode 100644
index 0000000..d7951aa
--- /dev/null
+++ b/lib/listener.ml
@@ -0,0 +1,188 @@
+module type LISTENER = functor (T : Transport.TRANSPORT)(S : Management.Physical.S with type error = string) -> sig
+ val run : T.t -> Management.Database.t -> S.t -> unit
+end
+
+module Make : LISTENER =
+ functor (T : Transport.TRANSPORT)(S : Management.Physical.S with type error = string) -> struct
+ module type SubS = Sublanguage.S with type storage = S.t
+ module BranchOps = Management.Branch.Make (S)
+ module AlgebraOps = Algebra.Make (S)
+
+ let read_command input =
+ try
+ Ok (Sexplib.Sexp.input_sexp input)
+ with Sexplib.Sexp.Parse_error { err_msg ; _} ->
+ Error (Error.SyntaxError err_msg)
+
+ let sublanguages = (* should this go here? *)
+ List.fold_right
+ (fun (module Language : SubS) -> Utilities.StringMap.add Language.name (module Language : SubS))
+ [
+ (module Drl.Sublanguage.Make(S) : SubS);
+ (module Ddl.Sublanguage.Make(S) : SubS);
+ (module Dml.Sublanguage.Make(S) : SubS);
+ (module Icl.Sublanguage.Make(S) : SubS);
+ (module Dcl.Sublanguage.Make(S) : SubS);
+ (module Scl.Sublanguage.Make(S) : SubS);
+ ]
+ Utilities.StringMap.empty
+
+ let fmap f m = Result.bind m f
+
+ let find_language tag =
+ Utilities.StringMap.find_opt tag sublanguages
+ |> Option.to_result ~none:(Error.UnrecognizedSublanguage tag)
+
+ let execute storage db expr (module Language : SubS) =
+ Language.parse_sexp expr
+ |> fmap (Language.execute storage db)
+ |> Result.map_error (fun e -> Error.SublanguageError (Language.sexp_of_error e))
+
+ let execute_command storage db = function
+ | Sexplib.Sexp.(List [Atom tag; expr]) ->
+ find_language tag
+ |> fmap (execute storage db expr)
+ | s -> Error (Error.MalformedExpression s)
+
+ let advance_head_branch storage new_hash =
+ match BranchOps.get_head storage with
+ | Ok (Some branch_name) ->
+ ignore (BranchOps.update_tip storage ~name:branch_name ~tip:new_hash)
+ | _ -> ()
+
+ let perform storage db_head old_db result =
+ match result with
+ | Sublanguage.Transition (new_db, _) ->
+ if Atomic.compare_and_set db_head old_db new_db
+ then (advance_head_branch storage new_db.hash; Ok result)
+ else Error (Error.Conflict { old_db; new_db })
+ | _ -> Ok result
+
+ let get_branch storage =
+ match BranchOps.get_head storage with Ok (Some name) -> name | _ -> "--"
+
+ let current_limit = 16 (* TODO: make the limit per-connection? *)
+
+ let materialize_generator gen limit =
+ let rec go gen pos acc count =
+ if count >= limit then (List.rev acc, true)
+ else
+ match gen (Some pos) with
+ | Generator.Done -> (List.rev acc, false)
+ | Generator.Error _ -> (List.rev acc, false)
+ | Generator.Value (t, next) -> (
+ let mat =
+ match t with
+ | Tuple.Materialized m -> Some m
+ | Tuple.NonMaterialized _ -> None
+ in
+ match mat with
+ | None -> go next (pos + 1) acc count
+ | Some m -> go next (pos + 1) (m :: acc) (count + 1))
+ in
+ go gen 0 [] 0
+
+ let materialize_relation storage (rel : Relation.t) limit =
+ let gen = AlgebraOps.to_generator storage rel in
+ materialize_generator gen limit
+
+ let tuple_to_sexp (t : Tuple.materialized) =
+ let open Sexplib.Sexp in
+ List (Tuple.AttributeMap.bindings t.Tuple.attributes
+ |> List.map (fun (k, attr) -> List [ Atom k; Conventions.AbstractValue.sexp_of_t attr.Attribute.value ]))
+
+ (* TODO: does our network protocol make sense? *)
+ let serialize storage (db : Management.Database.t) =
+ let open Sexplib.Sexp in
+ function
+ | Error e -> List [ Atom "error"; (Error.sexp_of_error e) ]
+ (* TODO: forsake the global cursor register in favour of per-connection bookkeeping *)
+ | Ok (Sublanguage.Cursor { cursor_id; rows; has_more }) ->
+ let row_sexps = List.map tuple_to_sexp rows in
+ let rows_sexp = List row_sexps in
+ List [ Atom "cursor";
+ List [ Atom "id"; Atom cursor_id ];
+ List [ Atom "rows"; rows_sexp ];
+ List [ Atom "row_count"; Atom (string_of_int (List.length row_sexps)) ];
+ List [ Atom "has_more"; Atom (string_of_bool has_more) ];
+ List [ Atom "db_hash"; Atom db.hash ];
+ List [ Atom "db_name"; Atom db.name ];
+ List [ Atom "branch"; Atom (get_branch storage) ] ]
+ | Ok (Sublanguage.Query rel) ->
+ let tuples, truncated = materialize_relation storage rel current_limit in
+ let schema_sexp = List (List.map (fun (a, d) -> List [ Atom a; Atom d ]) rel.Relation.schema) in
+ let rows_sexp = List (List.map tuple_to_sexp tuples) in
+ List [ Atom "relation";
+ List [ Atom "name"; Atom rel.Relation.name ];
+ List [ Atom "schema"; schema_sexp ];
+ List [ Atom "rows"; rows_sexp ];
+ List [ Atom "row_count"; Atom (string_of_int (List.length tuples)) ];
+ List [ Atom "truncated"; Atom (string_of_bool truncated) ];
+ List [ Atom "db_hash"; Atom db.hash ];
+ List [ Atom "db_name"; Atom db.name ];
+ List [ Atom "branch"; Atom (get_branch storage) ] ]
+ | Ok (Sublanguage.Transition (new_db, message)) ->
+ List [ Atom "ok";
+ List [ Atom "message"; Atom message ];
+ List [ Atom "db_hash"; Atom new_db.hash ];
+ List [ Atom "db_name"; Atom new_db.name ];
+ (* TODO: `serialize' shouldn't need access to the storage layer *)
+ List [ Atom "branch"; Atom (get_branch storage) ] ]
+
+ let print_with_time str = (* TODO: a proper logger *)
+ let now = Unix.gettimeofday () in
+ let tm = Unix.localtime now in
+ let orange = "\027[38;5;208m" in
+ let reset = "\027[0m" in
+ let formatted_time =
+ Printf.sprintf "%04d-%02d-%02d %02d:%02d:%02d" (tm.Unix.tm_year + 1900)
+ (tm.Unix.tm_mon + 1) tm.Unix.tm_mday tm.Unix.tm_hour tm.Unix.tm_min
+ tm.Unix.tm_sec
+ in
+ print_endline @@ Printf.sprintf "%s[%s]%s %s" orange formatted_time reset str
+
+ let output_response output sexp =
+ let response = Sexplib.Sexp.to_string sexp in
+ output_string output response;
+ (* Some programs, like our current iteration of
+ * relational-explorer, expect server responses to always end
+ * with a newline. Although that is technically incorrect,
+ * acommodating for it doesn't bring us much harm; thus:
+ *)
+ output_string output "\n";
+ flush output;
+ print_with_time response
+
+ let handle_client connection db_head (storage : S.t) =
+ let input = T.input connection in
+ let output = T.output connection in
+ try
+ while true do
+ let db = Atomic.get db_head in
+ read_command input
+ |> fmap (execute_command storage db)
+ |> fmap (perform storage db_head db)
+ |> serialize storage db
+ |> output_response output
+ |> ignore
+ done
+ with
+ End_of_file -> ()
+ (* TODO: use the logger instead *)
+ | e -> Printf.eprintf "Error handling connection: %s" (Printexc.to_string e)
+
+ let spawn_handler db_head storage connection =
+ Stdlib.Domain.spawn (fun () -> handle_client connection db_head storage)
+
+ let run transport db storage =
+ (* TODO: consider how to handle multiple databases within a
+ * single server (a catalog perhaps?)
+ *)
+ let db_head = Atomic.make db in
+ T.listen transport;
+ while true do
+ T.accept transport
+ |> spawn_handler db_head storage
+ |> ignore
+ done
+ end
diff --git a/lib/management/branch.ml b/lib/management/branch.ml
index ea15311..1d218b1 100644
--- a/lib/management/branch.ml
+++ b/lib/management/branch.ml
@@ -100,7 +100,7 @@ module Make (Storage : Physical.S with type error = string) = struct
~tree:None ~constraints:None
~cardinality:Conventions.Cardinality.ConstrainedFinite
~generator:(Some generator)
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:(Relation.Provenance.Base Prelude.Catalog.branch_rel_name)
~lineage:(Relation.Lineage.Base Prelude.Catalog.branch_rel_name)
@@ -127,7 +127,7 @@ module Make (Storage : Physical.S with type error = string) = struct
~tree:None ~constraints:None
~cardinality:Conventions.Cardinality.ConstrainedFinite
~generator:(Some generator)
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:(Relation.Provenance.Base Prelude.Catalog.head_rel_name)
~lineage:(Relation.Lineage.Base Prelude.Catalog.head_rel_name)
end
diff --git a/lib/management/merge.ml b/lib/management/merge.ml
index d30545a..a8860fe 100644
--- a/lib/management/merge.ml
+++ b/lib/management/merge.ml
@@ -10,6 +10,7 @@ type conflict =
type strategy = PreferLeft | PreferRight | RevertToAncestor
type merge_result = Clean of Database.t | Failed of conflict list
+(* TODO: Remove this later. We already should have the interface on the manipulation *)
(** Module type for the subset of Manipulation.Make we need. *)
module type MANIPULATION = sig
type storage
diff --git a/lib/manipulation.ml b/lib/manipulation.ml
index b44cc53..91cd35d 100644
--- a/lib/manipulation.ml
+++ b/lib/manipulation.ml
@@ -1,6 +1,6 @@
(** Database manipulation operations.
- This module implements the core CRUD operations for the relational engine:
+ This module implements the core operations for the relational engine:
- Database creation
- Relation creation and deletion
- Tuple insertion and deletion
@@ -14,68 +14,69 @@
module RelationMap = Management.Database.RelationMap
-(** Error types for manipulation operations *)
-type error =
- | RelationNotFound of string
- | RelationAlreadyExists of string
- | TupleNotFound of Conventions.Hash.t
- | DuplicateTuple of Conventions.Hash.t
- | ConstraintViolation of string
- | StorageError of string
-
-let string_of_error = function
- | RelationNotFound s -> "RelationNotFound: " ^ s
- | RelationAlreadyExists s -> "RelationAlreadyExists: " ^ s
- | TupleNotFound h -> "TupleNotFound: " ^ h
- | DuplicateTuple h -> "DuplicateTuple: " ^ h
- | ConstraintViolation s -> "ConstraintViolation: " ^ s
- | StorageError s -> "StorageError: " ^ s
-
-let sexp_of_error e =
- let open Sexplib.Sexp in
- match e with
- | RelationNotFound s -> List [ Atom "relation-not-found"; Atom s ]
- | RelationAlreadyExists s -> List [ Atom "relation-already-exists"; Atom s ]
- | TupleNotFound h -> List [ Atom "tuple-not-found"; Atom h ]
- | DuplicateTuple h -> List [ Atom "duplicate-tuple"; Atom h ]
- | ConstraintViolation s -> List [ Atom "constraint-violation"; Atom s ]
- | StorageError s -> List [ Atom "storage-error"; Atom s ]
-
-type 'a result = ('a, error) Result.t
-(** Result type for operations *)
-
-module Schema = Schema
-(** Re-export Schema for convenience *)
-
-(** Re-export hashing functions for convenience *)
-let hash_tuple = Hashing.hash_tuple
-
-(** Build base provenance for a schema *)
-let build_base_provenance _schema relation_name =
- Relation.Provenance.Base relation_name
-
-(** Build membership criteria from schema (validates type membership) *)
-let build_membership_criteria _schema : Tuple.t -> bool =
- (* For now, accept all tuples. Full implementation would check domain membership. *)
- fun _ ->
- true
-
-(** Mutation direction for cascade constraint checking *)
-type mutation_kind = Insert | Delete
-
-type mutation_context = {
- dep_rel : string;
- transition : (string * Conventions.AbstractValue.t) list;
- kind : mutation_kind;
-}
-(** Context for a single tuple mutation, used by cascade checking *)
+(** Build membership criteria from schema (validates type membership).
+ Returns a function that takes a tree-lookup function and a tuple, checking
+ schema conformance and tree membership at call time. *)
+let build_membership_criteria ~name schema :
+ (string -> Merkle.t option) -> Tuple.t -> bool =
+ let value_conforms_to_domain domain_name (value : Conventions.AbstractValue.t)
+ =
+ match domain_name with
+ | "integer" -> Obj.is_int value
+ | "natural" -> Obj.is_int value && (Obj.obj value : int) >= 0
+ | "string" -> Obj.tag value = Obj.string_tag
+ | _ ->
+ (* Unknown domain: could be a relation-typed attribute (nested tuple)
+ or a user-defined domain. Accept for now; full validation would
+ require looking up the target relation's schema. *)
+ true
+ in
+ let n_expected = List.length schema in
+ fun tree_of tuple ->
+ match tuple with
+ | Tuple.NonMaterialized nm -> (
+ match tree_of name with
+ | None -> false
+ | Some t ->
+ Merkle.member nm.hash t
+ && Tuple.AttributeMap.cardinal nm.attributes = n_expected
+ && List.for_all
+ (fun (attr_name, _) ->
+ Tuple.AttributeMap.mem attr_name nm.attributes)
+ schema)
+ | Tuple.Materialized m ->
+ Tuple.AttributeMap.cardinal m.attributes = n_expected
+ && List.for_all
+ (fun (attr_name, domain_name) ->
+ match Tuple.AttributeMap.find_opt attr_name m.attributes with
+ | None -> false
+ | Some attr ->
+ value_conforms_to_domain domain_name attr.Attribute.value)
+ schema
+
+let tree_of_db (db : Management.Database.t) name =
+ Option.bind (Management.Database.get_relation db name) (fun r -> r.Relation.tree)
+
+module Constraint = struct
+ include Constraint
+
+ (** Mutation direction for cascade constraint checking *)
+ type mutation = Insert | Delete
+
+ type mutation_context = {
+ target_relation : string;
+ transition : (string * Conventions.AbstractValue.t) list;
+ kind : mutation;
+ }
+ (** Context for a single tuple mutation, used by cascade checking *)
+end
(** Functor to create manipulation operations with a storage backend *)
module Make (Storage : Management.Physical.S) = struct
type storage = Storage.t
- type nonrec error = error
+ type error = Error.t
- let of_string_error s = StorageError s
+ let of_string_error s = Error.StorageError s
let ( let* ) = Result.bind
let fold_result (f : 'a -> 'b -> ('a, error) Result.t) (init : 'a)
@@ -86,16 +87,40 @@ module Make (Storage : Management.Physical.S) = struct
f a x)
(Ok init) xs
- (* Constraint evaluation context *)
-
(** Build an eval_context closed over a specific (storage, db) snapshot. All
relation lookups resolve against this exact database version. *)
let build_eval_context (storage : storage) (db : Management.Database.t) :
Constraint.eval_context =
+ let load_value attr_hash =
+ match Storage.load_raw storage attr_hash with
+ | Error _ | Ok None -> None
+ | Ok (Some vbytes) ->
+ Some (Marshal.from_bytes vbytes 0 : Conventions.AbstractValue.t)
+ in
+ let rec load_attrs acc = function
+ | [] -> Some (List.rev acc)
+ | (name, attr_hash) :: rest -> (
+ match load_value attr_hash with
+ | None -> None
+ | Some value -> load_attrs ((name, value) :: acc) rest)
+ in
+ let load_tuple hash =
+ match Storage.load_raw storage hash with
+ | Error _ | Ok None -> None
+ | Ok (Some bytes) ->
+ load_attrs [] (Storable.Tuple.of_bytes bytes).Storable.Tuple.attributes
+ in
+ let rec load_all acc = function
+ | [] -> Some (List.rev acc)
+ | h :: rest -> (
+ match load_tuple h with
+ | None -> None
+ | Some pairs -> load_all (pairs :: acc) rest)
+ in
let check_membership rel_name bound_pairs =
match Management.Database.get_relation db rel_name with
| None -> false
- | Some rel -> (
+ | Some rel ->
let attributes =
List.fold_left
(fun acc (k, v) ->
@@ -105,38 +130,7 @@ module Make (Storage : Management.Physical.S) = struct
let tuple =
Tuple.Materialized { Tuple.relation = rel_name; attributes }
in
- if not (rel.membership_criteria tuple) then false
- else
- (* For stored relations, check if a matching tuple actually exists *)
- match rel.tree with
- | None ->
- (* No tree = ephemeral/generator relation, membership_criteria suffices *)
- true
- | Some tree ->
- let hashes = Merkle.keys tree in
- List.exists
- (fun h ->
- match Storage.load_raw storage h with
- | Error _ | Ok None -> false
- | Ok (Some bytes) ->
- let stored = Storable.Tuple.of_bytes bytes in
- (* Check if all bound pairs match the stored tuple's attributes *)
- List.for_all
- (fun (bk, bv) ->
- List.exists
- (fun (sk, sh) ->
- sk = bk
- &&
- match Storage.load_raw storage sh with
- | Error _ | Ok None -> false
- | Ok (Some vbytes) ->
- let sv : Conventions.AbstractValue.t =
- Marshal.from_bytes vbytes 0
- in
- Stdlib.( = ) sv bv)
- stored.Storable.Tuple.attributes)
- bound_pairs)
- hashes)
+ rel.membership_criteria (tree_of_db db) tuple
in
let iterate_finite rel_name =
match Management.Database.get_relation db rel_name with
@@ -144,39 +138,11 @@ module Make (Storage : Management.Physical.S) = struct
| Some rel -> (
match rel.cardinality with
| Conventions.Cardinality.Finite _
- | Conventions.Cardinality.ConstrainedFinite -> (
- match rel.tree with
- | None -> Some []
- | Some tree ->
- let hashes = Merkle.keys tree in
- let rec load_all acc = function
- | [] -> Some (List.rev acc)
- | h :: rest -> (
- match Storage.load_raw storage h with
- | Error _ -> None
- | Ok None -> None
- | Ok (Some bytes) -> (
- let stored = Storable.Tuple.of_bytes bytes in
- let rec load_attrs attr_acc = function
- | [] -> Some (List.rev attr_acc)
- | (name, attr_hash) :: attr_rest -> (
- match Storage.load_raw storage attr_hash with
- | Error _ | Ok None -> None
- | Ok (Some vbytes) ->
- let value : Conventions.AbstractValue.t =
- Marshal.from_bytes vbytes 0
- in
- load_attrs
- ((name, value) :: attr_acc)
- attr_rest)
- in
- match
- load_attrs [] stored.Storable.Tuple.attributes
- with
- | None -> None
- | Some pairs -> load_all (pairs :: acc) rest))
- in
- load_all [] hashes)
+ | Conventions.Cardinality.ConstrainedFinite ->
+ let hashes =
+ match rel.tree with None -> [] | Some tree -> Merkle.keys tree
+ in
+ load_all [] hashes
| _ -> None)
in
{ Constraint.check_membership; iterate_finite }
@@ -187,7 +153,7 @@ module Make (Storage : Management.Physical.S) = struct
let store_relation (storage : storage) (relation : Relation.t) :
(unit, error) Result.t =
match relation.hash with
- | None -> Error (StorageError "Relation has no hash")
+ | None -> Error (Error.StorageError "Relation has no hash")
| Some rel_hash -> (
let tree_keys =
match relation.tree with None -> [] | Some tree -> Merkle.keys tree
@@ -203,7 +169,7 @@ module Make (Storage : Management.Physical.S) = struct
match
Storage.store_raw storage rel_hash (Storable.Relation.to_bytes stored)
with
- | Error _ -> Error (StorageError "Failed to store relation")
+ | Error _ -> Error (Error.StorageError "Failed to store relation")
| Ok () -> Ok ())
(** Store a database state to storage *)
@@ -232,14 +198,14 @@ module Make (Storage : Management.Physical.S) = struct
match
Storage.store_raw storage db.hash (Storable.Database.to_bytes stored)
with
- | Error _ -> Error (StorageError "Failed to store database")
+ | Error _ -> Error (Error.StorageError "Failed to store database")
| Ok () -> Ok ()
(** Load a relation state from storage by hash *)
let load_relation (storage : storage) (rel_hash : Conventions.Hash.t) :
(Relation.t option, error) Result.t =
match Storage.load_raw storage rel_hash with
- | Error _ -> Error (StorageError "Failed to load relation")
+ | Error _ -> Error (Error.StorageError "Failed to load relation")
| Ok None -> Ok None
| Ok (Some bytes) ->
let stored = Storable.Relation.of_bytes bytes in
@@ -252,8 +218,8 @@ module Make (Storage : Management.Physical.S) = struct
Relation.make ~hash:(Some rel_hash) ~name:stored.name
~schema:stored.schema ~tree:(Some tree) ~constraints:None
~cardinality:stored.cardinality ~generator:None
- ~membership_criteria:(build_membership_criteria stored.schema)
- ~provenance:(build_base_provenance stored.schema stored.name)
+ ~membership_criteria:(build_membership_criteria ~name:stored.name stored.schema)
+ ~provenance:(Relation.Provenance.Base stored.name)
~lineage:(Relation.Lineage.Base stored.name)
in
Ok (Some relation)
@@ -264,7 +230,7 @@ module Make (Storage : Management.Physical.S) = struct
let load_database (storage : storage) (db_hash : Conventions.Hash.t) :
(Management.Database.t option, error) Result.t =
match Storage.load_raw storage db_hash with
- | Error _ -> Error (StorageError "Failed to load database")
+ | Error _ -> Error (Error.StorageError "Failed to load database")
| Ok None -> Ok None
| Ok (Some bytes) ->
let stored = Storable.Database.of_bytes bytes in
@@ -278,7 +244,8 @@ module Make (Storage : Management.Physical.S) = struct
| (name, rel_hash) :: rest -> (
let* rel_opt = load_relation storage rel_hash in
match rel_opt with
- | None -> Error (StorageError ("Relation not found: " ^ name))
+ | None ->
+ Error (Error.StorageError ("Relation not found: " ^ name))
| Some rel -> load_relations ((name, rel) :: acc) rest)
in
let* relation_list = load_relations [] stored.relations in
@@ -307,9 +274,9 @@ module Make (Storage : Management.Physical.S) = struct
(** Create a new empty relation with the given schema *)
let create_relation_raw (storage : storage) (db : Management.Database.t)
~(name : string) ~(schema : Schema.t) :
- (Management.Database.t * Relation.t) result =
+ (Management.Database.t * Relation.t, Error.t) Result.t =
if Management.Database.has_relation db name then
- Error (RelationAlreadyExists name)
+ Error (Error.RelationAlreadyExists name)
else
let tree = Merkle.empty in
let relation_hash = Hashing.hash_relation ~name ~schema ~tree in
@@ -317,8 +284,8 @@ module Make (Storage : Management.Physical.S) = struct
Relation.make ~hash:(Some relation_hash) ~name ~schema ~tree:(Some tree)
~constraints:None ~cardinality:(Conventions.Cardinality.Finite 0)
~generator:None
- ~membership_criteria:(build_membership_criteria schema)
- ~provenance:(build_base_provenance schema name)
+ ~membership_criteria:(build_membership_criteria ~name schema)
+ ~provenance:(Relation.Provenance.Base name)
~lineage:(Relation.Lineage.Base name)
in
let new_db = Management.Database.add_relation db ~relation in
@@ -342,7 +309,7 @@ module Make (Storage : Management.Physical.S) = struct
in
match Storage.store_raw storage value_hash value_bytes with
| Error _ ->
- Error (StorageError ("Failed to store attribute: " ^ name))
+ Error (Error.StorageError ("Failed to store attribute: " ^ name))
| Ok () -> store_all ((name, value_hash) :: acc) rest)
in
store_all [] attrs
@@ -351,7 +318,7 @@ module Make (Storage : Management.Physical.S) = struct
let load_tuple (storage : storage) (tuple_hash : Conventions.Hash.t) :
(Tuple.materialized option, error) Result.t =
match Storage.load_raw storage tuple_hash with
- | Error _ -> Error (StorageError "Failed to load tuple")
+ | Error _ -> Error (Error.StorageError "Failed to load tuple")
| Ok None -> Ok None
| Ok (Some tuple_bytes) ->
let stored = Storable.Tuple.of_bytes tuple_bytes in
@@ -360,8 +327,10 @@ module Make (Storage : Management.Physical.S) = struct
| (name, attr_hash) :: rest -> (
match Storage.load_raw storage attr_hash with
| Error _ ->
- Error (StorageError ("Failed to load attribute: " ^ name))
- | Ok None -> Error (StorageError ("Attribute not found: " ^ name))
+ Error
+ (Error.StorageError ("Failed to load attribute: " ^ name))
+ | Ok None ->
+ Error (Error.StorageError ("Attribute not found: " ^ name))
| Ok (Some value_bytes) ->
let value : Conventions.AbstractValue.t =
Marshal.from_bytes value_bytes 0
@@ -385,7 +354,7 @@ module Make (Storage : Management.Physical.S) = struct
| hash :: rest -> (
let* tup_opt = load_tuple storage hash in
match tup_opt with
- | None -> Error (TupleNotFound hash)
+ | None -> Error (Error.TupleNotFound hash)
| Some tuple -> load_all (tuple :: acc) rest)
in
load_all [] hashes
@@ -396,7 +365,8 @@ module Make (Storage : Management.Physical.S) = struct
| Some tup -> on_some tup
| None ->
Error
- (StorageError ("Tuple missing for referenced hash: " ^ tuple_hash))
+ (Error.StorageError
+ ("Tuple missing for referenced hash: " ^ tuple_hash))
let transition_attrs (tuple : Tuple.materialized) =
Tuple.AttributeMap.bindings tuple.attributes
@@ -404,7 +374,7 @@ module Make (Storage : Management.Physical.S) = struct
let ensure_relation_exists (db : Management.Database.t) name =
if Management.Database.has_relation db name then Ok ()
- else Error (RelationNotFound name)
+ else Error (Error.RelationNotFound name)
let bump_cardinality delta = function
| Conventions.Cardinality.Finite n ->
@@ -414,7 +384,13 @@ module Make (Storage : Management.Physical.S) = struct
let rehashed_relation_with_tree ~name ~schema (relation : Relation.t) tree
cardinality =
let hash = Hashing.hash_relation ~name ~schema ~tree in
- { relation with hash = Some hash; tree = Some tree; cardinality }
+ {
+ relation with
+ hash = Some hash;
+ tree = Some tree;
+ cardinality;
+ membership_criteria = build_membership_criteria ~name schema;
+ }
let validate_tuple_constraints (storage : storage)
(db : Management.Database.t) (relation : Relation.t)
@@ -428,14 +404,15 @@ module Make (Storage : Management.Physical.S) = struct
in
match eval_result with
| Ok true -> Ok ()
- | Ok false -> Error (ConstraintViolation "Constraint not satisfied")
+ | Ok false -> Error (Error.ConstraintViolation "Constraint not satisfied")
| Error (Constraint.ConstraintFailures failures) ->
let msg =
String.concat "; "
(List.map (fun (n, _) -> "constraint " ^ n ^ " violated") failures)
in
- Error (ConstraintViolation msg)
- | Error _ -> Error (ConstraintViolation "Constraint evaluation failed")
+ Error (Error.ConstraintViolation msg)
+ | Error _ ->
+ Error (Error.ConstraintViolation "Constraint evaluation failed")
let store_tuple_payload storage tuple_hash (tuple : Tuple.materialized) =
let* attr_hashes = store_attributes storage tuple in
@@ -444,23 +421,25 @@ module Make (Storage : Management.Physical.S) = struct
in
let tuple_bytes = Storable.Tuple.to_bytes stored_tuple in
match Storage.store_raw storage tuple_hash tuple_bytes with
- | Error _ -> Error (StorageError "Failed to store tuple")
+ | Error _ -> Error (Error.StorageError "Failed to store tuple")
| Ok () -> Ok ()
(* Cascade constraint helpers *)
let polarity_triggered_by kind pol =
match (kind, pol) with
- | Insert, (Constraint.Negative | Constraint.Both) -> true
- | Delete, (Constraint.Positive | Constraint.Both) -> true
+ | Constraint.Insert, (Constraint.Negative | Constraint.Both) -> true
+ | Constraint.Delete, (Constraint.Positive | Constraint.Both) -> true
| _ -> false
- let cascade_violation_msg kind dep_rel cname constrained_name =
+ let cascade_violation_msg kind target_relation cname constrained_name =
let verb =
- match kind with Insert -> "inserting into" | Delete -> "deleting from"
+ match kind with
+ | Constraint.Insert -> "inserting into"
+ | Constraint.Delete -> "deleting from"
in
- Printf.sprintf "cascade: %s %s violates constraint %s on %s" verb dep_rel
- cname constrained_name
+ Printf.sprintf "cascade: %s %s violates constraint %s on %s" verb
+ target_relation cname constrained_name
let is_deferred (db : Management.Database.t) rel_name cname =
List.exists
@@ -477,13 +456,15 @@ module Make (Storage : Management.Physical.S) = struct
| None -> false)
filter
- let recheck_one storage ctx mctx cname cbody constrained_name filter
- (h : Conventions.Hash.t) : unit result =
+ let recheck_one storage ctx (mctx : Constraint.mutation_context) cname cbody
+ constrained_name filter (h : Conventions.Hash.t) : (unit, error) Result.t
+ =
with_loaded_tuple storage h ~on_some:(fun tup ->
if not (needs_recheck filter tup) then Ok ()
else
let cbody' =
- Constraint.substitute_transition cbody mctx.dep_rel mctx.transition
+ Constraint.substitute_transition cbody mctx.target_relation
+ mctx.transition
in
match
Constraint.evaluate_first_failure ctx tup [ (cname, cbody') ]
@@ -491,21 +472,21 @@ module Make (Storage : Management.Physical.S) = struct
| Ok true -> Ok ()
| Ok false | Error _ ->
Error
- (ConstraintViolation
- (cascade_violation_msg mctx.kind mctx.dep_rel cname
+ (Error.ConstraintViolation
+ (cascade_violation_msg mctx.kind mctx.target_relation cname
constrained_name)))
- let check_one_constraint storage ctx db mctx constrained_name constrained_rel
- (cname, cbody) : unit result =
+ let check_one_constraint storage ctx db (mctx : Constraint.mutation_context)
+ constrained_name constrained_rel (cname, cbody) : (unit, error) Result.t =
if is_deferred db constrained_name cname then Ok ()
else
let pols = Constraint.polarity_of cbody in
- match Constraint.polarity_find mctx.dep_rel pols with
+ match Constraint.polarity_find mctx.target_relation pols with
| None -> Ok ()
| Some pol when not (polarity_triggered_by mctx.kind pol) -> Ok ()
| Some _ ->
let filter =
- Constraint.focused_filter cbody mctx.dep_rel mctx.transition
+ Constraint.focused_filter cbody mctx.target_relation mctx.transition
in
let hashes =
match constrained_rel.Relation.tree with
@@ -517,13 +498,14 @@ module Make (Storage : Management.Physical.S) = struct
recheck_one storage ctx mctx cname cbody constrained_name filter h)
() hashes
- (** Scan every relation in [db] for constraints that reference [mctx.dep_rel]
- with a polarity matched by the mutation kind, then re-evaluate those
- constraints against the affected tuples in each constrained relation.
+ (** Scan every relation in [db] for constraints that reference
+ [mctx.target_relation] with a polarity matched by the mutation kind, then
+ re-evaluate those constraints against the affected tuples in each
+ constrained relation.
Returns [Ok ()] when all cascade checks pass. *)
let check_cascade_constraints (storage : storage) (db : Management.Database.t)
- (mctx : mutation_context) : unit result =
+ (mctx : Constraint.mutation_context) =
let ctx = build_eval_context storage db in
Management.Database.RelationMap.fold
(fun constrained_name constrained_rel acc ->
@@ -541,11 +523,13 @@ module Make (Storage : Management.Physical.S) = struct
(** Insert a tuple into a relation, storing it in the backend *)
let create_tuple (storage : storage) (db : Management.Database.t)
(relation : Relation.t) (tuple : Tuple.materialized) :
- (Management.Database.t * Relation.t * Conventions.Hash.t) result =
+ (Management.Database.t * Relation.t * Conventions.Hash.t, error) Result.t
+ =
let name = relation.name in
let* () = ensure_relation_exists db name in
- if not (relation.membership_criteria (Tuple.Materialized tuple)) then
- Error (ConstraintViolation "Tuple does not satisfy membership criteria")
+ if not (relation.membership_criteria (tree_of_db db) (Tuple.Materialized tuple)) then
+ Error
+ (Error.ConstraintViolation "Tuple does not satisfy membership criteria")
else
let* () = validate_tuple_constraints storage db relation tuple in
let tuple_hash = Hashing.hash_tuple tuple in
@@ -553,7 +537,7 @@ module Make (Storage : Management.Physical.S) = struct
match relation.tree with Some t -> t | None -> Merkle.empty
in
if Merkle.member tuple_hash current_tree then
- Error (DuplicateTuple tuple_hash)
+ Error (Error.DuplicateTuple tuple_hash)
else
let* () = store_tuple_payload storage tuple_hash tuple in
let new_tree = Merkle.insert tuple_hash current_tree in
@@ -568,9 +552,9 @@ module Make (Storage : Management.Physical.S) = struct
let* () =
check_cascade_constraints storage new_db
{
- dep_rel = name;
+ target_relation = name;
transition = transition_attrs tuple;
- kind = Insert;
+ kind = Constraint.Insert;
}
in
let* () = store_relation storage new_relation in
@@ -580,7 +564,9 @@ module Make (Storage : Management.Physical.S) = struct
(** Insert multiple tuples into a relation *)
let create_tuples (storage : storage) (db : Management.Database.t)
(relation : Relation.t) (tuples : Tuple.materialized list) :
- (Management.Database.t * Relation.t * Conventions.Hash.t list) result =
+ ( Management.Database.t * Relation.t * Conventions.Hash.t list,
+ error )
+ Result.t =
let rec insert_all db rel hashes = function
| [] -> Ok (db, rel, List.rev hashes)
| tuple :: rest ->
@@ -592,16 +578,16 @@ module Make (Storage : Management.Physical.S) = struct
(** Remove a tuple from a relation by its hash *)
let retract_tuple (storage : storage) (db : Management.Database.t)
(relation : Relation.t) ~(tuple_hash : Conventions.Hash.t) :
- (Management.Database.t * Relation.t) result =
+ (Management.Database.t * Relation.t, error) Result.t =
let name = relation.name in
let* () = ensure_relation_exists db name in
let* current_tree =
match relation.tree with
- | None -> Error (TupleNotFound tuple_hash)
+ | None -> Error (Error.TupleNotFound tuple_hash)
| Some tree -> Ok tree
in
if not (Merkle.member tuple_hash current_tree) then
- Error (TupleNotFound tuple_hash)
+ Error (Error.TupleNotFound tuple_hash)
else
(* Note: We don't delete from storage - content-addressed storage is append-only.
The tuple data remains for historical queries / garbage collection later. *)
@@ -618,9 +604,9 @@ module Make (Storage : Management.Physical.S) = struct
with_loaded_tuple storage tuple_hash ~on_some:(fun deleted_tuple ->
check_cascade_constraints storage new_db
{
- dep_rel = name;
+ target_relation = name;
transition = transition_attrs deleted_tuple;
- kind = Delete;
+ kind = Constraint.Delete;
})
in
let* () = store_relation storage new_relation in
@@ -724,7 +710,8 @@ module Make (Storage : Management.Physical.S) = struct
let get_required (db : Management.Database.t) rel_name =
match Management.Database.get_relation db rel_name with
| Some rel -> Ok rel
- | None -> Error (StorageError ("Catalog relation missing: " ^ rel_name))
+ | None ->
+ Error (Error.StorageError ("Catalog relation missing: " ^ rel_name))
in
let* relation_rel = get_required db Prelude.Catalog.relation_rel_name in
let* db, _, _ =
@@ -804,9 +791,9 @@ module Make (Storage : Management.Physical.S) = struct
[sakura:relation] and [sakura:attribute] in the system catalog. *)
let create_relation (storage : storage) (db : Management.Database.t)
~(name : string) ~(schema : Schema.t) :
- (Management.Database.t * Relation.t) result =
+ (Management.Database.t * Relation.t, error) Result.t =
if Management.Database.has_relation db name then
- Error (RelationAlreadyExists name)
+ Error (Error.RelationAlreadyExists name)
else
let tree = Merkle.empty in
let relation_hash = Hashing.hash_relation ~name ~schema ~tree in
@@ -814,8 +801,8 @@ module Make (Storage : Management.Physical.S) = struct
Relation.make ~hash:(Some relation_hash) ~name ~schema ~tree:(Some tree)
~constraints:None ~cardinality:(Conventions.Cardinality.Finite 0)
~generator:None
- ~membership_criteria:(build_membership_criteria schema)
- ~provenance:(build_base_provenance schema name)
+ ~membership_criteria:(build_membership_criteria ~name schema)
+ ~provenance:(Relation.Provenance.Base name)
~lineage:(Relation.Lineage.Base name)
in
let new_db = Management.Database.add_relation db ~relation in
@@ -827,11 +814,11 @@ module Make (Storage : Management.Physical.S) = struct
(** Create an immutable/generator-based relation *)
let create_immutable_relation (storage : storage) (db : Management.Database.t)
~(name : string) ~(schema : Schema.t) ~(generator : Generator.t)
- ~(membership_criteria : Tuple.t -> bool)
+ ~(membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool)
~(cardinality : Conventions.Cardinality.t) :
- (Management.Database.t * Relation.t) result =
+ (Management.Database.t * Relation.t, error) Result.t =
if Management.Database.has_relation db name then
- Error (RelationAlreadyExists name)
+ Error (Error.RelationAlreadyExists name)
else
let relation_hash =
Hashing.hash_relation ~name ~schema ~tree:Merkle.empty
@@ -840,8 +827,7 @@ module Make (Storage : Management.Physical.S) = struct
Relation.make ~hash:(Some relation_hash) ~name ~schema
~tree:None (* No tree for generator-based relations *)
~constraints:None ~cardinality ~generator:(Some generator)
- ~membership_criteria
- ~provenance:(build_base_provenance schema name)
+ ~membership_criteria ~provenance:(Relation.Provenance.Base name)
~lineage:(Relation.Lineage.Base name)
in
let new_db = Management.Database.add_relation db ~relation in
@@ -853,9 +839,9 @@ module Make (Storage : Management.Physical.S) = struct
(** Remove a relation from the database. Also removes its entries from
[sakura:relation] and [sakura:attribute]. *)
let retract_relation (storage : storage) (db : Management.Database.t)
- ~(name : string) : Management.Database.t result =
+ ~(name : string) : (Management.Database.t, error) Result.t =
match Management.Database.get_relation db name with
- | None -> Error (RelationNotFound name)
+ | None -> Error (Error.RelationNotFound name)
| Some relation ->
let new_db = Management.Database.remove_relation db ~name in
(* Update catalog on the db state that no longer contains the retracted relation *)
@@ -865,10 +851,11 @@ module Make (Storage : Management.Physical.S) = struct
(** Clear all tuples from a relation (truncate) *)
let clear_relation (storage : storage) (db : Management.Database.t)
- (relation : Relation.t) : (Management.Database.t * Relation.t) result =
+ (relation : Relation.t) :
+ (Management.Database.t * Relation.t, error) Result.t =
let name = relation.name in
match Management.Database.get_relation db name with
- | None -> Error (RelationNotFound name)
+ | None -> Error (Error.RelationNotFound name)
| Some _ ->
let new_tree = Merkle.empty in
let new_hash =
@@ -880,6 +867,8 @@ module Make (Storage : Management.Physical.S) = struct
hash = Some new_hash;
tree = Some new_tree;
cardinality = Conventions.Cardinality.Finite 0;
+ membership_criteria =
+ build_membership_criteria ~name relation.schema;
}
in
let new_db =
@@ -894,9 +883,9 @@ module Make (Storage : Management.Physical.S) = struct
let update_relation_constraints (storage : storage)
(db : Management.Database.t) ~(relation_name : string)
~(constraints : Relation.RelationConstraint.t) :
- (Management.Database.t * Relation.t) result =
+ (Management.Database.t * Relation.t, error) Result.t =
match Management.Database.get_relation db relation_name with
- | None -> Error (RelationNotFound relation_name)
+ | None -> Error (Error.RelationNotFound relation_name)
| Some relation ->
let merged_constraints =
match relation.constraints with
@@ -1012,7 +1001,7 @@ module Make (Storage : Management.Physical.S) = struct
| Ok true -> Ok ()
| Ok false | Error _ ->
Error
- (ConstraintViolation
+ (Error.ConstraintViolation
(Printf.sprintf
"deferred constraint %s on %s violated"
entry.constraint_name entry.relation_name))))
@@ -1037,6 +1026,3 @@ module Make (Storage : Management.Physical.S) = struct
let* () = store_database storage db' in
Ok db'
end
-
-module Memory = Make (Management.Physical.Memory)
-(** Default instance using in-memory storage for convenience/testing *)
diff --git a/lib/manipulation.mli b/lib/manipulation.mli
deleted file mode 100644
index 2a52b5c..0000000
--- a/lib/manipulation.mli
+++ /dev/null
@@ -1,137 +0,0 @@
-type error =
- | RelationNotFound of string
- | RelationAlreadyExists of string
- | TupleNotFound of Conventions.Hash.t
- | DuplicateTuple of Conventions.Hash.t
- | ConstraintViolation of string
- | StorageError of string
-
-val string_of_error : error -> string
-val sexp_of_error : error -> Sexplib.Sexp.t
-
-type 'a result = ('a, error) Result.t
-
-module Schema = Schema
-
-val hash_tuple : Tuple.materialized -> Conventions.Hash.t
-
-module Make (Storage : Management.Physical.S) : sig
- type storage = Storage.t
- type nonrec error = error
-
- val of_string_error : string -> error
-
- val store_database :
- storage -> Management.Database.t -> (unit, error) Result.t
-
- val load_relation :
- storage -> Conventions.Hash.t -> (Relation.t option, error) Result.t
-
- val load_database :
- storage ->
- Conventions.Hash.t ->
- (Management.Database.t option, error) Result.t
-
- val load_tuple :
- storage -> Conventions.Hash.t -> (Tuple.materialized option, error) Result.t
-
- val load_tuples :
- storage ->
- Conventions.Hash.t list ->
- (Tuple.materialized list, error) Result.t
-
- val create_tuple :
- storage ->
- Management.Database.t ->
- Relation.t ->
- Tuple.materialized ->
- (Management.Database.t * Relation.t * Conventions.Hash.t, error) Result.t
-
- val create_tuples :
- storage ->
- Management.Database.t ->
- Relation.t ->
- Tuple.materialized list ->
- ( Management.Database.t * Relation.t * Conventions.Hash.t list,
- error )
- Result.t
-
- val retract_tuple :
- storage ->
- Management.Database.t ->
- Relation.t ->
- tuple_hash:Conventions.Hash.t ->
- (Management.Database.t * Relation.t, error) Result.t
-
- val register_domain :
- storage ->
- Management.Database.t ->
- Domain.t ->
- (Management.Database.t, error) Result.t
-
- val create_database :
- storage -> name:string -> (Management.Database.t, error) Result.t
-
- val database_history : Management.Database.t -> Conventions.Hash.t list
-
- val create_relation :
- storage ->
- Management.Database.t ->
- name:string ->
- schema:Schema.t ->
- (Management.Database.t * Relation.t, error) Result.t
-
- val create_immutable_relation :
- storage ->
- Management.Database.t ->
- name:string ->
- schema:Schema.t ->
- generator:Generator.t ->
- membership_criteria:(Tuple.t -> bool) ->
- cardinality:Conventions.Cardinality.t ->
- (Management.Database.t * Relation.t, error) Result.t
-
- val retract_relation :
- storage ->
- Management.Database.t ->
- name:string ->
- Management.Database.t result
-
- val clear_relation :
- storage ->
- Management.Database.t ->
- Relation.t ->
- (Management.Database.t * Relation.t, error) Result.t
-
- val register_constraint :
- storage ->
- Management.Database.t ->
- constraint_name:string ->
- relation_name:string ->
- body:Constraint.t ->
- (Management.Database.t, error) Result.t
-
- val tuple_hashes : Relation.t -> Conventions.Hash.t list
- val get_relation : Management.Database.t -> name:string -> Relation.t option
- val tuple_count : Relation.t -> int
- val tuple_exists : Relation.t -> Conventions.Hash.t -> bool
-
- val attach_constraint :
- storage ->
- Management.Database.t ->
- constraint_name:string ->
- relation_name:string ->
- body:Constraint.t ->
- timing:Constraint.timing ->
- (Management.Database.t, error) Result.t
-
- val check_deferred_constraints :
- storage -> Management.Database.t -> (unit, error) Result.t
-
- val commit :
- storage -> Management.Database.t -> (Management.Database.t, error) Result.t
-end
-
-module Memory : sig
- include module type of Make (Management.Physical.Memory)
-end
diff --git a/lib/prelude/standard.ml b/lib/prelude/standard.ml
index 6bdab0c..6822f19 100644
--- a/lib/prelude/standard.ml
+++ b/lib/prelude/standard.ml
@@ -15,7 +15,8 @@ let make_comparison ~name ~domain_name ~pred ~cardinality ~generator =
|> Schema.add "left" domain_name
|> Schema.add "right" domain_name
in
- let membership_criteria : Tuple.t -> bool = function
+ let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
+ fun _tree_of -> function
| Tuple.Materialized m -> (
match
( Tuple.AttributeMap.find_opt "left" m.attributes,
@@ -176,7 +177,8 @@ let plus_natural : Relation.t =
(Tuple.make_materialized ~relation:"plus" ~attributes, generator)
| None -> Error "Cannot enumerate plus randomly."
in
- let membership_criteria : Tuple.t -> bool = function
+ let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
+ fun _tree_of -> function
| Tuple.Materialized m -> (
match
( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -214,7 +216,8 @@ let times_natural : Relation.t =
(Tuple.make_materialized ~relation:"times" ~attributes, generator)
| None -> Error "Cannot enumerate times randomly."
in
- let membership_criteria : Tuple.t -> bool = function
+ let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
+ fun _tree_of -> function
| Tuple.Materialized m -> (
match
( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -253,7 +256,8 @@ let minus_natural : Relation.t =
(Tuple.make_materialized ~relation:"minus" ~attributes, generator)
| None -> Error "Cannot enumerate minus randomly."
in
- let membership_criteria : Tuple.t -> bool = function
+ let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
+ fun _tree_of -> function
| Tuple.Materialized m -> (
match
( Tuple.AttributeMap.find_opt "a" m.attributes,
@@ -301,7 +305,8 @@ let divide_natural : Relation.t =
(Tuple.make_materialized ~relation:"divide" ~attributes, generator)
| None -> Error "Cannot enumerate divide randomly."
in
- let membership_criteria : Tuple.t -> bool = function
+ let membership_criteria : (string -> Merkle.t option) -> Tuple.t -> bool =
+ fun _tree_of -> function
| Tuple.Materialized m -> (
match
( Tuple.AttributeMap.find_opt "a" m.attributes,
diff --git a/lib/relation.ml b/lib/relation.ml
index 285bcef..0855b57 100644
--- a/lib/relation.ml
+++ b/lib/relation.ml
@@ -36,7 +36,7 @@ type t = {
constraints : RelationConstraint.t option;
cardinality : Conventions.Cardinality.t;
generator : Generator.t option;
- membership_criteria : Tuple.t -> bool;
+ membership_criteria : (string -> Tree.t option) -> Tuple.t -> bool;
provenance : Provenance.t;
lineage : Lineage.t;
}
diff --git a/lib/transport.ml b/lib/transport.ml
new file mode 100644
index 0000000..5130a2d
--- /dev/null
+++ b/lib/transport.ml
@@ -0,0 +1,41 @@
+module type TRANSPORT = sig
+ type t
+ type connection
+ type options
+
+ val create : options -> t
+
+ val listen : t -> unit
+ val accept : t -> connection
+
+ val input : connection -> in_channel
+ val output : connection -> out_channel
+end
+
+(* TODO: move this into TCP once we have a proper configuration system *)
+type tcp_options = {
+ address_family : Unix.socket_domain;
+ address : Unix.sockaddr
+}
+
+module TCP : (TRANSPORT with type options = tcp_options) = struct
+ type t = Unix.file_descr
+ type connection = Unix.file_descr
+ type options = tcp_options
+
+ let create { address_family; address } =
+ let socket = Unix.socket address_family Unix.SOCK_STREAM 0 in
+ Unix.setsockopt socket Unix.SO_REUSEADDR true;
+ Unix.setsockopt socket Unix.SO_REUSEPORT true;
+ Unix.bind socket address;
+ socket
+
+ let listen fd = Unix.listen fd 5
+
+ let accept fd =
+ let (conn, _) = Unix.accept fd in
+ conn
+
+ let input = Unix.in_channel_of_descr
+ let output = Unix.out_channel_of_descr
+end
diff --git a/test/test_relational_engine.ml b/test/test_relational_engine.ml
index 453cd9c..7d45725 100644
--- a/test/test_relational_engine.ml
+++ b/test/test_relational_engine.ml
@@ -2,6 +2,8 @@
open Relational_engine
+module Memory = Manipulation.Make (Management.Physical.Memory)
+
let%test_unit "merkle: empty tree" =
let tree = Merkle.empty in
assert (Merkle.is_empty tree);
@@ -145,7 +147,7 @@ let%test_unit "database: add relation" =
Relation.make ~hash:(Some "rel_hash_1") ~name:"users" ~schema:Schema.empty
~tree:(Some Merkle.empty) ~constraints:None
~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "users")
in
@@ -160,7 +162,7 @@ let%test_unit "database: remove relation" =
Relation.make ~hash:(Some "hash1") ~name:"users" ~schema:Schema.empty
~tree:(Some Merkle.empty) ~constraints:None
~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "users")
in
@@ -175,7 +177,7 @@ let%test_unit "database: update relation" =
Relation.make ~hash:(Some "hash1") ~name:"users" ~schema:Schema.empty
~tree:(Some Merkle.empty) ~constraints:None
~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "users")
in
@@ -193,7 +195,7 @@ let%test_unit "database: get relation names" =
Relation.make ~hash:(Some "h1") ~name:"users" ~schema:Schema.empty
~tree:(Some Merkle.empty) ~constraints:None
~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "users")
in
@@ -201,7 +203,7 @@ let%test_unit "database: get relation names" =
Relation.make ~hash:(Some "h2") ~name:"orders" ~schema:Schema.empty
~tree:(Some Merkle.empty) ~constraints:None
~cardinality:(Conventions.Cardinality.Finite 0) ~generator:None
- ~membership_criteria:(fun _ -> true)
+ ~membership_criteria:(fun _ _ -> true)
~provenance:Relation.Provenance.Undefined
~lineage:(Relation.Lineage.Base "orders")
in
@@ -223,14 +225,14 @@ let with_storage f =
let%test_unit "manipulation: create database" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"my_db" with
+ match Memory.create_database storage ~name:"my_db" with
| Error _ -> assert false
| Ok db -> assert (db.name = "my_db"))
let%test_unit "manipulation: create relation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -238,7 +240,7 @@ let%test_unit "manipulation: create relation" =
Schema.empty |> Schema.add "name" "string" |> Schema.add "age" "integer"
in
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, relation) ->
@@ -249,38 +251,38 @@ let%test_unit "manipulation: create relation" =
let%test_unit "manipulation: create relation already exists" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> (
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
- | Error (Manipulation.RelationAlreadyExists _) -> ()
+ | Error (Error.RelationAlreadyExists _) -> ()
| _ -> assert false))
let%test_unit "manipulation: retract relation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> (
assert (Management.Database.has_relation db "users");
match
- Manipulation.Memory.retract_relation storage db ~name:"users"
+ Memory.retract_relation storage db ~name:"users"
with
| Error _ -> assert false
| Ok db -> assert (not (Management.Database.has_relation db "users"))))
@@ -288,13 +290,13 @@ let%test_unit "manipulation: retract relation" =
let%test_unit "manipulation: create tuple with storage" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "name" "string" in
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -306,21 +308,21 @@ let%test_unit "manipulation: create tuple with storage" =
let tuple : Tuple.materialized =
{ relation = "users"; attributes = attrs }
in
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok (_db, new_relation, _hash) ->
- assert (Manipulation.Memory.tuple_count new_relation = 1)))
+ assert (Memory.tuple_count new_relation = 1)))
let%test_unit "manipulation: create and load tuple" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "value" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema
+ Memory.create_relation storage db ~name:"numbers" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -331,11 +333,11 @@ let%test_unit "manipulation: create and load tuple" =
let tuple : Tuple.materialized =
{ relation = "numbers"; attributes = attrs }
in
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok (_db, _relation, tuple_hash) -> (
(* Now load the tuple back from storage *)
- match Manipulation.Memory.load_tuple storage tuple_hash with
+ match Memory.load_tuple storage tuple_hash with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded_tuple) ->
@@ -348,13 +350,13 @@ let%test_unit "manipulation: create and load tuple" =
let%test_unit "manipulation: create multiple tuples with storage" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "id" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"items" ~schema
+ Memory.create_relation storage db ~name:"items" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -368,23 +370,23 @@ let%test_unit "manipulation: create multiple tuples with storage" =
in
let tuples = [ make_tuple 1; make_tuple 2; make_tuple 3 ] in
match
- Manipulation.Memory.create_tuples storage db relation tuples
+ Memory.create_tuples storage db relation tuples
with
| Error _ -> assert false
| Ok (_db, new_relation, hashes) ->
- assert (Manipulation.Memory.tuple_count new_relation = 3);
+ assert (Memory.tuple_count new_relation = 3);
assert (List.length hashes = 3)))
let%test_unit "manipulation: load multiple tuples" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "n" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"test" ~schema
+ Memory.create_relation storage db ~name:"test" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -397,12 +399,12 @@ let%test_unit "manipulation: load multiple tuples" =
: Tuple.materialized)
in
match
- Manipulation.Memory.create_tuples storage db relation
+ Memory.create_tuples storage db relation
[ make_tuple 10; make_tuple 20 ]
with
| Error _ -> assert false
| Ok (_db, _relation, hashes) -> (
- match Manipulation.Memory.load_tuples storage hashes with
+ match Memory.load_tuples storage hashes with
| Error _ -> assert false
| Ok loaded ->
assert (List.length loaded = 2);
@@ -421,13 +423,13 @@ let%test_unit "manipulation: load multiple tuples" =
let%test_unit "manipulation: retract tuple" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "value" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"numbers" ~schema
+ Memory.create_relation storage db ~name:"numbers" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -438,19 +440,19 @@ let%test_unit "manipulation: retract tuple" =
let tuple : Tuple.materialized =
{ relation = "numbers"; attributes = attrs }
in
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok (db, relation, tuple_hash) -> (
- assert (Manipulation.Memory.tuple_count relation = 1);
+ assert (Memory.tuple_count relation = 1);
match
- Manipulation.Memory.retract_tuple storage db relation
+ Memory.retract_tuple storage db relation
~tuple_hash
with
| Error _ -> assert false
| Ok (_db, relation) -> (
- assert (Manipulation.Memory.tuple_count relation = 0);
+ assert (Memory.tuple_count relation = 0);
(* Tuple data still exists in storage (append-only) *)
- match Manipulation.Memory.load_tuple storage tuple_hash with
+ match Memory.load_tuple storage tuple_hash with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some _) -> () (* Data is still there *)))))
@@ -458,13 +460,13 @@ let%test_unit "manipulation: retract tuple" =
let%test_unit "manipulation: tuple hashes" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
match
- Manipulation.Memory.create_relation storage db ~name:"test" ~schema
+ Memory.create_relation storage db ~name:"test" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -477,24 +479,24 @@ let%test_unit "manipulation: tuple hashes" =
: Tuple.materialized)
in
match
- Manipulation.Memory.create_tuples storage db relation
+ Memory.create_tuples storage db relation
[ make_tuple 1; make_tuple 2 ]
with
| Error _ -> assert false
| Ok (_db, relation, _) ->
- let hashes = Manipulation.Memory.tuple_hashes relation in
+ let hashes = Memory.tuple_hashes relation in
assert (List.length hashes = 2)))
let%test_unit "manipulation: clear relation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
match
- Manipulation.Memory.create_relation storage db ~name:"test" ~schema
+ Memory.create_relation storage db ~name:"test" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -507,27 +509,27 @@ let%test_unit "manipulation: clear relation" =
: Tuple.materialized)
in
match
- Manipulation.Memory.create_tuples storage db relation
+ Memory.create_tuples storage db relation
[ make_tuple 1; make_tuple 2; make_tuple 3 ]
with
| Error _ -> assert false
| Ok (db, relation, _) -> (
- assert (Manipulation.Memory.tuple_count relation = 3);
- match Manipulation.Memory.clear_relation storage db relation with
+ assert (Memory.tuple_count relation = 3);
+ match Memory.clear_relation storage db relation with
| Error _ -> assert false
| Ok (_db, relation) ->
- assert (Manipulation.Memory.tuple_count relation = 0))))
+ assert (Memory.tuple_count relation = 0))))
let%test_unit "manipulation: duplicate tuple rejected" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "x" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"test" ~schema
+ Memory.create_relation storage db ~name:"test" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -538,26 +540,26 @@ let%test_unit "manipulation: duplicate tuple rejected" =
let tuple : Tuple.materialized =
{ relation = "test"; attributes = attrs }
in
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok (db, relation, _) -> (
(* Try to insert the same tuple again *)
match
- Manipulation.Memory.create_tuple storage db relation tuple
+ Memory.create_tuple storage db relation tuple
with
- | Error (Manipulation.DuplicateTuple _) -> ()
+ | Error (Error.DuplicateTuple _) -> ()
| _ -> assert false)))
let%test_unit "manipulation: tuple_exists check" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
match
- Manipulation.Memory.create_relation storage db ~name:"test" ~schema
+ Memory.create_relation storage db ~name:"test" ~schema
with
| Error _ -> assert false
| Ok (db, relation) -> (
@@ -568,13 +570,13 @@ let%test_unit "manipulation: tuple_exists check" =
let tuple : Tuple.materialized =
{ relation = "test"; attributes = attrs }
in
- let tuple_hash = Manipulation.hash_tuple tuple in
- assert (not (Manipulation.Memory.tuple_exists relation tuple_hash));
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ let tuple_hash = Hashing.hash_tuple tuple in
+ assert (not (Memory.tuple_exists relation tuple_hash));
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok (_db, relation, hash) ->
assert (hash = tuple_hash);
- assert (Manipulation.Memory.tuple_exists relation tuple_hash)))
+ assert (Memory.tuple_exists relation tuple_hash)))
let%test_unit "manipulation: hash_tuple deterministic" =
let attrs =
@@ -583,8 +585,8 @@ let%test_unit "manipulation: hash_tuple deterministic" =
|> Tuple.AttributeMap.add "b" { Attribute.value = Obj.magic 2 }
in
let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } in
- let hash1 = Manipulation.hash_tuple tuple in
- let hash2 = Manipulation.hash_tuple tuple in
+ let hash1 = Hashing.hash_tuple tuple in
+ let hash2 = Hashing.hash_tuple tuple in
assert (hash1 = hash2)
let%test_unit "manipulation: different tuples different hashes" =
@@ -602,25 +604,25 @@ let%test_unit "manipulation: different tuples different hashes" =
Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 2 };
}
in
- let hash1 = Manipulation.hash_tuple tuple1 in
- let hash2 = Manipulation.hash_tuple tuple2 in
+ let hash1 = Hashing.hash_tuple tuple1 in
+ let hash2 = Hashing.hash_tuple tuple2 in
assert (hash1 <> hash2)
let%test_unit "manipulation: get_relation from database" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "id" "integer" in
match
- Manipulation.Memory.create_relation storage db ~name:"items" ~schema
+ Memory.create_relation storage db ~name:"items" ~schema
with
| Error _ -> assert false
| Ok (db, _relation) -> (
(* Now get the relation from the database *)
- match Manipulation.Memory.get_relation db ~name:"items" with
+ match Memory.get_relation db ~name:"items" with
| None -> assert false
| Some rel ->
assert (rel.name = "items");
@@ -629,7 +631,7 @@ let%test_unit "manipulation: get_relation from database" =
let%test_unit "schema: persisted and loaded correctly" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -638,7 +640,7 @@ let%test_unit "schema: persisted and loaded correctly" =
|> Schema.add "email" "string"
in
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _relation) -> (
@@ -647,7 +649,7 @@ let%test_unit "schema: persisted and loaded correctly" =
Option.get (Management.Database.get_relation_hash db "users")
in
(* Load the relation from storage *)
- match Manipulation.Memory.load_relation storage rel_hash with
+ match Memory.load_relation storage rel_hash with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded_rel) ->
@@ -659,7 +661,7 @@ let%test_unit "schema: persisted and loaded correctly" =
let%test_unit "catalog: create_database seeds 6 catalog relations" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let catalog_names = Prelude.Catalog.catalog_relation_names in
@@ -669,63 +671,63 @@ let%test_unit "catalog: create_database seeds 6 catalog relations" =
let%test_unit "catalog: sakura:relation contains all 6 catalog names" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let rel =
match
- Manipulation.Memory.get_relation db ~name:"sakura:relation"
+ Memory.get_relation db ~name:"sakura:relation"
with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 6))
+ assert (Memory.tuple_count rel = 6))
let%test_unit "catalog: sakura:on contains insert, update, delete" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let on_rel =
- match Manipulation.Memory.get_relation db ~name:"sakura:on" with
+ match Memory.get_relation db ~name:"sakura:on" with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count on_rel = 3))
+ assert (Memory.tuple_count on_rel = 3))
let%test_unit "catalog: sakura:timing contains immediate, deferred" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let timing_rel =
- match Manipulation.Memory.get_relation db ~name:"sakura:timing" with
+ match Memory.get_relation db ~name:"sakura:timing" with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count timing_rel = 2))
+ assert (Memory.tuple_count timing_rel = 2))
let%test_unit "catalog: sakura:domain seeded with 4 prelude domains" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let dom_rel =
- match Manipulation.Memory.get_relation db ~name:"sakura:domain" with
+ match Memory.get_relation db ~name:"sakura:domain" with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count dom_rel = 4))
+ assert (Memory.tuple_count dom_rel = 4))
let%test_unit "catalog: create_relation updates sakura:relation" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let schema = Schema.empty |> Schema.add "id" "natural" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"employees"
+ Memory.create_relation storage db ~name:"employees"
~schema
with
| Error _ -> assert false
@@ -733,23 +735,23 @@ let%test_unit "catalog: create_relation updates sakura:relation" =
in
let rel =
match
- Manipulation.Memory.get_relation db ~name:"sakura:relation"
+ Memory.get_relation db ~name:"sakura:relation"
with
| None -> assert false
| Some r -> r
in
(* 6 catalog relations + 1 user relation *)
- assert (Manipulation.Memory.tuple_count rel = 7))
+ assert (Memory.tuple_count rel = 7))
let%test_unit "catalog: create_relation updates sakura:attribute" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let schema = Schema.empty |> Schema.add "id" "natural" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"employees"
+ Memory.create_relation storage db ~name:"employees"
~schema
with
| Error _ -> assert false
@@ -757,7 +759,7 @@ let%test_unit "catalog: create_relation updates sakura:attribute" =
in
let attr_rel =
match
- Manipulation.Memory.get_relation db ~name:"sakura:attribute"
+ Memory.get_relation db ~name:"sakura:attribute"
with
| None -> assert false
| Some r -> r
@@ -765,18 +767,18 @@ let%test_unit "catalog: create_relation updates sakura:attribute" =
(* catalog attribute tuples (sum of schema sizes of all 6 catalog relations) + 1 for employees *)
(* sakura:relation: 1, sakura:domain: 1, sakura:attribute: 3, sakura:constraint: 2,
sakura:on: 1, sakura:timing: 1 => 9 catalog attrs + 1 for employees = 10 *)
- let count = Manipulation.Memory.tuple_count attr_rel in
+ let count = Memory.tuple_count attr_rel in
assert (count = 10))
let%test_unit "catalog: retract_relation removes from sakura:relation" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let schema = Schema.empty |> Schema.add "id" "natural" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"employees"
+ Memory.create_relation storage db ~name:"employees"
~schema
with
| Error _ -> assert false
@@ -784,30 +786,30 @@ let%test_unit "catalog: retract_relation removes from sakura:relation" =
in
let db =
match
- Manipulation.Memory.retract_relation storage db ~name:"employees"
+ Memory.retract_relation storage db ~name:"employees"
with
| Error _ -> assert false
| Ok db -> db
in
let rel =
match
- Manipulation.Memory.get_relation db ~name:"sakura:relation"
+ Memory.get_relation db ~name:"sakura:relation"
with
| None -> assert false
| Some r -> r
in
(* Back to 6 catalog relations *)
- assert (Manipulation.Memory.tuple_count rel = 6))
+ assert (Memory.tuple_count rel = 6))
let%test_unit "catalog: register_constraint inserts into sakura:constraint" =
with_storage (fun storage ->
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db ->
let schema = Schema.empty |> Schema.add "id" "natural" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"orders"
+ Memory.create_relation storage db ~name:"orders"
~schema
with
| Error _ -> assert false
@@ -815,7 +817,7 @@ let%test_unit "catalog: register_constraint inserts into sakura:constraint" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"orders_id_positive" ~relation_name:"orders"
~body:(Constraint.And [])
with
@@ -824,18 +826,18 @@ let%test_unit "catalog: register_constraint inserts into sakura:constraint" =
in
let con_rel =
match
- Manipulation.Memory.get_relation db ~name:"sakura:constraint"
+ Memory.get_relation db ~name:"sakura:constraint"
with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count con_rel = 1))
+ assert (Memory.tuple_count con_rel = 1))
let%test_unit "integration: full workflow with storage" =
with_storage (fun storage ->
(* Create database *)
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
@@ -848,7 +850,7 @@ let%test_unit "integration: full workflow with storage" =
let db, products =
match
- Manipulation.Memory.create_relation storage db ~name:"products"
+ Memory.create_relation storage db ~name:"products"
~schema
with
| Error _ -> assert false
@@ -877,39 +879,39 @@ let%test_unit "integration: full workflow with storage" =
in
let db, products, hashes =
- match Manipulation.Memory.create_tuples storage db products tuples with
+ match Memory.create_tuples storage db products tuples with
| Error _ -> assert false
| Ok x -> x
in
- assert (Manipulation.Memory.tuple_count products = 3);
+ assert (Memory.tuple_count products = 3);
assert (List.length hashes = 3);
(* Verify we can load all tuples back *)
- (match Manipulation.Memory.load_tuples storage hashes with
+ (match Memory.load_tuples storage hashes with
| Error _ -> assert false
| Ok loaded -> assert (List.length loaded = 3));
(* Delete one product *)
- let banana_hash = Manipulation.hash_tuple (make_product 2 "Banana" 50) in
+ let banana_hash = Hashing.hash_tuple (make_product 2 "Banana" 50) in
let _db, products =
match
- Manipulation.Memory.retract_tuple storage db products
+ Memory.retract_tuple storage db products
~tuple_hash:banana_hash
with
| Error _ -> assert false
| Ok x -> x
in
- assert (Manipulation.Memory.tuple_count products = 2);
+ assert (Memory.tuple_count products = 2);
(* Verify remaining hashes *)
- let remaining_hashes = Manipulation.Memory.tuple_hashes products in
+ let remaining_hashes = Memory.tuple_hashes products in
assert (List.length remaining_hashes = 2);
assert (not (List.mem banana_hash remaining_hashes));
(* But banana data is still in storage (append-only) *)
- match Manipulation.Memory.load_tuple storage banana_hash with
+ match Memory.load_tuple storage banana_hash with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded) ->
@@ -919,7 +921,7 @@ let%test_unit "integration: full workflow with storage" =
let%test_unit "integration: database history tracking" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"versioned" with
+ match Memory.create_database storage ~name:"versioned" with
| Error _ -> assert false
| Ok db -> db
in
@@ -928,7 +930,7 @@ let%test_unit "integration: database history tracking" =
let schema = Schema.empty in
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"rel1" ~schema
+ Memory.create_relation storage db ~name:"rel1" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -941,7 +943,7 @@ let%test_unit "integration: database history tracking" =
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"rel2" ~schema
+ Memory.create_relation storage db ~name:"rel2" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -954,7 +956,7 @@ let%test_unit "integration: database history tracking" =
let%test_unit "integration: hash bubbles up correctly" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
@@ -962,7 +964,7 @@ let%test_unit "integration: hash bubbles up correctly" =
let db, relation =
match
- Manipulation.Memory.create_relation storage db ~name:"items" ~schema
+ Memory.create_relation storage db ~name:"items" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -981,7 +983,7 @@ let%test_unit "integration: hash bubbles up correctly" =
in
let db, relation, _ =
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok x -> x
in
@@ -1003,7 +1005,7 @@ let%test_unit "integration: hash bubbles up correctly" =
let%test_unit "branching: load database from historical hash" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1012,7 +1014,7 @@ let%test_unit "branching: load database from historical hash" =
(* Create relation and add a tuple *)
let db, relation =
match
- Manipulation.Memory.create_relation storage db ~name:"items" ~schema
+ Memory.create_relation storage db ~name:"items" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -1027,7 +1029,7 @@ let%test_unit "branching: load database from historical hash" =
in
let db, _relation, _ =
- match Manipulation.Memory.create_tuple storage db relation tuple with
+ match Memory.create_tuple storage db relation tuple with
| Error _ -> assert false
| Ok x -> x
in
@@ -1046,13 +1048,13 @@ let%test_unit "branching: load database from historical hash" =
(* Get relation from database - it's now integrated! *)
let relation =
- match Manipulation.Memory.get_relation db ~name:"items" with
+ match Memory.get_relation db ~name:"items" with
| None -> assert false
| Some r -> r
in
let db, _relation, _ =
- match Manipulation.Memory.create_tuple storage db relation tuple2 with
+ match Memory.create_tuple storage db relation tuple2 with
| Error _ -> assert false
| Ok x -> x
in
@@ -1061,23 +1063,23 @@ let%test_unit "branching: load database from historical hash" =
assert (h1 <> h2);
(* Now load H1 from storage - should get database state with 1 tuple *)
- match Manipulation.Memory.load_database storage h1 with
+ match Memory.load_database storage h1 with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded_db) -> (
assert (loaded_db.hash = h1);
assert (loaded_db.name = "test");
(* The relation is now loaded directly in the database *)
- match Manipulation.Memory.get_relation loaded_db ~name:"items" with
+ match Memory.get_relation loaded_db ~name:"items" with
| None -> assert false
| Some loaded_rel ->
(* Should have 1 tuple *)
- assert (Manipulation.Memory.tuple_count loaded_rel = 1)))
+ assert (Memory.tuple_count loaded_rel = 1)))
let%test_unit "branching: branch from historical state" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1086,7 +1088,7 @@ let%test_unit "branching: branch from historical state" =
(* Create relation *)
let db, relation =
match
- Manipulation.Memory.create_relation storage db ~name:"data" ~schema
+ Memory.create_relation storage db ~name:"data" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -1101,7 +1103,7 @@ let%test_unit "branching: branch from historical state" =
}
in
let db, relation, _ =
- match Manipulation.Memory.create_tuple storage db relation tuple_a with
+ match Memory.create_tuple storage db relation tuple_a with
| Error _ -> assert false
| Ok x -> x
in
@@ -1118,7 +1120,7 @@ let%test_unit "branching: branch from historical state" =
}
in
let db_main, relation_main, _ =
- match Manipulation.Memory.create_tuple storage db relation tuple_b with
+ match Memory.create_tuple storage db relation tuple_b with
| Error _ -> assert false
| Ok x -> x
in
@@ -1126,14 +1128,14 @@ let%test_unit "branching: branch from historical state" =
(* Now branch from H1 and add tuple C instead *)
let db_branch =
- match Manipulation.Memory.load_database storage h1 with
+ match Memory.load_database storage h1 with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some d) -> d
in
(* Relation is now loaded directly in the database *)
let relation_branch =
- match Manipulation.Memory.get_relation db_branch ~name:"data" with
+ match Memory.get_relation db_branch ~name:"data" with
| None -> assert false
| Some r -> r
in
@@ -1147,7 +1149,7 @@ let%test_unit "branching: branch from historical state" =
in
let db_branch, _relation_branch, _ =
match
- Manipulation.Memory.create_tuple storage db_branch relation_branch
+ Memory.create_tuple storage db_branch relation_branch
tuple_c
with
| Error _ -> assert false
@@ -1161,21 +1163,21 @@ let%test_unit "branching: branch from historical state" =
assert (h2 <> h3);
(* H2 (main branch) has tuples A and B *)
- assert (Manipulation.Memory.tuple_count relation_main = 2);
+ assert (Memory.tuple_count relation_main = 2);
(* H1 is still loadable and unchanged *)
- match Manipulation.Memory.load_database storage h1 with
+ match Memory.load_database storage h1 with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded_h1) -> (
- match Manipulation.Memory.get_relation loaded_h1 ~name:"data" with
+ match Memory.get_relation loaded_h1 ~name:"data" with
| None -> assert false
- | Some r -> assert (Manipulation.Memory.tuple_count r = 1)))
+ | Some r -> assert (Memory.tuple_count r = 1)))
let%test_unit "branching: full reconstruction from hash" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1184,7 +1186,7 @@ let%test_unit "branching: full reconstruction from hash" =
(* Create relation *)
let db, relation =
match
- Manipulation.Memory.create_relation storage db ~name:"products"
+ Memory.create_relation storage db ~name:"products"
~schema
with
| Error _ -> assert false
@@ -1202,7 +1204,7 @@ let%test_unit "branching: full reconstruction from hash" =
in
let db, _relation, _ =
match
- Manipulation.Memory.create_tuples storage db relation
+ Memory.create_tuples storage db relation
[
make_product "Apple"; make_product "Banana"; make_product "Cherry";
]
@@ -1214,20 +1216,20 @@ let%test_unit "branching: full reconstruction from hash" =
let saved_hash = db.hash in
(* Now reconstruct everything from just the hash *)
- match Manipulation.Memory.load_database storage saved_hash with
+ match Memory.load_database storage saved_hash with
| Error _ -> assert false
| Ok None -> assert false
| Ok (Some loaded_db) -> (
(* Relation is now loaded directly in the database *)
- match Manipulation.Memory.get_relation loaded_db ~name:"products" with
+ match Memory.get_relation loaded_db ~name:"products" with
| None -> assert false
| Some loaded_rel -> (
(* Get tuple hashes from relation *)
- let tuple_hashes = Manipulation.Memory.tuple_hashes loaded_rel in
+ let tuple_hashes = Memory.tuple_hashes loaded_rel in
assert (List.length tuple_hashes = 3);
(* Load all tuples *)
- match Manipulation.Memory.load_tuples storage tuple_hashes with
+ match Memory.load_tuples storage tuple_hashes with
| Error _ -> assert false
| Ok tuples ->
assert (List.length tuples = 3);
@@ -1258,7 +1260,7 @@ let make_int_tuple relation pairs =
let stored_relation_with_ints storage db ~name ~attr values =
let schema = Schema.empty |> Schema.add attr "integer" in
let db, rel =
- match Manipulation.Memory.create_relation storage db ~name ~schema with
+ match Memory.create_relation storage db ~name ~schema with
| Error _ -> assert false
| Ok x -> x
in
@@ -1273,7 +1275,7 @@ let stored_relation_with_ints storage db ~name ~attr values =
values
in
let db, rel, _ =
- match Manipulation.Memory.create_tuples storage db rel tuples with
+ match Memory.create_tuples storage db rel tuples with
| Error _ -> assert false
| Ok x -> x
in
@@ -1298,7 +1300,7 @@ let%test_unit "algebra: const_relation single tuple" =
let%test_unit "algebra: select_fn with predicate" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1335,7 +1337,7 @@ let%test_unit "algebra: select_fn with predicate" =
let%test_unit "algebra: project restricts schema" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1344,7 +1346,7 @@ let%test_unit "algebra: project restricts schema" =
in
let db, rel =
match
- Manipulation.Memory.create_relation storage db ~name:"ab" ~schema
+ Memory.create_relation storage db ~name:"ab" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -1356,7 +1358,7 @@ let%test_unit "algebra: project restricts schema" =
in
let _, rel, _ =
match
- Manipulation.Memory.create_tuple storage db rel
+ Memory.create_tuple storage db rel
{ Tuple.relation = "ab"; attributes = attrs }
with
| Error _ -> assert false
@@ -1375,7 +1377,7 @@ let%test_unit "algebra: project restricts schema" =
let%test_unit "algebra: rename changes attr names" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1401,7 +1403,7 @@ let%test_unit "algebra: rename changes attr names" =
let%test_unit "algebra: equijoin merges matching tuples" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1411,7 +1413,7 @@ let%test_unit "algebra: equijoin merges matching tuples" =
in
let db, left =
match
- Manipulation.Memory.create_relation storage db ~name:"L"
+ Memory.create_relation storage db ~name:"L"
~schema:schema_l
with
| Error _ -> assert false
@@ -1429,7 +1431,7 @@ let%test_unit "algebra: equijoin merges matching tuples" =
in
let db, left, _ =
match
- Manipulation.Memory.create_tuples storage db left
+ Memory.create_tuples storage db left
[ make_left 1 "Alice"; make_left 2 "Bob" ]
with
| Error _ -> assert false
@@ -1442,7 +1444,7 @@ let%test_unit "algebra: equijoin merges matching tuples" =
in
let db, right =
match
- Manipulation.Memory.create_relation storage db ~name:"R"
+ Memory.create_relation storage db ~name:"R"
~schema:schema_r
with
| Error _ -> assert false
@@ -1460,7 +1462,7 @@ let%test_unit "algebra: equijoin merges matching tuples" =
in
let _, right, _ =
match
- Manipulation.Memory.create_tuples storage db right
+ Memory.create_tuples storage db right
[ make_right 1 100; make_right 3 999 ]
with
| Error _ -> assert false
@@ -1485,7 +1487,7 @@ let%test_unit "algebra: equijoin merges matching tuples" =
let%test_unit "algebra: equijoin empty match" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1505,7 +1507,7 @@ let%test_unit "algebra: equijoin empty match" =
let%test_unit "algebra: union concatenates streams" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1538,7 +1540,7 @@ let%test_unit "algebra: union concatenates streams" =
let%test_unit "algebra: diff removes right from left" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1565,7 +1567,7 @@ let%test_unit "algebra: diff removes right from left" =
let%test_unit "algebra: take limits output" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1608,7 +1610,7 @@ let%test_unit "drl: parse Select" =
let%test_unit "drl: execute Base" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1628,7 +1630,7 @@ let%test_unit "drl: execute Base" =
let%test_unit "drl: execute Select+Const" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test_db" with
+ match Memory.create_database storage ~name:"test_db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -1638,7 +1640,7 @@ let%test_unit "drl: execute Select+Const" =
in
let db, users =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -1655,7 +1657,7 @@ let%test_unit "drl: execute Select+Const" =
in
let db, _, _ =
match
- Manipulation.Memory.create_tuples storage db users
+ Memory.create_tuples storage db users
[ make_user 18 "Alice"; make_user 25 "Bob" ]
with
| Error _ -> assert false
@@ -2013,14 +2015,14 @@ let%test_unit "constraint: Forall unbounded quantifier errors" =
let%test_unit "constraint: create_tuple with passing constraint" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "value" "natural" in
let db, _rel =
match
- Manipulation.Memory.create_relation storage db ~name:"positives"
+ Memory.create_relation storage db ~name:"positives"
~schema
with
| Error _ -> assert false
@@ -2029,7 +2031,7 @@ let%test_unit "constraint: create_tuple with passing constraint" =
(* Register a constraint: value must be member of natural (always true for naturals) *)
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"is_natural" ~relation_name:"positives"
~body:(Constraint.And [])
with
@@ -2037,7 +2039,7 @@ let%test_unit "constraint: create_tuple with passing constraint" =
| Ok db -> db
in
let rel =
- match Manipulation.Memory.get_relation db ~name:"positives" with
+ match Memory.get_relation db ~name:"positives" with
| None -> assert false
| Some r -> r
in
@@ -2049,21 +2051,21 @@ let%test_unit "constraint: create_tuple with passing constraint" =
{ Attribute.value = Obj.repr 5 };
}
in
- match Manipulation.Memory.create_tuple storage db rel tuple with
+ match Memory.create_tuple storage db rel tuple with
| Ok _ -> ()
| Error _ -> assert false)
let%test_unit "constraint: create_tuple with failing constraint" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "value" "natural" in
let db, _rel =
match
- Manipulation.Memory.create_relation storage db ~name:"checked" ~schema
+ Memory.create_relation storage db ~name:"checked" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -2071,7 +2073,7 @@ let%test_unit "constraint: create_tuple with failing constraint" =
(* Register a constraint that always fails: MemberOf a nonexistent relation *)
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"impossible" ~relation_name:"checked"
~body:
(Constraint.MemberOf
@@ -2086,7 +2088,7 @@ let%test_unit "constraint: create_tuple with failing constraint" =
| Ok db -> db
in
let rel =
- match Manipulation.Memory.get_relation db ~name:"checked" with
+ match Memory.get_relation db ~name:"checked" with
| None -> assert false
| Some r -> r
in
@@ -2098,8 +2100,8 @@ let%test_unit "constraint: create_tuple with failing constraint" =
{ Attribute.value = Obj.repr 5 };
}
in
- match Manipulation.Memory.create_tuple storage db rel tuple with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db rel tuple with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* ---------- Scenario tests ported from Erlang ---------- *)
@@ -2108,14 +2110,14 @@ let%test_unit "constraint: create_tuple with failing constraint" =
let%test_unit "constraint scenario: mutual exclusion subtypes" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "id" "natural" in
let db, _employee =
match
- Manipulation.Memory.create_relation storage db ~name:"employee"
+ Memory.create_relation storage db ~name:"employee"
~schema
with
| Error _ -> assert false
@@ -2123,7 +2125,7 @@ let%test_unit "constraint scenario: mutual exclusion subtypes" =
in
let db, _manager =
match
- Manipulation.Memory.create_relation storage db ~name:"manager" ~schema
+ Memory.create_relation storage db ~name:"manager" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -2144,7 +2146,7 @@ let%test_unit "constraint scenario: mutual exclusion subtypes" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"not_employee" ~relation_name:"manager" ~body
with
| Error _ -> assert false
@@ -2152,7 +2154,7 @@ let%test_unit "constraint scenario: mutual exclusion subtypes" =
in
(* Insert into employee first *)
let employee =
- match Manipulation.Memory.get_relation db ~name:"employee" with
+ match Memory.get_relation db ~name:"employee" with
| None -> assert false
| Some r -> r
in
@@ -2165,14 +2167,14 @@ let%test_unit "constraint scenario: mutual exclusion subtypes" =
in
let db, _employee, _ =
match
- Manipulation.Memory.create_tuple storage db employee emp_tuple
+ Memory.create_tuple storage db employee emp_tuple
with
| Error _ -> assert false
| Ok x -> x
in
(* Now try to insert same id into manager, should fail *)
let manager =
- match Manipulation.Memory.get_relation db ~name:"manager" with
+ match Memory.get_relation db ~name:"manager" with
| None -> assert false
| Some r -> r
in
@@ -2183,22 +2185,22 @@ let%test_unit "constraint scenario: mutual exclusion subtypes" =
Tuple.AttributeMap.singleton "id" { Attribute.value = Obj.repr 1 };
}
in
- match Manipulation.Memory.create_tuple storage db manager mgr_tuple with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db manager mgr_tuple with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* Scenario 2: Foreign key constraint *)
let%test_unit "constraint scenario: foreign key" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let order_schema = Schema.empty |> Schema.add "order_id" "natural" in
let db, _orders =
match
- Manipulation.Memory.create_relation storage db ~name:"orders"
+ Memory.create_relation storage db ~name:"orders"
~schema:order_schema
with
| Error _ -> assert false
@@ -2211,7 +2213,7 @@ let%test_unit "constraint scenario: foreign key" =
in
let db, _items =
match
- Manipulation.Memory.create_relation storage db ~name:"order_items"
+ Memory.create_relation storage db ~name:"order_items"
~schema:item_schema
with
| Error _ -> assert false
@@ -2229,7 +2231,7 @@ let%test_unit "constraint scenario: foreign key" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"fk_order" ~relation_name:"order_items"
~body:fk_body
with
@@ -2238,7 +2240,7 @@ let%test_unit "constraint scenario: foreign key" =
in
(* Insert an order *)
let orders =
- match Manipulation.Memory.get_relation db ~name:"orders" with
+ match Memory.get_relation db ~name:"orders" with
| None -> assert false
| Some r -> r
in
@@ -2252,14 +2254,14 @@ let%test_unit "constraint scenario: foreign key" =
in
let db, _orders, _ =
match
- Manipulation.Memory.create_tuple storage db orders order_tuple
+ Memory.create_tuple storage db orders order_tuple
with
| Error _ -> assert false
| Ok x -> x
in
(* Insert item referencing valid order, should succeed *)
let items =
- match Manipulation.Memory.get_relation db ~name:"order_items" with
+ match Memory.get_relation db ~name:"order_items" with
| None -> assert false
| Some r -> r
in
@@ -2275,7 +2277,7 @@ let%test_unit "constraint scenario: foreign key" =
}
in
let db, items, _ =
- match Manipulation.Memory.create_tuple storage db items valid_item with
+ match Memory.create_tuple storage db items valid_item with
| Error _ -> assert false
| Ok x -> x
in
@@ -2291,15 +2293,15 @@ let%test_unit "constraint scenario: foreign key" =
];
}
in
- match Manipulation.Memory.create_tuple storage db items invalid_item with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db items invalid_item with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* Scenario 3: Self-reference (emp_id != mgr_id via not_equal comparison) *)
let%test_unit "constraint scenario: self-reference neq" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
@@ -2310,7 +2312,7 @@ let%test_unit "constraint scenario: self-reference neq" =
in
let db, _rel =
match
- Manipulation.Memory.create_relation storage db ~name:"reports_to"
+ Memory.create_relation storage db ~name:"reports_to"
~schema
with
| Error _ -> assert false
@@ -2319,14 +2321,14 @@ let%test_unit "constraint scenario: self-reference neq" =
(* Register the not_equal comparison relation *)
let db, _ =
match
- Manipulation.Memory.create_immutable_relation storage db
+ Memory.create_immutable_relation storage db
~name:"not_equal"
~schema:
(Schema.empty
|> Schema.add "left" "natural"
|> Schema.add "right" "natural")
~generator:(fun _ -> Generator.Error "not enumerable")
- ~membership_criteria:(fun t ->
+ ~membership_criteria:(fun _tree_of t ->
match t with
| Tuple.Materialized m -> (
match
@@ -2349,7 +2351,7 @@ let%test_unit "constraint scenario: self-reference neq" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"no_self_manage" ~relation_name:"reports_to"
~body:neq_body
with
@@ -2357,7 +2359,7 @@ let%test_unit "constraint scenario: self-reference neq" =
| Ok db -> db
in
let rel =
- match Manipulation.Memory.get_relation db ~name:"reports_to" with
+ match Memory.get_relation db ~name:"reports_to" with
| None -> assert false
| Some r -> r
in
@@ -2374,7 +2376,7 @@ let%test_unit "constraint scenario: self-reference neq" =
}
in
let db, rel, _ =
- match Manipulation.Memory.create_tuple storage db rel valid with
+ match Memory.create_tuple storage db rel valid with
| Error _ -> assert false
| Ok x -> x
in
@@ -2390,22 +2392,22 @@ let%test_unit "constraint scenario: self-reference neq" =
];
}
in
- match Manipulation.Memory.create_tuple storage db rel invalid with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db rel invalid with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* Scenario 4: Mutual exclusion between open_ticket and closed_ticket *)
let%test_unit "constraint scenario: open vs closed ticket" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "ticket_id" "natural" in
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"open_ticket"
+ Memory.create_relation storage db ~name:"open_ticket"
~schema
with
| Error _ -> assert false
@@ -2413,7 +2415,7 @@ let%test_unit "constraint scenario: open vs closed ticket" =
in
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"closed_ticket"
+ Memory.create_relation storage db ~name:"closed_ticket"
~schema
with
| Error _ -> assert false
@@ -2422,7 +2424,7 @@ let%test_unit "constraint scenario: open vs closed ticket" =
(* open_ticket must not be in closed_ticket *)
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"not_closed" ~relation_name:"open_ticket"
~body:
(Constraint.Not
@@ -2443,7 +2445,7 @@ let%test_unit "constraint scenario: open vs closed ticket" =
in
(* Insert ticket 1 as closed *)
let closed =
- match Manipulation.Memory.get_relation db ~name:"closed_ticket" with
+ match Memory.get_relation db ~name:"closed_ticket" with
| None -> assert false
| Some r -> r
in
@@ -2456,13 +2458,13 @@ let%test_unit "constraint scenario: open vs closed ticket" =
}
in
let db, _, _ =
- match Manipulation.Memory.create_tuple storage db closed t1 with
+ match Memory.create_tuple storage db closed t1 with
| Error _ -> assert false
| Ok x -> x
in
(* Try to open same ticket, should fail *)
let open_ =
- match Manipulation.Memory.get_relation db ~name:"open_ticket" with
+ match Memory.get_relation db ~name:"open_ticket" with
| None -> assert false
| Some r -> r
in
@@ -2474,22 +2476,22 @@ let%test_unit "constraint scenario: open vs closed ticket" =
{ Attribute.value = Obj.repr 1 };
}
in
- match Manipulation.Memory.create_tuple storage db open_ t1_open with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db open_ t1_open with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* Scenario 5: Weak entity dependency *)
let%test_unit "constraint scenario: weak entity dependency" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let parent_schema = Schema.empty |> Schema.add "parent_id" "natural" in
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"parent"
+ Memory.create_relation storage db ~name:"parent"
~schema:parent_schema
with
| Error _ -> assert false
@@ -2502,7 +2504,7 @@ let%test_unit "constraint scenario: weak entity dependency" =
in
let db, _ =
match
- Manipulation.Memory.create_relation storage db ~name:"dependent"
+ Memory.create_relation storage db ~name:"dependent"
~schema:dep_schema
with
| Error _ -> assert false
@@ -2511,7 +2513,7 @@ let%test_unit "constraint scenario: weak entity dependency" =
(* dependent.parent_id must exist in parent *)
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"parent_exists" ~relation_name:"dependent"
~body:
(Constraint.MemberOf
@@ -2527,7 +2529,7 @@ let%test_unit "constraint scenario: weak entity dependency" =
in
(* Insert parent *)
let parent =
- match Manipulation.Memory.get_relation db ~name:"parent" with
+ match Memory.get_relation db ~name:"parent" with
| None -> assert false
| Some r -> r
in
@@ -2540,13 +2542,13 @@ let%test_unit "constraint scenario: weak entity dependency" =
}
in
let db, _, _ =
- match Manipulation.Memory.create_tuple storage db parent pt with
+ match Memory.create_tuple storage db parent pt with
| Error _ -> assert false
| Ok x -> x
in
(* Insert dependent with valid parent, should succeed *)
let dep =
- match Manipulation.Memory.get_relation db ~name:"dependent" with
+ match Memory.get_relation db ~name:"dependent" with
| None -> assert false
| Some r -> r
in
@@ -2562,7 +2564,7 @@ let%test_unit "constraint scenario: weak entity dependency" =
}
in
let db, dep, _ =
- match Manipulation.Memory.create_tuple storage db dep valid_dep with
+ match Memory.create_tuple storage db dep valid_dep with
| Error _ -> assert false
| Ok x -> x
in
@@ -2578,22 +2580,22 @@ let%test_unit "constraint scenario: weak entity dependency" =
];
}
in
- match Manipulation.Memory.create_tuple storage db dep invalid_dep with
- | Error (Manipulation.ConstraintViolation _) -> ()
+ match Memory.create_tuple storage db dep invalid_dep with
+ | Error (Error.ConstraintViolation _) -> ()
| _ -> assert false)
(* Scenario 6: Algebra propagation, select preserves constraints *)
let%test_unit "constraint propagation: select preserves constraints" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "x" "natural" in
let db, _rel =
match
- Manipulation.Memory.create_relation storage db ~name:"constrained"
+ Memory.create_relation storage db ~name:"constrained"
~schema
with
| Error _ -> assert false
@@ -2601,7 +2603,7 @@ let%test_unit "constraint propagation: select preserves constraints" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"c1" ~relation_name:"constrained"
~body:(Constraint.And [])
with
@@ -2609,7 +2611,7 @@ let%test_unit "constraint propagation: select preserves constraints" =
| Ok db -> db
in
let rel =
- match Manipulation.Memory.get_relation db ~name:"constrained" with
+ match Memory.get_relation db ~name:"constrained" with
| None -> assert false
| Some r -> r
in
@@ -2621,7 +2623,7 @@ let%test_unit "constraint propagation: select preserves constraints" =
let%test_unit "constraint propagation: project filters constraints" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"test" with
+ match Memory.create_database storage ~name:"test" with
| Error _ -> assert false
| Ok db -> db
in
@@ -2630,7 +2632,7 @@ let%test_unit "constraint propagation: project filters constraints" =
in
let db, _rel =
match
- Manipulation.Memory.create_relation storage db ~name:"xy" ~schema
+ Memory.create_relation storage db ~name:"xy" ~schema
with
| Error _ -> assert false
| Ok x -> x
@@ -2646,14 +2648,14 @@ let%test_unit "constraint propagation: project filters constraints" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"x_only" ~relation_name:"xy" ~body:c_on_x
with
| Error _ -> assert false
| Ok db -> db
in
let rel =
- match Manipulation.Memory.get_relation db ~name:"xy" with
+ match Memory.get_relation db ~name:"xy" with
| None -> assert false
| Some r -> r
in
@@ -2741,7 +2743,7 @@ let%test_unit "ddl: execute CreateDatabase" =
let%test_unit "ddl: execute CreateRelation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
@@ -2759,14 +2761,14 @@ let%test_unit "ddl: execute CreateRelation" =
let%test_unit "dml: execute InsertTuple" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "name" "string" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> db
@@ -2783,19 +2785,19 @@ let%test_unit "dml: execute InsertTuple" =
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 1))
+ assert (Memory.tuple_count rel = 1))
let%test_unit "dml: execute InsertTuples" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "name" "string" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> db
@@ -2819,19 +2821,19 @@ let%test_unit "dml: execute InsertTuples" =
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 2))
+ assert (Memory.tuple_count rel = 2))
let%test_unit "dml: execute DeleteTuple" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "name" "string" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> db
@@ -2860,19 +2862,19 @@ let%test_unit "dml: execute DeleteTuple" =
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 0))
+ assert (Memory.tuple_count rel = 0))
let%test_unit "ddl: execute RetractRelation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> db
@@ -2887,14 +2889,14 @@ let%test_unit "ddl: execute RetractRelation" =
let%test_unit "ddl: execute ClearRelation" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "name" "string" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"users" ~schema
+ Memory.create_relation storage db ~name:"users" ~schema
with
| Error _ -> assert false
| Ok (db, _) -> db
@@ -2925,12 +2927,12 @@ let%test_unit "ddl: execute ClearRelation" =
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 0))
+ assert (Memory.tuple_count rel = 0))
let%test_unit "ddl: execute RegisterDomain" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
@@ -2945,7 +2947,7 @@ let%test_unit "ddl: execute RegisterDomain" =
let%test_unit "dml: insert into nonexistent relation returns error" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
@@ -3035,14 +3037,14 @@ let%test_unit "dcl: round-trip Not constraint" =
let%test_unit "dcl: execute RegisterConstraint attaches constraint" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "order_id" "natural" in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"order_items"
+ Memory.create_relation storage db ~name:"order_items"
~schema
with
| Error _ -> assert false
@@ -3074,13 +3076,13 @@ let%test_unit "dcl: execute RegisterConstraint attaches constraint" =
let%test_unit "dcl: FK constraint enforced on insert" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"shop" with
+ match Memory.create_database storage ~name:"shop" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"orders"
+ Memory.create_relation storage db ~name:"orders"
~schema:(Schema.empty |> Schema.add "id" "natural")
with
| Error _ -> assert false
@@ -3098,7 +3100,7 @@ let%test_unit "dcl: FK constraint enforced on insert" =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"order_items"
+ Memory.create_relation storage db ~name:"order_items"
~schema:(Schema.empty |> Schema.add "order_id" "natural")
with
| Error _ -> assert false
@@ -3141,7 +3143,7 @@ let%test_unit "dcl: FK constraint enforced on insert" =
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count rel = 1);
+ assert (Memory.tuple_count rel = 1);
(* Invalid insert: order_id=99 does not exist in orders *)
match
Dml.Executor.Memory.execute storage db
@@ -3153,7 +3155,7 @@ let%test_unit "dcl: FK constraint enforced on insert" =
with
| Error
(Dml.Executor.Memory.ManipulationError
- (Manipulation.ConstraintViolation _)) ->
+ (Error.ConstraintViolation _)) ->
()
| _ -> assert false)
@@ -3243,7 +3245,7 @@ let%test_unit "branch: multiple branches are independent" =
let%test_unit "diff: identical databases produce empty diff" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
@@ -3253,14 +3255,14 @@ let%test_unit "diff: identical databases produce empty diff" =
let%test_unit "diff: added relation detected" =
with_storage (fun storage ->
let ancestor =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
let schema = Schema.empty |> Schema.add "x" "natural" in
let target, _ =
match
- Manipulation.Memory.create_relation storage ancestor ~name:"new_rel"
+ Memory.create_relation storage ancestor ~name:"new_rel"
~schema
with
| Error _ -> assert false
@@ -3278,13 +3280,13 @@ let%test_unit "diff: removed relation detected" =
with_storage (fun storage ->
let schema = Schema.empty |> Schema.add "x" "natural" in
let ancestor =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
let ancestor, _ =
match
- Manipulation.Memory.create_relation storage ancestor ~name:"gone"
+ Memory.create_relation storage ancestor ~name:"gone"
~schema
with
| Error _ -> assert false
@@ -3292,7 +3294,7 @@ let%test_unit "diff: removed relation detected" =
in
let target =
match
- Manipulation.Memory.retract_relation storage ancestor ~name:"gone"
+ Memory.retract_relation storage ancestor ~name:"gone"
with
| Error _ -> assert false
| Ok db -> db
@@ -3309,13 +3311,13 @@ let%test_unit "diff: modified relation detected with added tuple" =
with_storage (fun storage ->
let schema = Schema.empty |> Schema.add "val" "natural" in
let ancestor =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
let ancestor, _ =
match
- Manipulation.Memory.create_relation storage ancestor ~name:"r" ~schema
+ Memory.create_relation storage ancestor ~name:"r" ~schema
with
| Error _ -> assert false
| Ok p -> p
@@ -3329,7 +3331,7 @@ let%test_unit "diff: modified relation detected with added tuple" =
}
in
let target, _, _ =
- match Manipulation.Memory.create_tuple storage ancestor rel t with
+ match Memory.create_tuple storage ancestor rel t with
| Error _ -> assert false
| Ok p -> p
in
@@ -3346,24 +3348,24 @@ let%test_unit "diff: modified relation detected with added tuple" =
| _ -> assert false)
module MergeMemory =
- Management.Merge.Make (Management.Physical.Memory) (Manipulation.Memory)
+ Management.Merge.Make (Management.Physical.Memory) (Memory)
let%test_unit "merge: fast-forward when only one side changed" =
with_storage (fun storage ->
let schema = Schema.empty |> Schema.add "val" "natural" in
let base_db =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
let base_db, _ =
match
- Manipulation.Memory.create_relation storage base_db ~name:"r" ~schema
+ Memory.create_relation storage base_db ~name:"r" ~schema
with
| Error _ -> assert false
| Ok p -> p
in
- (match Manipulation.Memory.store_database storage base_db with
+ (match Memory.store_database storage base_db with
| Error _ -> assert false
| Ok () -> ());
let rel = Option.get (Management.Database.get_relation base_db "r") in
@@ -3375,11 +3377,11 @@ let%test_unit "merge: fast-forward when only one side changed" =
}
in
let left_db, _, _ =
- match Manipulation.Memory.create_tuple storage base_db rel t1 with
+ match Memory.create_tuple storage base_db rel t1 with
| Error _ -> assert false
| Ok p -> p
in
- (match Manipulation.Memory.store_database storage left_db with
+ (match Memory.store_database storage left_db with
| Error _ -> assert false
| Ok () -> ());
match
@@ -3393,24 +3395,24 @@ let%test_unit "merge: fast-forward when only one side changed" =
let merged_rel =
Option.get (Management.Database.get_relation merged "r")
in
- assert (Manipulation.Memory.tuple_count merged_rel = 1))
+ assert (Memory.tuple_count merged_rel = 1))
let%test_unit "merge: independent tuple additions produce union" =
with_storage (fun storage ->
let schema = Schema.empty |> Schema.add "val" "natural" in
let base_db =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
let base_db, _ =
match
- Manipulation.Memory.create_relation storage base_db ~name:"r" ~schema
+ Memory.create_relation storage base_db ~name:"r" ~schema
with
| Error _ -> assert false
| Ok p -> p
in
- (match Manipulation.Memory.store_database storage base_db with
+ (match Memory.store_database storage base_db with
| Error _ -> assert false
| Ok () -> ());
let rel = Option.get (Management.Database.get_relation base_db "r") in
@@ -3422,11 +3424,11 @@ let%test_unit "merge: independent tuple additions produce union" =
}
in
let left_db, _, _ =
- match Manipulation.Memory.create_tuple storage base_db rel t_left with
+ match Memory.create_tuple storage base_db rel t_left with
| Error _ -> assert false
| Ok p -> p
in
- (match Manipulation.Memory.store_database storage left_db with
+ (match Memory.store_database storage left_db with
| Error _ -> assert false
| Ok () -> ());
let t_right : Tuple.materialized =
@@ -3437,11 +3439,11 @@ let%test_unit "merge: independent tuple additions produce union" =
}
in
let right_db, _, _ =
- match Manipulation.Memory.create_tuple storage base_db rel t_right with
+ match Memory.create_tuple storage base_db rel t_right with
| Error _ -> assert false
| Ok p -> p
in
- (match Manipulation.Memory.store_database storage right_db with
+ (match Memory.store_database storage right_db with
| Error _ -> assert false
| Ok () -> ());
match
@@ -3455,16 +3457,16 @@ let%test_unit "merge: independent tuple additions produce union" =
let merged_rel =
Option.get (Management.Database.get_relation merged "r")
in
- assert (Manipulation.Memory.tuple_count merged_rel = 2))
+ assert (Memory.tuple_count merged_rel = 2))
let%test_unit "merge: no-op when both sides are identical" =
with_storage (fun storage ->
let base_db =
- match Manipulation.Memory.create_database storage ~name:"db" with
+ match Memory.create_database storage ~name:"db" with
| Error _ -> assert false
| Ok db -> db
in
- (match Manipulation.Memory.store_database storage base_db with
+ (match Memory.store_database storage base_db with
| Error _ -> assert false
| Ok () -> ());
match
@@ -3891,13 +3893,13 @@ let%test_unit "substitute_transition: substitution applies through And and Not"
Constraint on Employee: Exists d in Department, MemberOf Department (dept_id = Var "dept_id") *)
let setup_fk_db storage =
let db =
- match Manipulation.Memory.create_database storage ~name:"hr" with
+ match Memory.create_database storage ~name:"hr" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Department"
+ Memory.create_relation storage db ~name:"Department"
~schema:(Schema.empty |> Schema.add "dept_id" "natural")
with
| Error _ -> assert false
@@ -3905,7 +3907,7 @@ let setup_fk_db storage =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Employee"
+ Memory.create_relation storage db ~name:"Employee"
~schema:
(Schema.empty
|> Schema.add "emp_id" "natural"
@@ -3927,7 +3929,7 @@ let setup_fk_db storage =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"fk_dept" ~relation_name:"Employee" ~body:fk_body
with
| Error _ -> assert false
@@ -4001,7 +4003,7 @@ let%test_unit "cascade: delete referenced row violates FK and is rejected" =
| Ok db -> db
in
let dept_rel =
- match Manipulation.Memory.get_relation db ~name:"Department" with
+ match Memory.get_relation db ~name:"Department" with
| None -> assert false
| Some r -> r
in
@@ -4016,11 +4018,11 @@ let%test_unit "cascade: delete referenced row violates FK and is rejected" =
in
(* Deleting Dept 1 while Employee references it must fail *)
match
- Manipulation.Memory.retract_tuple storage db dept_rel
+ Memory.retract_tuple storage db dept_rel
~tuple_hash:dept_hash
with
| Ok _ -> assert false (* should have been rejected *)
- | Error (Manipulation.ConstraintViolation msg) ->
+ | Error (Error.ConstraintViolation msg) ->
assert (String.length msg > 0)
| Error _ -> assert false)
@@ -4066,7 +4068,7 @@ let%test_unit "cascade: delete unreferenced row succeeds" =
| Ok db -> db
in
let dept_rel =
- match Manipulation.Memory.get_relation db ~name:"Department" with
+ match Memory.get_relation db ~name:"Department" with
| None -> assert false
| Some r -> r
in
@@ -4081,19 +4083,19 @@ let%test_unit "cascade: delete unreferenced row succeeds" =
in
(* Deleting unreferenced Dept 2 must succeed *)
match
- Manipulation.Memory.retract_tuple storage db dept_rel
+ Memory.retract_tuple storage db dept_rel
~tuple_hash:dept2_hash
with
| Error _ -> assert false
| Ok (new_db, _) ->
let dept =
match
- Manipulation.Memory.get_relation new_db ~name:"Department"
+ Memory.get_relation new_db ~name:"Department"
with
| None -> assert false
| Some r -> r
in
- assert (Manipulation.Memory.tuple_count dept = 1))
+ assert (Memory.tuple_count dept = 1))
let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
(* Constraint on Employee: NOT (MemberOf Blacklist (emp_id = Var "emp_id"))
@@ -4101,13 +4103,13 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
DELETE from Blacklist should never trigger a cascade check. *)
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"hr" with
+ match Memory.create_database storage ~name:"hr" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Blacklist"
+ Memory.create_relation storage db ~name:"Blacklist"
~schema:(Schema.empty |> Schema.add "emp_id" "natural")
with
| Error _ -> assert false
@@ -4115,7 +4117,7 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Employee"
+ Memory.create_relation storage db ~name:"Employee"
~schema:(Schema.empty |> Schema.add "emp_id" "natural")
with
| Error _ -> assert false
@@ -4133,7 +4135,7 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
in
let db =
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"not_blacklisted" ~relation_name:"Employee"
~body:not_body
with
@@ -4166,7 +4168,7 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
| Ok db -> db
in
let bl_rel =
- match Manipulation.Memory.get_relation db ~name:"Blacklist" with
+ match Memory.get_relation db ~name:"Blacklist" with
| None -> assert false
| Some r -> r
in
@@ -4181,7 +4183,7 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
in
(* Deleting from Blacklist (negative polarity) must not trigger cascade check *)
match
- Manipulation.Memory.retract_tuple storage db bl_rel ~tuple_hash:bl_hash
+ Memory.retract_tuple storage db bl_rel ~tuple_hash:bl_hash
with
| Error _ -> assert false
| Ok _ -> ())
@@ -4189,13 +4191,13 @@ let%test_unit "cascade: Negative-polarity relation deletion is not checked" =
let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
with_storage (fun storage ->
let db =
- match Manipulation.Memory.create_database storage ~name:"hr" with
+ match Memory.create_database storage ~name:"hr" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Department"
+ Memory.create_relation storage db ~name:"Department"
~schema:(Schema.empty |> Schema.add "dept_id" "natural")
with
| Error _ -> assert false
@@ -4203,7 +4205,7 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Employee"
+ Memory.create_relation storage db ~name:"Employee"
~schema:
(Schema.empty
|> Schema.add "emp_id" "natural"
@@ -4226,7 +4228,7 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
(* Register as DEFERRED *)
let db =
match
- Manipulation.Memory.attach_constraint storage db
+ Memory.attach_constraint storage db
~constraint_name:"fk_dept_deferred" ~relation_name:"Employee"
~body:fk_body ~timing:Constraint.Deferred
with
@@ -4259,7 +4261,7 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
| Ok db -> db
in
let dept_rel =
- match Manipulation.Memory.get_relation db ~name:"Department" with
+ match Memory.get_relation db ~name:"Department" with
| None -> assert false
| Some r -> r
in
@@ -4274,17 +4276,17 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
in
(* Deferred: retract_tuple itself should NOT reject the deletion *)
match
- Manipulation.Memory.retract_tuple storage db dept_rel
+ Memory.retract_tuple storage db dept_rel
~tuple_hash:dept_hash
with
| Error _ -> assert false (* deferred: must pass here *)
| Ok (new_db, _) -> (
(* But check_deferred_constraints must catch the violation *)
match
- Manipulation.Memory.check_deferred_constraints storage new_db
+ Memory.check_deferred_constraints storage new_db
with
| Ok () -> assert false (* should have caught the violation *)
- | Error (Manipulation.ConstraintViolation _) -> ()
+ | Error (Error.ConstraintViolation _) -> ()
| Error _ -> assert false))
(* INSERT cascade tests.
@@ -4300,13 +4302,13 @@ let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
must trigger a re-check of Employee tuples. *)
let setup_blacklist_db storage =
let db =
- match Manipulation.Memory.create_database storage ~name:"hr" with
+ match Memory.create_database storage ~name:"hr" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Blacklist"
+ Memory.create_relation storage db ~name:"Blacklist"
~schema:(Schema.empty |> Schema.add "emp_id" "natural")
with
| Error _ -> assert false
@@ -4314,7 +4316,7 @@ let setup_blacklist_db storage =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Employee"
+ Memory.create_relation storage db ~name:"Employee"
~schema:(Schema.empty |> Schema.add "emp_id" "natural")
with
| Error _ -> assert false
@@ -4335,7 +4337,7 @@ let setup_blacklist_db storage =
}
in
match
- Manipulation.Memory.register_constraint storage db
+ Memory.register_constraint storage db
~constraint_name:"not_blacklisted" ~relation_name:"Employee"
~body:not_body
with
@@ -4410,13 +4412,13 @@ let%test_unit
commit is the boundary where deferred violations are caught. *)
let setup_deferred_fk_db storage =
let db =
- match Manipulation.Memory.create_database storage ~name:"hr" with
+ match Memory.create_database storage ~name:"hr" with
| Error _ -> assert false
| Ok db -> db
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Department"
+ Memory.create_relation storage db ~name:"Department"
~schema:(Schema.empty |> Schema.add "dept_id" "natural")
with
| Error _ -> assert false
@@ -4424,7 +4426,7 @@ let setup_deferred_fk_db storage =
in
let db =
match
- Manipulation.Memory.create_relation storage db ~name:"Employee"
+ Memory.create_relation storage db ~name:"Employee"
~schema:
(Schema.empty
|> Schema.add "emp_id" "natural"
@@ -4449,7 +4451,7 @@ let setup_deferred_fk_db storage =
}
in
match
- Manipulation.Memory.attach_constraint storage db ~constraint_name:"fk_dept"
+ Memory.attach_constraint storage db ~constraint_name:"fk_dept"
~relation_name:"Employee" ~body:fk_body ~timing:Constraint.Deferred
with
| Error _ -> assert false
@@ -4484,7 +4486,7 @@ let%test_unit "commit: no deferred constraints, returns Ok with db unchanged" =
| Ok db -> db
in
(* All constraints satisfied, commit must pass *)
- match Manipulation.Memory.commit storage db with
+ match Memory.commit storage db with
| Error _ -> assert false
| Ok _ -> ())
@@ -4517,7 +4519,7 @@ let%test_unit "commit: deferred violation is caught at commit boundary" =
| Ok db -> db
in
let dept_rel =
- match Manipulation.Memory.get_relation db ~name:"Department" with
+ match Memory.get_relation db ~name:"Department" with
| None -> assert false
| Some r -> r
in
@@ -4533,16 +4535,16 @@ let%test_unit "commit: deferred violation is caught at commit boundary" =
(* Delete the referenced department. Deferred, so retract succeeds *)
let db =
match
- Manipulation.Memory.retract_tuple storage db dept_rel
+ Memory.retract_tuple storage db dept_rel
~tuple_hash:dept_hash
with
| Error _ -> assert false
| Ok (db, _) -> db
in
(* commit must now catch the orphaned Employee *)
- match Manipulation.Memory.commit storage db with
+ match Memory.commit storage db with
| Ok _ -> assert false
- | Error (Manipulation.ConstraintViolation _) -> ()
+ | Error (Error.ConstraintViolation _) -> ()
| Error _ -> assert false)
let%test_unit "commit: clears deferred list, second commit passes" =
@@ -4577,11 +4579,11 @@ let%test_unit "commit: clears deferred list, second commit passes" =
| Ok db -> db
in
let db =
- match Manipulation.Memory.commit storage db with
+ match Memory.commit storage db with
| Error _ -> assert false
| Ok db -> db
in
(* Second commit with no new mutations must also pass *)
- match Manipulation.Memory.commit storage db with
+ match Memory.commit storage db with
| Error _ -> assert false
| Ok _ -> ())
generated by cgit v1.2.3 (git 2.25.1) at 2026-11-04 09:09:12 +0000