path: root/test/test_relational_engine.ml

(** Tests for the relational engine *)

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);
  assert (Merkle.size tree = 0);
  assert (Merkle.root_hash tree = None)

let%test_unit "merkle: insert single element" =
  let tree = Merkle.empty in
  let hash = "abc123" in
  let tree = Merkle.insert hash tree in
  assert (not (Merkle.is_empty tree));
  assert (Merkle.size tree = 1);
  assert (Merkle.member hash tree);
  assert (Merkle.root_hash tree <> None)

let%test_unit "merkle: insert multiple elements" =
  let tree = Merkle.empty in
  let tree = Merkle.insert "hash1" tree in
  let tree = Merkle.insert "hash2" tree in
  let tree = Merkle.insert "hash3" tree in
  assert (Merkle.size tree = 3);
  assert (Merkle.member "hash1" tree);
  assert (Merkle.member "hash2" tree);
  assert (Merkle.member "hash3" tree);
  assert (not (Merkle.member "hash4" tree))

let%test_unit "merkle: delete element" =
  let tree = Merkle.empty in
  let tree = Merkle.insert "hash1" tree in
  let tree = Merkle.insert "hash2" tree in
  assert (Merkle.size tree = 2);
  let tree = Merkle.delete "hash1" tree in
  assert (Merkle.size tree = 1);
  assert (not (Merkle.member "hash1" tree));
  assert (Merkle.member "hash2" tree)

let%test_unit "merkle: keys returns all elements" =
  let tree = Merkle.empty in
  let tree = Merkle.insert "c" tree in
  let tree = Merkle.insert "a" tree in
  let tree = Merkle.insert "b" tree in
  let keys = Merkle.keys tree in
  assert (List.length keys = 3);
  assert (List.mem "a" keys);
  assert (List.mem "b" keys);
  assert (List.mem "c" keys)

let%test_unit "merkle: root hash changes on insert" =
  let tree = Merkle.empty in
  let tree1 = Merkle.insert "hash1" tree in
  let root1 = Merkle.root_hash tree1 in
  let tree2 = Merkle.insert "hash2" tree1 in
  let root2 = Merkle.root_hash tree2 in
  assert (root1 <> root2)

let%test_unit "merkle: same elements produce same root hash" =
  let tree1 = Merkle.empty |> Merkle.insert "a" |> Merkle.insert "b" in
  let tree2 = Merkle.empty |> Merkle.insert "b" |> Merkle.insert "a" in
  assert (Merkle.root_hash tree1 = Merkle.root_hash tree2)

let%test_unit "storage: create and close" =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage -> Management.Physical.Memory.close storage

let%test_unit "storage: store and load attribute" =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage ->
      let value = Obj.magic 42 in
      (match Management.Physical.Memory.store_attribute storage value with
      | Error _ -> assert false
      | Ok hash -> (
          match Management.Physical.Memory.load_attribute storage hash with
          | Error _ -> assert false
          | Ok None -> assert false
          | Ok (Some loaded) -> assert ((Obj.magic loaded : int) = 42)));
      Management.Physical.Memory.close storage

let%test_unit "storage: store and load raw bytes" =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage ->
      let hash = "test_hash" in
      let data = Bytes.of_string "hello world" in
      (match Management.Physical.Memory.store_raw storage hash data with
      | Error _ -> assert false
      | Ok () -> (
          match Management.Physical.Memory.load_raw storage hash with
          | Error _ -> assert false
          | Ok None -> assert false
          | Ok (Some loaded) -> assert (Bytes.equal loaded data)));
      Management.Physical.Memory.close storage

let%test_unit "storage: exists check" =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage ->
      let hash = "exists_test" in
      let data = Bytes.of_string "data" in
      (match Management.Physical.Memory.exists storage hash with
      | Error _ -> assert false
      | Ok exists -> assert (not exists));
      (match Management.Physical.Memory.store_raw storage hash data with
      | Error _ -> assert false
      | Ok () -> (
          match Management.Physical.Memory.exists storage hash with
          | Error _ -> assert false
          | Ok exists -> assert exists));
      Management.Physical.Memory.close storage

let%test_unit "storage: transaction commit" =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage ->
      let result =
        Management.Physical.Memory.with_transaction storage (fun () ->
            let hash = "tx_test" in
            let data = Bytes.of_string "tx_data" in
            Management.Physical.Memory.store_raw storage hash data)
      in
      (match result with
      | Error _ -> assert false
      | Ok () -> (
          match Management.Physical.Memory.exists storage "tx_test" with
          | Error _ -> assert false
          | Ok exists -> assert exists));
      Management.Physical.Memory.close storage

let%test_unit "database: create empty" =
  let db = Management.Database.empty ~name:"test_db" in
  assert (db.name = "test_db");
  assert (Merkle.is_empty db.tree);
  assert (Management.Database.RelationMap.is_empty db.relations);
  assert (db.history = [])

let%test_unit "database: add relation" =
  let db = Management.Database.empty ~name:"test_db" in
  (* Create a minimal relation for testing *)
  let 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)
      ~provenance:Relation.Provenance.Undefined
      ~lineage:(Relation.Lineage.Base "users")
  in
  let db = Management.Database.add_relation db ~relation in
  assert (Management.Database.has_relation db "users");
  assert (Management.Database.get_relation_hash db "users" = Some "rel_hash_1");
  assert (not (Management.Database.has_relation db "orders"))

let%test_unit "database: remove relation" =
  let db = Management.Database.empty ~name:"test_db" in
  let 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)
      ~provenance:Relation.Provenance.Undefined
      ~lineage:(Relation.Lineage.Base "users")
  in
  let db = Management.Database.add_relation db ~relation in
  assert (Management.Database.has_relation db "users");
  let db = Management.Database.remove_relation db ~name:"users" in
  assert (not (Management.Database.has_relation db "users"))

let%test_unit "database: update relation" =
  let db = Management.Database.empty ~name:"test_db" in
  let 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)
      ~provenance:Relation.Provenance.Undefined
      ~lineage:(Relation.Lineage.Base "users")
  in
  let db = Management.Database.add_relation db ~relation in
  let old_db_hash = db.hash in
  let updated_relation = { relation with hash = Some "hash2" } in
  let db = Management.Database.update_relation db ~relation:updated_relation in
  assert (Management.Database.get_relation_hash db "users" = Some "hash2");
  assert (db.hash <> old_db_hash);
  assert (List.mem old_db_hash db.history)

let%test_unit "database: get relation names" =
  let db = Management.Database.empty ~name:"test_db" in
  let rel1 =
    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)
      ~provenance:Relation.Provenance.Undefined
      ~lineage:(Relation.Lineage.Base "users")
  in
  let rel2 =
    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)
      ~provenance:Relation.Provenance.Undefined
      ~lineage:(Relation.Lineage.Base "orders")
  in
  let db = Management.Database.add_relation db ~relation:rel1 in
  let db = Management.Database.add_relation db ~relation:rel2 in
  let names = Management.Database.get_relation_names db in
  assert (List.length names = 2);
  assert (List.mem "users" names);
  assert (List.mem "orders" names)

(* Helper to create storage for tests *)
let with_storage f =
  match Management.Physical.Memory.create () with
  | Error _ -> assert false
  | Ok storage ->
      let result = f storage in
      Management.Physical.Memory.close storage;
      result

let%test_unit "manipulation: create database" =
  with_storage (fun storage ->
      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 Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema =
        Schema.empty |> Schema.add "name" "string" |> Schema.add "age" "integer"
      in
      match
        Memory.create_relation storage db ~name:"users" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) ->
          assert (relation.name = "users");
          assert (relation.schema = schema);
          assert (Management.Database.has_relation db "users"))

let%test_unit "manipulation: create relation already exists" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      match
        Memory.create_relation storage db ~name:"users" ~schema
      with
      | Error _ -> assert false
      | Ok (db, _) -> (
          match
            Memory.create_relation storage db ~name:"users" ~schema
          with
          | Error (Error.RelationAlreadyExists _) -> ()
          | _ -> assert false))

let%test_unit "manipulation: retract relation" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      match
        Memory.create_relation storage db ~name:"users" ~schema
      with
      | Error _ -> assert false
      | Ok (db, _) -> (
          assert (Management.Database.has_relation db "users");
          match
            Memory.retract_relation storage db ~name:"users"
          with
          | Error _ -> assert false
          | Ok db -> assert (not (Management.Database.has_relation db "users"))))

let%test_unit "manipulation: create tuple with storage" =
  with_storage (fun storage ->
      let db =
        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
        Memory.create_relation storage db ~name:"users" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let attrs =
            Tuple.AttributeMap.empty
            |> Tuple.AttributeMap.add "name"
                 { Attribute.value = Obj.magic "Alice" }
          in
          let tuple : Tuple.materialized =
            { relation = "users"; attributes = attrs }
          in
          match Memory.create_tuple storage db relation tuple with
          | Error _ -> assert false
          | Ok (_db, new_relation, _hash) ->
              assert (Memory.tuple_count new_relation = 1)))

let%test_unit "manipulation: create and load tuple" =
  with_storage (fun storage ->
      let db =
        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
        Memory.create_relation storage db ~name:"numbers" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let attrs =
            Tuple.AttributeMap.empty
            |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 }
          in
          let tuple : Tuple.materialized =
            { relation = "numbers"; attributes = attrs }
          in
          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 Memory.load_tuple storage tuple_hash with
              | Error _ -> assert false
              | Ok None -> assert false
              | Ok (Some loaded_tuple) ->
                  assert (loaded_tuple.relation = "numbers");
                  let loaded_value =
                    Tuple.AttributeMap.find "value" loaded_tuple.attributes
                  in
                  assert ((Obj.magic loaded_value.Attribute.value : int) = 42))))

let%test_unit "manipulation: create multiple tuples with storage" =
  with_storage (fun storage ->
      let db =
        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
        Memory.create_relation storage db ~name:"items" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let make_tuple id =
            let attrs =
              Tuple.AttributeMap.empty
              |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id }
            in
            ({ Tuple.relation = "items"; attributes = attrs }
              : Tuple.materialized)
          in
          let tuples = [ make_tuple 1; make_tuple 2; make_tuple 3 ] in
          match
            Memory.create_tuples storage db relation tuples
          with
          | Error _ -> assert false
          | Ok (_db, new_relation, hashes) ->
              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 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
        Memory.create_relation storage db ~name:"test" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let make_tuple n =
            let attrs =
              Tuple.AttributeMap.empty
              |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n }
            in
            ({ Tuple.relation = "test"; attributes = attrs }
              : Tuple.materialized)
          in
          match
            Memory.create_tuples storage db relation
              [ make_tuple 10; make_tuple 20 ]
          with
          | Error _ -> assert false
          | Ok (_db, _relation, hashes) -> (
              match Memory.load_tuples storage hashes with
              | Error _ -> assert false
              | Ok loaded ->
                  assert (List.length loaded = 2);
                  let values =
                    List.map
                      (fun t ->
                        let attr =
                          Tuple.AttributeMap.find "n" t.Tuple.attributes
                        in
                        (Obj.magic attr.Attribute.value : int))
                      loaded
                  in
                  assert (List.mem 10 values);
                  assert (List.mem 20 values))))

let%test_unit "manipulation: retract tuple" =
  with_storage (fun storage ->
      let db =
        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
        Memory.create_relation storage db ~name:"numbers" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let attrs =
            Tuple.AttributeMap.empty
            |> Tuple.AttributeMap.add "value" { Attribute.value = Obj.magic 42 }
          in
          let tuple : Tuple.materialized =
            { relation = "numbers"; attributes = attrs }
          in
          match Memory.create_tuple storage db relation tuple with
          | Error _ -> assert false
          | Ok (db, relation, tuple_hash) -> (
              assert (Memory.tuple_count relation = 1);
              match
                Memory.retract_tuple storage db relation
                  ~tuple_hash
              with
              | Error _ -> assert false
              | Ok (_db, relation) -> (
                  assert (Memory.tuple_count relation = 0);
                  (* Tuple data still exists in storage (append-only) *)
                  match Memory.load_tuple storage tuple_hash with
                  | Error _ -> assert false
                  | Ok None -> assert false
                  | Ok (Some _) -> () (* Data is still there *)))))

let%test_unit "manipulation: tuple hashes" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      match
        Memory.create_relation storage db ~name:"test" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let make_tuple n =
            let attrs =
              Tuple.AttributeMap.empty
              |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n }
            in
            ({ Tuple.relation = "test"; attributes = attrs }
              : Tuple.materialized)
          in
          match
            Memory.create_tuples storage db relation
              [ make_tuple 1; make_tuple 2 ]
          with
          | Error _ -> assert false
          | Ok (_db, relation, _) ->
              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 Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      match
        Memory.create_relation storage db ~name:"test" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let make_tuple n =
            let attrs =
              Tuple.AttributeMap.empty
              |> Tuple.AttributeMap.add "n" { Attribute.value = Obj.magic n }
            in
            ({ Tuple.relation = "test"; attributes = attrs }
              : Tuple.materialized)
          in
          match
            Memory.create_tuples storage db relation
              [ make_tuple 1; make_tuple 2; make_tuple 3 ]
          with
          | Error _ -> assert false
          | Ok (db, relation, _) -> (
              assert (Memory.tuple_count relation = 3);
              match Memory.clear_relation storage db relation with
              | Error _ -> assert false
              | Ok (_db, relation) ->
                  assert (Memory.tuple_count relation = 0))))

let%test_unit "manipulation: duplicate tuple rejected" =
  with_storage (fun storage ->
      let db =
        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
        Memory.create_relation storage db ~name:"test" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let attrs =
            Tuple.AttributeMap.empty
            |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 }
          in
          let tuple : Tuple.materialized =
            { relation = "test"; attributes = attrs }
          in
          match Memory.create_tuple storage db relation tuple with
          | Error _ -> assert false
          | Ok (db, relation, _) -> (
              (* Try to insert the same tuple again *)
              match
                Memory.create_tuple storage db relation tuple
              with
              | Error (Error.DuplicateTuple _) -> ()
              | _ -> assert false)))

let%test_unit "manipulation: tuple_exists check" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      match
        Memory.create_relation storage db ~name:"test" ~schema
      with
      | Error _ -> assert false
      | Ok (db, relation) -> (
          let attrs =
            Tuple.AttributeMap.empty
            |> Tuple.AttributeMap.add "v" { Attribute.value = Obj.magic 99 }
          in
          let tuple : Tuple.materialized =
            { relation = "test"; attributes = attrs }
          in
          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 (Memory.tuple_exists relation tuple_hash)))

let%test_unit "manipulation: hash_tuple deterministic" =
  let attrs =
    Tuple.AttributeMap.empty
    |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.magic 1 }
    |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.magic 2 }
  in
  let tuple : Tuple.materialized = { relation = "test"; attributes = attrs } 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" =
  let tuple1 : Tuple.materialized =
    {
      relation = "test";
      attributes =
        Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 1 };
    }
  in
  let tuple2 : Tuple.materialized =
    {
      relation = "test";
      attributes =
        Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.magic 2 };
    }
  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 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
        Memory.create_relation storage db ~name:"items" ~schema
      with
      | Error _ -> assert false
      | Ok (db, _relation) -> (
          (* Now get the relation from the database *)
          match Memory.get_relation db ~name:"items" with
          | None -> assert false
          | Some rel ->
              assert (rel.name = "items");
              assert (rel.schema = schema)))

let%test_unit "schema: persisted and loaded correctly" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema =
        Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string"
        |> Schema.add "email" "string"
      in
      match
        Memory.create_relation storage db ~name:"users" ~schema
      with
      | Error _ -> assert false
      | Ok (db, _relation) -> (
          (* Get the relation hash *)
          let rel_hash =
            Option.get (Management.Database.get_relation_hash db "users")
          in
          (* Load the relation from storage *)
          match Memory.load_relation storage rel_hash with
          | Error _ -> assert false
          | Ok None -> assert false
          | Ok (Some loaded_rel) ->
              (* Verify schema was persisted and loaded correctly *)
              assert (loaded_rel.schema = schema);
              assert (List.mem ("id", "integer") loaded_rel.schema);
              assert (List.mem ("name", "string") loaded_rel.schema);
              assert (List.mem ("email", "string") loaded_rel.schema)))

let%test_unit "catalog: create_database seeds 6 catalog relations" =
  with_storage (fun storage ->
      match Memory.create_database storage ~name:"test" with
      | Error _ -> assert false
      | Ok db ->
          let catalog_names = Prelude.Catalog.catalog_relation_names in
          List.iter
            (fun name -> assert (Management.Database.has_relation db name))
            catalog_names)

let%test_unit "catalog: sakura:relation contains all 6 catalog names" =
  with_storage (fun storage ->
      match Memory.create_database storage ~name:"test" with
      | Error _ -> assert false
      | Ok db ->
          let rel =
            match
              Memory.get_relation db ~name:"sakura:relation"
            with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count rel = 6))

let%test_unit "catalog: sakura:on contains insert, update, delete" =
  with_storage (fun storage ->
      match Memory.create_database storage ~name:"test" with
      | Error _ -> assert false
      | Ok db ->
          let on_rel =
            match Memory.get_relation db ~name:"sakura:on" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count on_rel = 3))

let%test_unit "catalog: sakura:timing contains immediate, deferred" =
  with_storage (fun storage ->
      match Memory.create_database storage ~name:"test" with
      | Error _ -> assert false
      | Ok db ->
          let timing_rel =
            match Memory.get_relation db ~name:"sakura:timing" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count timing_rel = 2))

let%test_unit "catalog: sakura:domain seeded with 4 prelude domains" =
  with_storage (fun storage ->
      match Memory.create_database storage ~name:"test" with
      | Error _ -> assert false
      | Ok db ->
          let dom_rel =
            match Memory.get_relation db ~name:"sakura:domain" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count dom_rel = 4))

let%test_unit "catalog: create_relation updates sakura:relation" =
  with_storage (fun storage ->
      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
              Memory.create_relation storage db ~name:"employees"
                ~schema
            with
            | Error _ -> assert false
            | Ok (db, _) -> db
          in
          let rel =
            match
              Memory.get_relation db ~name:"sakura:relation"
            with
            | None -> assert false
            | Some r -> r
          in
          (* 6 catalog relations + 1 user relation *)
          assert (Memory.tuple_count rel = 7))

let%test_unit "catalog: create_relation updates sakura:attribute" =
  with_storage (fun storage ->
      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
              Memory.create_relation storage db ~name:"employees"
                ~schema
            with
            | Error _ -> assert false
            | Ok (db, _) -> db
          in
          let attr_rel =
            match
              Memory.get_relation db ~name:"sakura:attribute"
            with
            | None -> assert false
            | Some r -> r
          in
          (* 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 = Memory.tuple_count attr_rel in
          assert (count = 10))

let%test_unit "catalog: retract_relation removes from sakura:relation" =
  with_storage (fun storage ->
      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
              Memory.create_relation storage db ~name:"employees"
                ~schema
            with
            | Error _ -> assert false
            | Ok (db, _) -> db
          in
          let db =
            match
              Memory.retract_relation storage db ~name:"employees"
            with
            | Error _ -> assert false
            | Ok db -> db
          in
          let rel =
            match
              Memory.get_relation db ~name:"sakura:relation"
            with
            | None -> assert false
            | Some r -> r
          in
          (* Back to 6 catalog relations *)
          assert (Memory.tuple_count rel = 6))

let%test_unit "catalog: register_constraint inserts into sakura:constraint" =
  with_storage (fun storage ->
      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
              Memory.create_relation storage db ~name:"orders"
                ~schema
            with
            | Error _ -> assert false
            | Ok (db, _) -> db
          in
          let db =
            match
              Memory.register_constraint storage db
                ~constraint_name:"orders_id_positive" ~relation_name:"orders"
                ~body:(Constraint.And [])
            with
            | Error _ -> assert false
            | Ok db -> db
          in
          let con_rel =
            match
              Memory.get_relation db ~name:"sakura:constraint"
            with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count con_rel = 1))

let%test_unit "integration: full workflow with storage" =
  with_storage (fun storage ->
      (* Create database *)
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in

      (* Create products relation *)
      let schema =
        Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string"
        |> Schema.add "price" "integer"
      in

      let db, products =
        match
          Memory.create_relation storage db ~name:"products"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Insert some products *)
      let make_product id name price =
        let attrs =
          Tuple.AttributeMap.empty
          |> Tuple.AttributeMap.add "id" { Attribute.value = Obj.magic id }
          |> Tuple.AttributeMap.add "name" { Attribute.value = Obj.magic name }
          |> Tuple.AttributeMap.add "price"
               { Attribute.value = Obj.magic price }
        in
        ({ Tuple.relation = "products"; attributes = attrs }
          : Tuple.materialized)
      in

      let tuples =
        [
          make_product 1 "Apple" 100;
          make_product 2 "Banana" 50;
          make_product 3 "Cherry" 200;
        ]
      in

      let db, products, hashes =
        match Memory.create_tuples storage db products tuples with
        | Error _ -> assert false
        | Ok x -> x
      in

      assert (Memory.tuple_count products = 3);
      assert (List.length hashes = 3);

      (* Verify we can load all tuples back *)
      (match Memory.load_tuples storage hashes with
      | Error _ -> assert false
      | Ok loaded -> assert (List.length loaded = 3));

      (* Delete one product *)
      let banana_hash = Hashing.hash_tuple (make_product 2 "Banana" 50) in
      let _db, products =
        match
          Memory.retract_tuple storage db products
            ~tuple_hash:banana_hash
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      assert (Memory.tuple_count products = 2);

      (* Verify remaining hashes *)
      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 Memory.load_tuple storage banana_hash with
      | Error _ -> assert false
      | Ok None -> assert false
      | Ok (Some loaded) ->
          let name_attr = Tuple.AttributeMap.find "name" loaded.attributes in
          assert ((Obj.magic name_attr.Attribute.value : string) = "Banana"))

let%test_unit "integration: database history tracking" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"versioned" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let initial_hash = db.hash in

      let schema = Schema.empty in
      let db, _ =
        match
          Memory.create_relation storage db ~name:"rel1" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* After first change, initial hash should be in history *)
      assert (db.hash <> initial_hash);

      let hash_after_rel1 = db.hash in

      let db, _ =
        match
          Memory.create_relation storage db ~name:"rel2" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* After second change, previous hash should be in history *)
      assert (db.hash <> hash_after_rel1);
      assert (List.mem hash_after_rel1 db.history))

let%test_unit "integration: hash bubbles up correctly" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in

      let db, relation =
        match
          Memory.create_relation storage db ~name:"items" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      let db_hash_before = db.hash in
      let rel_hash_before = relation.hash in

      (* Insert a tuple *)
      let attrs =
        Tuple.AttributeMap.empty
        |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 }
      in
      let tuple : Tuple.materialized =
        { relation = "items"; attributes = attrs }
      in

      let db, relation, _ =
        match Memory.create_tuple storage db relation tuple with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Relation hash should change *)
      assert (relation.hash <> rel_hash_before);

      (* Database hash should change *)
      assert (db.hash <> db_hash_before);

      (* Old database hash should be in history *)
      assert (List.mem db_hash_before db.history);

      (* Database's merkle tree should contain the new relation hash *)
      match relation.hash with
      | None -> assert false
      | Some rel_hash -> assert (Merkle.member rel_hash db.tree))

let%test_unit "branching: load database from historical hash" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in

      (* Create relation and add a tuple *)
      let db, relation =
        match
          Memory.create_relation storage db ~name:"items" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      let attrs =
        Tuple.AttributeMap.empty
        |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 1 }
      in
      let tuple : Tuple.materialized =
        { relation = "items"; attributes = attrs }
      in

      let db, _relation, _ =
        match Memory.create_tuple storage db relation tuple with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Capture hash H1 - database with 1 tuple *)
      let h1 = db.hash in

      (* Add another tuple *)
      let attrs2 =
        Tuple.AttributeMap.empty
        |> Tuple.AttributeMap.add "x" { Attribute.value = Obj.magic 2 }
      in
      let tuple2 : Tuple.materialized =
        { relation = "items"; attributes = attrs2 }
      in

      (* Get relation from database - it's now integrated! *)
      let relation =
        match Memory.get_relation db ~name:"items" with
        | None -> assert false
        | Some r -> r
      in

      let db, _relation, _ =
        match Memory.create_tuple storage db relation tuple2 with
        | Error _ -> assert false
        | Ok x -> x
      in

      let h2 = db.hash in
      assert (h1 <> h2);

      (* Now load H1 from storage - should get database state with 1 tuple *)
      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 Memory.get_relation loaded_db ~name:"items" with
          | None -> assert false
          | Some loaded_rel ->
              (* Should have 1 tuple *)
              assert (Memory.tuple_count loaded_rel = 1)))

let%test_unit "branching: branch from historical state" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in

      (* Create relation *)
      let db, relation =
        match
          Memory.create_relation storage db ~name:"data" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Add tuple A *)
      let tuple_a : Tuple.materialized =
        {
          relation = "data";
          attributes =
            Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "A" };
        }
      in
      let db, relation, _ =
        match Memory.create_tuple storage db relation tuple_a with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Capture H1 - state with tuple A *)
      let h1 = db.hash in

      (* Continue on main branch: add tuple B *)
      let tuple_b : Tuple.materialized =
        {
          relation = "data";
          attributes =
            Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "B" };
        }
      in
      let db_main, relation_main, _ =
        match Memory.create_tuple storage db relation tuple_b with
        | Error _ -> assert false
        | Ok x -> x
      in
      let h2 = db_main.hash in

      (* Now branch from H1 and add tuple C instead *)
      let db_branch =
        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 Memory.get_relation db_branch ~name:"data" with
        | None -> assert false
        | Some r -> r
      in

      let tuple_c : Tuple.materialized =
        {
          relation = "data";
          attributes =
            Tuple.AttributeMap.singleton "v" { Attribute.value = Obj.magic "C" };
        }
      in
      let db_branch, _relation_branch, _ =
        match
          Memory.create_tuple storage db_branch relation_branch
            tuple_c
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let h3 = db_branch.hash in

      (* Verify: H1, H2, H3 are all different *)
      assert (h1 <> h2);
      assert (h1 <> h3);
      assert (h2 <> h3);

      (* H2 (main branch) has tuples A and B *)
      assert (Memory.tuple_count relation_main = 2);

      (* H1 is still loadable and unchanged *)
      match Memory.load_database storage h1 with
      | Error _ -> assert false
      | Ok None -> assert false
      | Ok (Some loaded_h1) -> (
          match Memory.get_relation loaded_h1 ~name:"data" with
          | None -> assert false
          | Some r -> assert (Memory.tuple_count r = 1)))

let%test_unit "branching: full reconstruction from hash" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in

      (* Create relation *)
      let db, relation =
        match
          Memory.create_relation storage db ~name:"products"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      (* Add products *)
      let make_product name =
        {
          Tuple.relation = "products";
          attributes =
            Tuple.AttributeMap.singleton "name"
              { Attribute.value = Obj.magic name };
        }
      in
      let db, _relation, _ =
        match
          Memory.create_tuples storage db relation
            [
              make_product "Apple"; make_product "Banana"; make_product "Cherry";
            ]
        with
        | Error _ -> assert false
        | Ok x -> x
      in

      let saved_hash = db.hash in

      (* Now reconstruct everything from just the hash *)
      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 Memory.get_relation loaded_db ~name:"products" with
          | None -> assert false
          | Some loaded_rel -> (
              (* Get tuple hashes from relation *)
              let tuple_hashes = Memory.tuple_hashes loaded_rel in
              assert (List.length tuple_hashes = 3);

              (* Load all tuples *)
              match Memory.load_tuples storage tuple_hashes with
              | Error _ -> assert false
              | Ok tuples ->
                  assert (List.length tuples = 3);
                  let names =
                    List.map
                      (fun t ->
                        let attr =
                          Tuple.AttributeMap.find "name" t.Tuple.attributes
                        in
                        (Obj.magic attr.Attribute.value : string))
                      tuples
                  in
                  assert (List.mem "Apple" names);
                  assert (List.mem "Banana" names);
                  assert (List.mem "Cherry" names))))

(* Helper: build a materialized tuple with int attributes *)
let make_int_tuple relation pairs =
  let attributes =
    List.fold_left
      (fun acc (k, v) ->
        Tuple.AttributeMap.add k { Attribute.value = Obj.repr (v : int) } acc)
      Tuple.AttributeMap.empty pairs
  in
  (Tuple.Materialized { Tuple.relation; attributes } : Tuple.t)

(* Helper: build a stored relation with one integer column and given values *)
let stored_relation_with_ints storage db ~name ~attr values =
  let schema = Schema.empty |> Schema.add attr "integer" in
  let db, rel =
    match Memory.create_relation storage db ~name ~schema with
    | Error _ -> assert false
    | Ok x -> x
  in
  let tuples =
    List.map
      (fun v ->
        let attributes =
          Tuple.AttributeMap.singleton attr
            { Attribute.value = Obj.repr (v : int) }
        in
        ({ Tuple.relation = name; attributes } : Tuple.materialized))
      values
  in
  let db, rel, _ =
    match Memory.create_tuples storage db rel tuples with
    | Error _ -> assert false
    | Ok x -> x
  in
  (db, rel)

let%test_unit "algebra: const_relation single tuple" =
  with_storage (fun storage ->
      let rel =
        Algebra.Memory.const_relation
          [ ("x", Obj.repr (42 : int)); ("y", Obj.repr (99 : int)) ]
      in
      match Algebra.Memory.materialize storage rel with
      | Error _ -> assert false
      | Ok [ tup ] ->
          let x : int =
            Obj.obj
              (Tuple.AttributeMap.find "x" tup.Tuple.attributes).Attribute.value
          in
          assert (x = 42)
      | Ok _ -> assert false)

let%test_unit "algebra: select_fn with predicate" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let _, rel =
        stored_relation_with_ints storage db ~name:"nums" ~attr:"n"
          [ 1; 2; 3; 4; 5 ]
      in
      let predicate = function
        | Tuple.Materialized t ->
            let v : int =
              Obj.obj
                (Tuple.AttributeMap.find "n" t.Tuple.attributes).Attribute.value
            in
            v > 3
        | _ -> false
      in
      match Algebra.Memory.select_fn storage predicate rel with
      | Error _ -> assert false
      | Ok result -> (
          match Algebra.Memory.materialize storage result with
          | Error _ -> assert false
          | Ok rows ->
              assert (List.length rows = 2);
              List.iter
                (fun t ->
                  let v : int =
                    Obj.obj
                      (Tuple.AttributeMap.find "n" t.Tuple.attributes)
                        .Attribute.value
                  in
                  assert (v > 3))
                rows))

let%test_unit "algebra: project restricts schema" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema =
        Schema.empty |> Schema.add "a" "integer" |> Schema.add "b" "integer"
      in
      let db, rel =
        match
          Memory.create_relation storage db ~name:"ab" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let attrs =
        Tuple.AttributeMap.empty
        |> Tuple.AttributeMap.add "a" { Attribute.value = Obj.repr (1 : int) }
        |> Tuple.AttributeMap.add "b" { Attribute.value = Obj.repr (2 : int) }
      in
      let _, rel, _ =
        match
          Memory.create_tuple storage db rel
            { Tuple.relation = "ab"; attributes = attrs }
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      match Algebra.Memory.project storage [ "a" ] rel with
      | Error _ -> assert false
      | Ok projected -> (
          match Algebra.Memory.materialize storage projected with
          | Error _ -> assert false
          | Ok [ t ] ->
              assert (Tuple.AttributeMap.mem "a" t.Tuple.attributes);
              assert (not (Tuple.AttributeMap.mem "b" t.Tuple.attributes))
          | Ok _ -> assert false))

let%test_unit "algebra: rename changes attr names" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let _, rel =
        stored_relation_with_ints storage db ~name:"r" ~attr:"x" [ 7 ]
      in
      match Algebra.Memory.rename storage [ ("x", "y") ] rel with
      | Error _ -> assert false
      | Ok renamed -> (
          match Algebra.Memory.materialize storage renamed with
          | Error _ -> assert false
          | Ok [ t ] ->
              assert (not (Tuple.AttributeMap.mem "x" t.Tuple.attributes));
              assert (Tuple.AttributeMap.mem "y" t.Tuple.attributes);
              let v : int =
                Obj.obj
                  (Tuple.AttributeMap.find "y" t.Tuple.attributes)
                    .Attribute.value
              in
              assert (v = 7)
          | Ok _ -> assert false))

let%test_unit "algebra: equijoin merges matching tuples" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* left: {id=1, name="Alice"}, {id=2, name="Bob"} *)
      let schema_l =
        Schema.empty |> Schema.add "id" "integer" |> Schema.add "name" "string"
      in
      let db, left =
        match
          Memory.create_relation storage db ~name:"L"
            ~schema:schema_l
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let make_left id name =
        let attrs =
          Tuple.AttributeMap.empty
          |> Tuple.AttributeMap.add "id"
               { Attribute.value = Obj.repr (id : int) }
          |> Tuple.AttributeMap.add "name"
               { Attribute.value = Obj.repr (name : string) }
        in
        ({ Tuple.relation = "L"; attributes = attrs } : Tuple.materialized)
      in
      let db, left, _ =
        match
          Memory.create_tuples storage db left
            [ make_left 1 "Alice"; make_left 2 "Bob" ]
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* right: {id=1, score=100}, {id=3, score=999} *)
      let schema_r =
        Schema.empty |> Schema.add "id" "integer"
        |> Schema.add "score" "integer"
      in
      let db, right =
        match
          Memory.create_relation storage db ~name:"R"
            ~schema:schema_r
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let make_right id score =
        let attrs =
          Tuple.AttributeMap.empty
          |> Tuple.AttributeMap.add "id"
               { Attribute.value = Obj.repr (id : int) }
          |> Tuple.AttributeMap.add "score"
               { Attribute.value = Obj.repr (score : int) }
        in
        ({ Tuple.relation = "R"; attributes = attrs } : Tuple.materialized)
      in
      let _, right, _ =
        match
          Memory.create_tuples storage db right
            [ make_right 1 100; make_right 3 999 ]
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      match Algebra.Memory.equijoin storage [ "id" ] left right with
      | Error _ -> assert false
      | Ok joined -> (
          match Algebra.Memory.materialize storage joined with
          | Error _ -> assert false
          | Ok rows ->
              (* Only id=1 matches *)
              assert (List.length rows = 1);
              let t = List.hd rows in
              let score : int =
                Obj.obj
                  (Tuple.AttributeMap.find "score" t.Tuple.attributes)
                    .Attribute.value
              in
              assert (score = 100)))

let%test_unit "algebra: equijoin empty match" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db, left =
        stored_relation_with_ints storage db ~name:"L" ~attr:"id" [ 1; 2 ]
      in
      let _, right =
        stored_relation_with_ints storage db ~name:"R" ~attr:"id" [ 9; 8 ]
      in
      match Algebra.Memory.equijoin storage [ "id" ] left right with
      | Error _ -> assert false
      | Ok joined -> (
          match Algebra.Memory.materialize storage joined with
          | Error _ -> assert false
          | Ok rows -> assert (List.length rows = 0)))

let%test_unit "algebra: union concatenates streams" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db, r1 =
        stored_relation_with_ints storage db ~name:"A" ~attr:"n" [ 1; 2 ]
      in
      let _, r2 =
        stored_relation_with_ints storage db ~name:"B" ~attr:"n" [ 3; 4 ]
      in
      match Algebra.Memory.union storage r1 r2 with
      | Error _ -> assert false
      | Ok unioned -> (
          match Algebra.Memory.materialize storage unioned with
          | Error _ -> assert false
          | Ok rows ->
              assert (List.length rows = 4);
              let vals =
                List.map
                  (fun t ->
                    Obj.obj
                      (Tuple.AttributeMap.find "n" t.Tuple.attributes)
                        .Attribute.value)
                  rows
              in
              assert (List.mem 1 vals);
              assert (List.mem 2 vals);
              assert (List.mem 3 vals);
              assert (List.mem 4 vals)))

let%test_unit "algebra: diff removes right from left" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db, r1 =
        stored_relation_with_ints storage db ~name:"A" ~attr:"n" [ 1; 2; 3 ]
      in
      let _, r2 =
        stored_relation_with_ints storage db ~name:"B" ~attr:"n" [ 2; 3 ]
      in
      match Algebra.Memory.diff storage r1 r2 with
      | Error _ -> assert false
      | Ok result -> (
          match Algebra.Memory.materialize storage result with
          | Error _ -> assert false
          | Ok rows ->
              assert (List.length rows = 1);
              let v : int =
                Obj.obj
                  (Tuple.AttributeMap.find "n" (List.hd rows).Tuple.attributes)
                    .Attribute.value
              in
              assert (v = 1)))

let%test_unit "algebra: take limits output" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let _, rel =
        stored_relation_with_ints storage db ~name:"big" ~attr:"n"
          [ 10; 20; 30; 40; 50 ]
      in
      match Algebra.Memory.take storage 3 rel with
      | Error _ -> assert false
      | Ok result -> (
          match Algebra.Memory.materialize storage result with
          | Error _ -> assert false
          | Ok rows -> assert (List.length rows = 3)))

let%test_unit "drl: parse Base" =
  match Drl.Parser.of_string {|(Base "users")|} with
  | Error _ -> assert false
  | Ok (Drl.Ast.Base s) -> assert (s = "users")
  | Ok _ -> assert false

let%test_unit "drl: parse Const" =
  match Drl.Parser.of_string {|(Const (("age" (Int 18))))|} with
  | Error _ -> assert false
  | Ok (Drl.Ast.Const [ ("age", Drl.Ast.Int 18) ]) -> ()
  | Ok _ -> assert false

let%test_unit "drl: parse Join" =
  match Drl.Parser.of_string {|(Join (id) (Base "L") (Base "R"))|} with
  | Error _ -> assert false
  | Ok (Drl.Ast.Join ([ "id" ], Drl.Ast.Base "L", Drl.Ast.Base "R")) -> ()
  | Ok _ -> assert false

let%test_unit "drl: parse Select" =
  let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in
  match Drl.Parser.of_string s with
  | Error _ -> assert false
  | Ok (Drl.Ast.Select (Drl.Ast.Const _, Drl.Ast.Base "users")) -> ()
  | Ok _ -> assert false

let%test_unit "drl: execute Base" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db, _ =
        stored_relation_with_ints storage db ~name:"items" ~attr:"v" [ 10; 20 ]
      in
      match Drl.Parser.of_string {|(Base "items")|} with
      | Error _ -> assert false
      | Ok query -> (
          match Drl.Executor.Memory.execute storage db query with
          | Error _ -> assert false
          | Ok rel -> (
              match Algebra.Memory.materialize storage rel with
              | Error _ -> assert false
              | Ok rows -> assert (List.length rows = 2))))

let%test_unit "drl: execute Select+Const" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test_db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* users: {age=18, name="Alice"}, {age=25, name="Bob"} *)
      let schema =
        Schema.empty |> Schema.add "age" "integer" |> Schema.add "name" "string"
      in
      let db, users =
        match
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let make_user age name =
        let attrs =
          Tuple.AttributeMap.empty
          |> Tuple.AttributeMap.add "age"
               { Attribute.value = Obj.repr (age : int) }
          |> Tuple.AttributeMap.add "name"
               { Attribute.value = Obj.repr (name : string) }
        in
        ({ Tuple.relation = "users"; attributes = attrs } : Tuple.materialized)
      in
      let db, _, _ =
        match
          Memory.create_tuples storage db users
            [ make_user 18 "Alice"; make_user 25 "Bob" ]
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Query: select users where age = 18 *)
      let s = {|(Select (Const (("age" (Int 18)))) (Base "users"))|} in
      match Drl.Parser.of_string s with
      | Error _ -> assert false
      | Ok query -> (
          match Drl.Executor.Memory.execute storage db query with
          | Error _ -> assert false
          | Ok rel -> (
              match Algebra.Memory.materialize storage rel with
              | Error _ -> assert false
              | Ok rows ->
                  assert (List.length rows = 1);
                  let name_v : string =
                    Obj.obj
                      (Tuple.AttributeMap.find "name"
                         (List.hd rows).Tuple.attributes)
                        .Attribute.value
                  in
                  assert (name_v = "Alice"))))

(* ---------- Constraint construction ---------- *)

let%test_unit "constraint: vars_in MemberOf" =
  let b =
    Constraint.BindingMap.empty
    |> Constraint.BindingMap.add "left" (Constraint.Var "x")
    |> Constraint.BindingMap.add "right" (Constraint.Const (Obj.repr 10))
  in
  let c = Constraint.MemberOf { target = "less_than"; binding = b } in
  let vars = Constraint.vars_in c in
  assert (List.mem "x" vars);
  assert (not (List.mem "right" vars))

let%test_unit "constraint: vars_in And" =
  let b1 = Constraint.BindingMap.singleton "left" (Constraint.Var "a") in
  let b2 = Constraint.BindingMap.singleton "left" (Constraint.Var "b") in
  let c =
    Constraint.And
      [
        Constraint.MemberOf { target = "t1"; binding = b1 };
        Constraint.MemberOf { target = "t2"; binding = b2 };
      ]
  in
  let vars = Constraint.vars_in c in
  assert (List.mem "a" vars);
  assert (List.mem "b" vars)

let%test_unit "constraint: rename_vars" =
  let b = Constraint.BindingMap.singleton "left" (Constraint.Var "old_name") in
  let c = Constraint.MemberOf { target = "t"; binding = b } in
  let c' = Constraint.rename_vars [ ("old_name", "new_name") ] c in
  let vars = Constraint.vars_in c' in
  assert (List.mem "new_name" vars);
  assert (not (List.mem "old_name" vars))

let%test_unit "constraint: filter_by_attrs keeps relevant" =
  let b = Constraint.BindingMap.singleton "left" (Constraint.Var "x") in
  let c = Constraint.MemberOf { target = "t"; binding = b } in
  assert (Constraint.filter_by_attrs [ "x" ] c <> None);
  assert (Constraint.filter_by_attrs [ "y" ] c = None)

let%test_unit "constraint: merge named constraints" =
  let b = Constraint.BindingMap.empty in
  let cs1 = [ ("c1", Constraint.MemberOf { target = "t1"; binding = b }) ] in
  let cs2 = [ ("c2", Constraint.MemberOf { target = "t2"; binding = b }) ] in
  let merged = Constraint.merge cs1 cs2 in
  assert (List.length merged = 2)

let%test_unit "constraint: merge duplicate names produces And" =
  let b = Constraint.BindingMap.empty in
  let c1 = Constraint.MemberOf { target = "t1"; binding = b } in
  let c2 = Constraint.MemberOf { target = "t2"; binding = b } in
  let merged = Constraint.merge [ ("shared", c1) ] [ ("shared", c2) ] in
  assert (List.length merged = 1);
  match List.assoc "shared" merged with
  | Constraint.And _ -> ()
  | _ -> assert false

(* ---------- Smart constructors ---------- *)

let%test_unit "constraint: and_ singleton" =
  let b = Constraint.BindingMap.empty in
  let c = Constraint.MemberOf { target = "t"; binding = b } in
  match Constraint.and_ [ c ] with
  | Constraint.MemberOf _ -> ()
  | _ -> assert false

let%test_unit "constraint: or_ singleton" =
  let b = Constraint.BindingMap.empty in
  let c = Constraint.MemberOf { target = "t"; binding = b } in
  match Constraint.or_ [ c ] with
  | Constraint.MemberOf _ -> ()
  | _ -> assert false

(* ---------- Comparison shorthands ---------- *)

let%test_unit "constraint: lt shorthand" =
  match Constraint.lt ~left:(Var "x") ~right:(Const (Obj.repr 5)) with
  | Constraint.MemberOf { target = "less_than"; _ } -> ()
  | _ -> assert false

let%test_unit "constraint: between shorthand" =
  match
    Constraint.between ~value:(Var "x")
      ~low:(Const (Obj.repr 0))
      ~high:(Const (Obj.repr 100))
  with
  | Constraint.And [ _; _ ] -> ()
  | _ -> assert false

(* ---------- Binding resolution ---------- *)

let%test_unit "constraint: bind resolves Var and Const" =
  let b =
    Constraint.BindingMap.empty
    |> Constraint.BindingMap.add "left" (Constraint.Var "x")
    |> Constraint.BindingMap.add "right" (Constraint.Const (Obj.repr 42))
  in
  let tuple : Tuple.materialized =
    {
      relation = "test";
      attributes =
        Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.repr 10 };
    }
  in
  let bound = Constraint.bind b tuple in
  assert (List.length bound = 2);
  let left_v : int = Obj.obj (List.assoc "left" bound) in
  let right_v : int = Obj.obj (List.assoc "right" bound) in
  assert (left_v = 10);
  assert (right_v = 42)

(* ---------- Evaluation engine ---------- *)

let make_eval_ctx ?(relations = []) () : Constraint.eval_context =
  {
    check_membership =
      (fun rel_name bound_pairs ->
        match List.assoc_opt rel_name relations with
        | None -> false
        | Some checker -> checker bound_pairs);
    iterate_finite =
      (fun rel_name ->
        match List.assoc_opt rel_name relations with
        | None -> None
        | Some _ -> Some []);
  }

let%test_unit "constraint: evaluate MemberOf success" =
  let ctx = make_eval_ctx ~relations:[ ("my_rel", fun _pairs -> true) ] () in
  let b = Constraint.BindingMap.empty in
  let c = Constraint.MemberOf { target = "my_rel"; binding = b } in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false

let%test_unit "constraint: evaluate MemberOf failure" =
  let ctx = make_eval_ctx ~relations:[ ("my_rel", fun _pairs -> false) ] () in
  let b = Constraint.BindingMap.empty in
  let c = Constraint.MemberOf { target = "my_rel"; binding = b } in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  match Constraint.evaluate ctx tuple c with
  | Error (Constraint.MembershipFailed _) -> ()
  | _ -> assert false

let%test_unit "constraint: evaluate And short-circuits" =
  let call_count = ref 0 in
  let ctx =
    make_eval_ctx
      ~relations:
        [
          ( "fail_rel",
            fun _ ->
              incr call_count;
              false );
          ( "ok_rel",
            fun _ ->
              incr call_count;
              true );
        ]
      ()
  in
  let b = Constraint.BindingMap.empty in
  let c =
    Constraint.And
      [
        Constraint.MemberOf { target = "fail_rel"; binding = b };
        Constraint.MemberOf { target = "ok_rel"; binding = b };
      ]
  in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  (match Constraint.evaluate ctx tuple c with
  | Error _ -> ()
  | _ -> assert false);
  (* Second branch should not have been called *)
  assert (!call_count = 1)

let%test_unit "constraint: evaluate Or succeeds on first match" =
  let ctx =
    make_eval_ctx ~relations:[ ("a", fun _ -> false); ("b", fun _ -> true) ] ()
  in
  let b = Constraint.BindingMap.empty in
  let c =
    Constraint.Or
      [
        Constraint.MemberOf { target = "a"; binding = b };
        Constraint.MemberOf { target = "b"; binding = b };
      ]
  in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false

let%test_unit "constraint: evaluate Not negates" =
  let ctx : Constraint.eval_context =
    {
      check_membership =
        (fun rel_name _pairs ->
          match rel_name with
          | "universe" -> true
          | "body_rel" -> false
          | _ -> false);
      iterate_finite = (fun _ -> None);
    }
  in
  let b = Constraint.BindingMap.empty in
  let c =
    Constraint.Not
      {
        body = Constraint.MemberOf { target = "body_rel"; binding = b };
        universe = "universe";
      }
  in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false

let%test_unit "constraint: evaluate Exists over finite relation" =
  let ctx : Constraint.eval_context =
    {
      check_membership =
        (fun _rel_name pairs ->
          match (List.assoc_opt "left" pairs, List.assoc_opt "right" pairs) with
          | Some l, Some r -> (Obj.obj l : int) < (Obj.obj r : int)
          | _ -> false);
      iterate_finite =
        (fun rel_name ->
          if rel_name = "small_set" then
            Some
              [
                [ ("value", Obj.repr 1) ];
                [ ("value", Obj.repr 5) ];
                [ ("value", Obj.repr 10) ];
              ]
          else None);
    }
  in
  let b =
    Constraint.BindingMap.empty
    |> Constraint.BindingMap.add "left" (Constraint.Var "x")
    |> Constraint.BindingMap.add "right" (Constraint.Var "value.value")
  in
  let c =
    Constraint.Exists
      {
        variable = "value";
        quantifier = "small_set";
        body = Constraint.MemberOf { target = "less_than"; binding = b };
      }
  in
  (* x=3, exists value in {1,5,10} where 3 < value => true (5 or 10 work) *)
  let tuple : Tuple.materialized =
    {
      relation = "test";
      attributes =
        Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.repr 3 };
    }
  in
  match Constraint.evaluate ctx tuple c with Ok true -> () | _ -> assert false

let%test_unit "constraint: evaluate Forall fails when not all match" =
  let ctx : Constraint.eval_context =
    {
      check_membership =
        (fun _rel_name pairs ->
          match (List.assoc_opt "left" pairs, List.assoc_opt "right" pairs) with
          | Some l, Some r -> (Obj.obj l : int) < (Obj.obj r : int)
          | _ -> false);
      iterate_finite =
        (fun rel_name ->
          if rel_name = "small_set" then
            Some [ [ ("value", Obj.repr 1) ]; [ ("value", Obj.repr 5) ] ]
          else None);
    }
  in
  let b =
    Constraint.BindingMap.empty
    |> Constraint.BindingMap.add "left" (Constraint.Var "x")
    |> Constraint.BindingMap.add "right" (Constraint.Var "value.value")
  in
  let c =
    Constraint.Forall
      {
        variable = "value";
        quantifier = "small_set";
        body = Constraint.MemberOf { target = "less_than"; binding = b };
      }
  in
  (* x=3, forall value in {1,5} where 3 < value => false (3 is not < 1) *)
  let tuple : Tuple.materialized =
    {
      relation = "test";
      attributes =
        Tuple.AttributeMap.singleton "x" { Attribute.value = Obj.repr 3 };
    }
  in
  match Constraint.evaluate ctx tuple c with
  | Ok false -> ()
  | _ -> assert false

let%test_unit "constraint: Forall unbounded quantifier errors" =
  let ctx : Constraint.eval_context =
    { check_membership = (fun _ _ -> true); iterate_finite = (fun _ -> None) }
  in
  let b = Constraint.BindingMap.empty in
  let c =
    Constraint.Forall
      {
        variable = "v";
        quantifier = "infinite_rel";
        body = Constraint.MemberOf { target = "t"; binding = b };
      }
  in
  let tuple : Tuple.materialized =
    { relation = "test"; attributes = Tuple.AttributeMap.empty }
  in
  match Constraint.evaluate ctx tuple c with
  | Error (Constraint.UnboundedQuantifier _) -> ()
  | _ -> assert false

(* ---------- Integrated constraint enforcement in manipulation ---------- *)

let%test_unit "constraint: create_tuple with passing constraint" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"positives"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Register a constraint: value must be member of natural (always true for naturals) *)
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"is_natural" ~relation_name:"positives"
            ~body:(Constraint.And [])
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let rel =
        match Memory.get_relation db ~name:"positives" with
        | None -> assert false
        | Some r -> r
      in
      let tuple : Tuple.materialized =
        {
          relation = "positives";
          attributes =
            Tuple.AttributeMap.singleton "value"
              { Attribute.value = Obj.repr 5 };
        }
      in
      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 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
          Memory.create_relation storage db ~name:"checked" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Register a constraint that always fails: MemberOf a nonexistent relation *)
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"impossible" ~relation_name:"checked"
            ~body:
              (Constraint.MemberOf
                 {
                   target = "nonexistent_relation";
                   binding =
                     Constraint.BindingMap.singleton "x"
                       (Constraint.Var "value");
                 })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let rel =
        match Memory.get_relation db ~name:"checked" with
        | None -> assert false
        | Some r -> r
      in
      let tuple : Tuple.materialized =
        {
          relation = "checked";
          attributes =
            Tuple.AttributeMap.singleton "value"
              { Attribute.value = Obj.repr 5 };
        }
      in
      match Memory.create_tuple storage db rel tuple with
      | Error (Error.ConstraintViolation _) -> ()
      | _ -> assert false)

(* ---------- Scenario tests ported from Erlang ---------- *)

(* Scenario 1: Mutual exclusion between subtypes *)
let%test_unit "constraint scenario: mutual exclusion subtypes" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"employee"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let db, _manager =
        match
          Memory.create_relation storage db ~name:"manager" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* manager must NOT be in employee (mutual exclusion) *)
      let body =
        Constraint.Not
          {
            body =
              Constraint.MemberOf
                {
                  target = "employee";
                  binding =
                    Constraint.BindingMap.singleton "id" (Constraint.Var "id");
                };
            universe = "manager";
          }
      in
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"not_employee" ~relation_name:"manager" ~body
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Insert into employee first *)
      let employee =
        match Memory.get_relation db ~name:"employee" with
        | None -> assert false
        | Some r -> r
      in
      let emp_tuple : Tuple.materialized =
        {
          relation = "employee";
          attributes =
            Tuple.AttributeMap.singleton "id" { Attribute.value = Obj.repr 1 };
        }
      in
      let db, _employee, _ =
        match
          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 Memory.get_relation db ~name:"manager" with
        | None -> assert false
        | Some r -> r
      in
      let mgr_tuple : Tuple.materialized =
        {
          relation = "manager";
          attributes =
            Tuple.AttributeMap.singleton "id" { Attribute.value = Obj.repr 1 };
        }
      in
      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 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
          Memory.create_relation storage db ~name:"orders"
            ~schema:order_schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let item_schema =
        Schema.empty
        |> Schema.add "item_id" "natural"
        |> Schema.add "order_id" "natural"
      in
      let db, _items =
        match
          Memory.create_relation storage db ~name:"order_items"
            ~schema:item_schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* FK: order_items.order_id must exist in orders *)
      let fk_body =
        Constraint.MemberOf
          {
            target = "orders";
            binding =
              Constraint.BindingMap.singleton "order_id"
                (Constraint.Var "order_id");
          }
      in
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"fk_order" ~relation_name:"order_items"
            ~body:fk_body
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Insert an order *)
      let orders =
        match Memory.get_relation db ~name:"orders" with
        | None -> assert false
        | Some r -> r
      in
      let order_tuple : Tuple.materialized =
        {
          relation = "orders";
          attributes =
            Tuple.AttributeMap.singleton "order_id"
              { Attribute.value = Obj.repr 100 };
        }
      in
      let db, _orders, _ =
        match
          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 Memory.get_relation db ~name:"order_items" with
        | None -> assert false
        | Some r -> r
      in
      let valid_item : Tuple.materialized =
        {
          relation = "order_items";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("item_id", { Attribute.value = Obj.repr 1 });
                ("order_id", { Attribute.value = Obj.repr 100 });
              ];
        }
      in
      let db, items, _ =
        match Memory.create_tuple storage db items valid_item with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Insert item referencing nonexistent order, should fail *)
      let invalid_item : Tuple.materialized =
        {
          relation = "order_items";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("item_id", { Attribute.value = Obj.repr 2 });
                ("order_id", { Attribute.value = Obj.repr 999 });
              ];
        }
      in
      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 Memory.create_database storage ~name:"test" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema =
        Schema.empty
        |> Schema.add "emp_id" "natural"
        |> Schema.add "mgr_id" "natural"
      in
      let db, _rel =
        match
          Memory.create_relation storage db ~name:"reports_to"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Register the not_equal comparison relation *)
      let db, _ =
        match
          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 _tree_of t ->
              match t with
              | Tuple.Materialized m -> (
                  match
                    ( Tuple.AttributeMap.find_opt "left" m.attributes,
                      Tuple.AttributeMap.find_opt "right" m.attributes )
                  with
                  | Some l, Some r ->
                      (Obj.obj l.Attribute.value : int)
                      <> (Obj.obj r.Attribute.value : int)
                  | _ -> false)
              | _ -> false)
            ~cardinality:Conventions.Cardinality.AlephZero
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Constraint: emp_id != mgr_id via not_equal relation *)
      let neq_body =
        Constraint.neq ~left:(Var "emp_id") ~right:(Var "mgr_id")
      in
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"no_self_manage" ~relation_name:"reports_to"
            ~body:neq_body
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let rel =
        match Memory.get_relation db ~name:"reports_to" with
        | None -> assert false
        | Some r -> r
      in
      (* Insert (emp_id=1, mgr_id=2), should succeed *)
      let valid : Tuple.materialized =
        {
          relation = "reports_to";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("emp_id", { Attribute.value = Obj.repr 1 });
                ("mgr_id", { Attribute.value = Obj.repr 2 });
              ];
        }
      in
      let db, rel, _ =
        match Memory.create_tuple storage db rel valid with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Insert (emp_id=3, mgr_id=3): same person, should fail *)
      let invalid : Tuple.materialized =
        {
          relation = "reports_to";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("emp_id", { Attribute.value = Obj.repr 3 });
                ("mgr_id", { Attribute.value = Obj.repr 3 });
              ];
        }
      in
      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 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
          Memory.create_relation storage db ~name:"open_ticket"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let db, _ =
        match
          Memory.create_relation storage db ~name:"closed_ticket"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* open_ticket must not be in closed_ticket *)
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"not_closed" ~relation_name:"open_ticket"
            ~body:
              (Constraint.Not
                 {
                   body =
                     Constraint.MemberOf
                       {
                         target = "closed_ticket";
                         binding =
                           Constraint.BindingMap.singleton "ticket_id"
                             (Constraint.Var "ticket_id");
                       };
                   universe = "open_ticket";
                 })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Insert ticket 1 as closed *)
      let closed =
        match Memory.get_relation db ~name:"closed_ticket" with
        | None -> assert false
        | Some r -> r
      in
      let t1 : Tuple.materialized =
        {
          relation = "closed_ticket";
          attributes =
            Tuple.AttributeMap.singleton "ticket_id"
              { Attribute.value = Obj.repr 1 };
        }
      in
      let db, _, _ =
        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 Memory.get_relation db ~name:"open_ticket" with
        | None -> assert false
        | Some r -> r
      in
      let t1_open : Tuple.materialized =
        {
          relation = "open_ticket";
          attributes =
            Tuple.AttributeMap.singleton "ticket_id"
              { Attribute.value = Obj.repr 1 };
        }
      in
      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 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
          Memory.create_relation storage db ~name:"parent"
            ~schema:parent_schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let dep_schema =
        Schema.empty
        |> Schema.add "dep_id" "natural"
        |> Schema.add "parent_id" "natural"
      in
      let db, _ =
        match
          Memory.create_relation storage db ~name:"dependent"
            ~schema:dep_schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* dependent.parent_id must exist in parent *)
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"parent_exists" ~relation_name:"dependent"
            ~body:
              (Constraint.MemberOf
                 {
                   target = "parent";
                   binding =
                     Constraint.BindingMap.singleton "parent_id"
                       (Constraint.Var "parent_id");
                 })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Insert parent *)
      let parent =
        match Memory.get_relation db ~name:"parent" with
        | None -> assert false
        | Some r -> r
      in
      let pt : Tuple.materialized =
        {
          relation = "parent";
          attributes =
            Tuple.AttributeMap.singleton "parent_id"
              { Attribute.value = Obj.repr 10 };
        }
      in
      let db, _, _ =
        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 Memory.get_relation db ~name:"dependent" with
        | None -> assert false
        | Some r -> r
      in
      let valid_dep : Tuple.materialized =
        {
          relation = "dependent";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("dep_id", { Attribute.value = Obj.repr 1 });
                ("parent_id", { Attribute.value = Obj.repr 10 });
              ];
        }
      in
      let db, dep, _ =
        match Memory.create_tuple storage db dep valid_dep with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Insert dependent with nonexistent parent, should fail *)
      let invalid_dep : Tuple.materialized =
        {
          relation = "dependent";
          attributes =
            Tuple.AttributeMap.of_list
              [
                ("dep_id", { Attribute.value = Obj.repr 2 });
                ("parent_id", { Attribute.value = Obj.repr 999 });
              ];
        }
      in
      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 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
          Memory.create_relation storage db ~name:"constrained"
            ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"c1" ~relation_name:"constrained"
            ~body:(Constraint.And [])
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let rel =
        match Memory.get_relation db ~name:"constrained" with
        | None -> assert false
        | Some r -> r
      in
      match Algebra.Memory.select_fn storage (fun _ -> true) rel with
      | Error _ -> assert false
      | Ok result -> assert (result.Relation.constraints <> None))

(* Scenario 7: Algebra propagation, project filters constraints *)
let%test_unit "constraint propagation: project filters constraints" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"test" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema =
        Schema.empty |> Schema.add "x" "natural" |> Schema.add "y" "natural"
      in
      let db, _rel =
        match
          Memory.create_relation storage db ~name:"xy" ~schema
        with
        | Error _ -> assert false
        | Ok x -> x
      in
      (* Constraint on x only *)
      let c_on_x =
        Constraint.MemberOf
          {
            target = "some_rel";
            binding =
              Constraint.BindingMap.singleton "left" (Constraint.Var "x");
          }
      in
      let db =
        match
          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 Memory.get_relation db ~name:"xy" with
        | None -> assert false
        | Some r -> r
      in
      (* Project to only "x", constraint should survive *)
      (match Algebra.Memory.project storage [ "x" ] rel with
      | Error _ -> assert false
      | Ok result -> assert (result.Relation.constraints <> None));
      (* Project to only "y", constraint referencing "x" should be dropped *)
      match Algebra.Memory.project storage [ "y" ] rel with
      | Error _ -> assert false
      | Ok result -> assert (result.Relation.constraints = None))

(* Parse tests use canonical flat sexp format: (Constructor (field val) ...) *)

let%test_unit "ddl: parse CreateDatabase" =
  match Ddl.Parser.of_string {|(CreateDatabase "shop")|} with
  | Error _ -> assert false
  | Ok stmt -> assert (stmt = Ddl.Ast.CreateDatabase "shop")

let%test_unit "ddl: parse RetractRelation" =
  match Ddl.Parser.of_string {|(RetractRelation "users")|} with
  | Error _ -> assert false
  | Ok stmt -> assert (stmt = Ddl.Ast.RetractRelation "users")

let%test_unit "ddl: parse ClearRelation" =
  match Ddl.Parser.of_string {|(ClearRelation "users")|} with
  | Error _ -> assert false
  | Ok stmt -> assert (stmt = Ddl.Ast.ClearRelation "users")

let%test_unit "dml: round-trip InsertTuple" =
  let src =
    Dml.Ast.InsertTuple
      {
        relation = "users";
        attributes = [ ("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30) ];
      }
  in
  match Dml.Parser.of_string (Dml.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "ddl: round-trip CreateRelation" =
  let src =
    Ddl.Ast.CreateRelation
      { name = "users"; schema = [ ("name", "string"); ("age", "natural") ] }
  in
  match Ddl.Parser.of_string (Ddl.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "dml: round-trip InsertTuples" =
  let src =
    Dml.Ast.InsertTuples
      {
        relation = "users";
        tuples =
          [
            [ ("name", Drl.Ast.Str "Alice"); ("age", Drl.Ast.Int 30) ];
            [ ("name", Drl.Ast.Str "Bob"); ("age", Drl.Ast.Int 25) ];
          ];
      }
  in
  match Dml.Parser.of_string (Dml.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "ddl: round-trip RegisterDomain" =
  let src =
    Ddl.Ast.RegisterDomain { name = "money"; cardinality = Ddl.Ast.AlephZero }
  in
  match Ddl.Parser.of_string (Ddl.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

(* Executor tests construct AST directly, no dependency on sexp format *)

let%test_unit "ddl: execute CreateDatabase" =
  with_storage (fun storage ->
      let db = Management.Database.empty ~name:"" in
      let stmt = Ddl.Ast.CreateDatabase "shop" in
      match Ddl.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok (db, _msg) -> assert (db.name = "shop"))

let%test_unit "ddl: execute CreateRelation" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let stmt =
        Ddl.Ast.CreateRelation
          {
            name = "users";
            schema = [ ("name", "string"); ("age", "natural") ];
          }
      in
      match Ddl.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok (db, _msg) -> assert (Management.Database.has_relation db "users"))

let%test_unit "dml: execute InsertTuple" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let stmt =
        Dml.Ast.InsertTuple
          { relation = "users"; attributes = [ ("name", Drl.Ast.Str "Alice") ] }
      in
      match Dml.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok db ->
          let rel =
            match Management.Database.get_relation db "users" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count rel = 1))

let%test_unit "dml: execute InsertTuples" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let stmt =
        Dml.Ast.InsertTuples
          {
            relation = "users";
            tuples =
              [
                [ ("name", Drl.Ast.Str "Alice") ];
                [ ("name", Drl.Ast.Str "Bob") ];
              ];
          }
      in
      match Dml.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok db ->
          let rel =
            match Management.Database.get_relation db "users" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count rel = 2))

let%test_unit "dml: execute DeleteTuple" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "users";
                 attributes = [ ("name", Drl.Ast.Str "Alice") ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let stmt =
        Dml.Ast.DeleteTuple
          { relation = "users"; attributes = [ ("name", Drl.Ast.Str "Alice") ] }
      in
      match Dml.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok db ->
          let rel =
            match Management.Database.get_relation db "users" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count rel = 0))

let%test_unit "ddl: execute RetractRelation" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let schema = Schema.empty in
      let db =
        match
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      match
        Ddl.Executor.Memory.execute storage db (Ddl.Ast.RetractRelation "users")
      with
      | Error _ -> assert false
      | Ok (db, _msg) ->
          assert (not (Management.Database.has_relation db "users")))

let%test_unit "ddl: execute ClearRelation" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"users" ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuples
               {
                 relation = "users";
                 tuples =
                   [
                     [ ("name", Drl.Ast.Str "Alice") ];
                     [ ("name", Drl.Ast.Str "Bob") ];
                   ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      match
        Ddl.Executor.Memory.execute storage db (Ddl.Ast.ClearRelation "users")
      with
      | Error _ -> assert false
      | Ok (db, _msg) ->
          let rel =
            match Management.Database.get_relation db "users" with
            | None -> assert false
            | Some r -> r
          in
          assert (Memory.tuple_count rel = 0))

let%test_unit "ddl: execute RegisterDomain" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let stmt =
        Ddl.Ast.RegisterDomain
          { name = "money"; cardinality = Ddl.Ast.AlephZero }
      in
      match Ddl.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok (db, _msg) -> assert (Management.Database.has_domain db "money"))

let%test_unit "dml: insert into nonexistent relation returns error" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let stmt =
        Dml.Ast.InsertTuple
          { relation = "ghost"; attributes = [ ("x", Drl.Ast.Int 1) ] }
      in
      match Dml.Executor.Memory.execute storage db stmt with
      | Error (Dml.Executor.Memory.RelationNotFound "ghost") -> ()
      | _ -> assert false)

let%test_unit "dcl: round-trip RegisterConstraint MemberOf" =
  let src =
    Icl.Ast.RegisterConstraint
      {
        constraint_name = "fk_order";
        relation_name = "order_items";
        body =
          Icl.Ast.MemberOf
            {
              target = "orders";
              binding = [ ("order_id", Icl.Ast.Var "order_id") ];
            };
      }
  in
  match Icl.Parser.of_string (Icl.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "dcl: round-trip And constraint" =
  let src =
    Icl.Ast.RegisterConstraint
      {
        constraint_name = "valid_range";
        relation_name = "scores";
        body =
          Icl.Ast.And
            [
              Icl.Ast.MemberOf
                {
                  target = "ge_zero";
                  binding =
                    [
                      ("left", Icl.Ast.Var "score");
                      ("right", Icl.Ast.Const (Drl.Ast.Int 0));
                    ];
                };
              Icl.Ast.MemberOf
                {
                  target = "le_hundred";
                  binding =
                    [
                      ("left", Icl.Ast.Var "score");
                      ("right", Icl.Ast.Const (Drl.Ast.Int 100));
                    ];
                };
            ];
      }
  in
  match Icl.Parser.of_string (Icl.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "dcl: round-trip Not constraint" =
  let src =
    Icl.Ast.RegisterConstraint
      {
        constraint_name = "not_closed";
        relation_name = "open_ticket";
        body =
          Icl.Ast.Not
            {
              body =
                Icl.Ast.MemberOf
                  {
                    target = "closed_ticket";
                    binding = [ ("ticket_id", Icl.Ast.Var "ticket_id") ];
                  };
              universe = "open_ticket";
            };
      }
  in
  match Icl.Parser.of_string (Icl.Parser.to_string src) with
  | Error _ -> assert false
  | Ok parsed -> assert (parsed = src)

let%test_unit "dcl: execute RegisterConstraint attaches constraint" =
  with_storage (fun storage ->
      let db =
        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
          Memory.create_relation storage db ~name:"order_items"
            ~schema
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let stmt =
        Icl.Ast.RegisterConstraint
          {
            constraint_name = "fk_order";
            relation_name = "order_items";
            body =
              Icl.Ast.MemberOf
                {
                  target = "orders";
                  binding = [ ("order_id", Icl.Ast.Var "order_id") ];
                };
          }
      in
      match Icl.Executor.Memory.execute storage db stmt with
      | Error _ -> assert false
      | Ok (db, _) ->
          let rel =
            match Management.Database.get_relation db "order_items" with
            | None -> assert false
            | Some r -> r
          in
          assert (rel.Relation.constraints <> None))

let%test_unit "dcl: FK constraint enforced on insert" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"shop" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"orders"
            ~schema:(Schema.empty |> Schema.add "id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      (* Insert a valid order *)
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               { relation = "orders"; attributes = [ ("id", Drl.Ast.Int 1) ] })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"order_items"
            ~schema:(Schema.empty |> Schema.add "order_id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      (* Register FK: order_id in order_items must match id in orders *)
      let db =
        match
          Icl.Executor.Memory.execute storage db
            (Icl.Ast.RegisterConstraint
               {
                 constraint_name = "fk_order";
                 relation_name = "order_items";
                 body =
                   Icl.Ast.MemberOf
                     {
                       target = "orders";
                       binding = [ ("id", Icl.Ast.Var "order_id") ];
                     };
               })
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      (* Valid insert: order_id=1 exists in orders *)
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "order_items";
                 attributes = [ ("order_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let rel =
        match Management.Database.get_relation db "order_items" with
        | None -> assert false
        | Some r -> r
      in
      assert (Memory.tuple_count rel = 1);
      (* Invalid insert: order_id=99 does not exist in orders *)
      match
        Dml.Executor.Memory.execute storage db
          (Dml.Ast.InsertTuple
             {
               relation = "order_items";
               attributes = [ ("order_id", Drl.Ast.Int 99) ];
             })
      with
      | Error
          (Dml.Executor.Memory.ManipulationError
             (Error.ConstraintViolation _)) ->
          ()
      | _ -> assert false)

module BranchMemory = Management.Branch.Make (Management.Physical.Memory)

let%test_unit "branch: create and get_tip" =
  with_storage (fun storage ->
      let tip = "deadbeef" in
      (match BranchMemory.create storage ~name:"main" ~tip with
      | Error _ -> assert false
      | Ok () -> ());
      match BranchMemory.get_tip storage "main" with
      | Error _ -> assert false
      | Ok None -> assert false
      | Ok (Some t) -> assert (t = tip))

let%test_unit "branch: get_tip returns None for unknown branch" =
  with_storage (fun storage ->
      match BranchMemory.get_tip storage "nonexistent" with
      | Error _ -> assert false
      | Ok None -> ()
      | Ok (Some _) -> assert false)

let%test_unit "branch: checkout and get_head" =
  with_storage (fun storage ->
      (match BranchMemory.create storage ~name:"main" ~tip:"abc" with
      | Error _ -> assert false
      | Ok () -> ());
      (match BranchMemory.checkout storage "main" with
      | Error _ -> assert false
      | Ok () -> ());
      match BranchMemory.get_head storage with
      | Error _ -> assert false
      | Ok None -> assert false
      | Ok (Some h) -> assert (h = "main"))

let%test_unit "branch: get_head returns None when not set" =
  with_storage (fun storage ->
      match BranchMemory.get_head storage with
      | Error _ -> assert false
      | Ok None -> ()
      | Ok (Some _) -> assert false)

let%test_unit "branch: update_tip advances the branch" =
  with_storage (fun storage ->
      (match BranchMemory.create storage ~name:"main" ~tip:"v1" with
      | Error _ -> assert false
      | Ok () -> ());
      (match BranchMemory.update_tip storage ~name:"main" ~tip:"v2" with
      | Error _ -> assert false
      | Ok () -> ());
      match BranchMemory.get_tip storage "main" with
      | Error _ -> assert false
      | Ok None -> assert false
      | Ok (Some t) -> assert (t = "v2"))

let%test_unit "branch: update_tip fails on unknown branch" =
  with_storage (fun storage ->
      match BranchMemory.update_tip storage ~name:"ghost" ~tip:"v1" with
      | Error _ -> ()
      | Ok () -> assert false)

let%test_unit "branch: multiple branches are independent" =
  with_storage (fun storage ->
      (match BranchMemory.create storage ~name:"main" ~tip:"hash-main" with
      | Error _ -> assert false
      | Ok () -> ());
      (match
         BranchMemory.create storage ~name:"feature" ~tip:"hash-feature"
       with
      | Error _ -> assert false
      | Ok () -> ());
      let main_tip =
        match BranchMemory.get_tip storage "main" with
        | Ok (Some t) -> t
        | _ -> assert false
      in
      let feat_tip =
        match BranchMemory.get_tip storage "feature" with
        | Ok (Some t) -> t
        | _ -> assert false
      in
      assert (main_tip = "hash-main");
      assert (feat_tip = "hash-feature");
      assert (main_tip <> feat_tip))

let%test_unit "diff: identical databases produce empty diff" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let diffs = Management.Diff.diff ~ancestor:db ~target:db in
      assert (diffs = []))

let%test_unit "diff: added relation detected" =
  with_storage (fun storage ->
      let ancestor =
        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
          Memory.create_relation storage ancestor ~name:"new_rel"
            ~schema
        with
        | Error _ -> assert false
        | Ok p -> p
      in
      let diffs = Management.Diff.diff ~ancestor ~target in
      let added =
        List.filter_map
          (function Management.Diff.RelationAdded r -> Some r | _ -> None)
          diffs
      in
      assert (List.exists (fun r -> r.Relation.name = "new_rel") added))

let%test_unit "diff: removed relation detected" =
  with_storage (fun storage ->
      let schema = Schema.empty |> Schema.add "x" "natural" in
      let ancestor =
        match Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let ancestor, _ =
        match
          Memory.create_relation storage ancestor ~name:"gone"
            ~schema
        with
        | Error _ -> assert false
        | Ok p -> p
      in
      let target =
        match
          Memory.retract_relation storage ancestor ~name:"gone"
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let diffs = Management.Diff.diff ~ancestor ~target in
      let removed =
        List.filter_map
          (function Management.Diff.RelationRemoved n -> Some n | _ -> None)
          diffs
      in
      assert (List.mem "gone" removed))

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 Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let ancestor, _ =
        match
          Memory.create_relation storage ancestor ~name:"r" ~schema
        with
        | Error _ -> assert false
        | Ok p -> p
      in
      let rel = Option.get (Management.Database.get_relation ancestor "r") in
      let t : Tuple.materialized =
        {
          Tuple.relation = "r";
          attributes =
            Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 42 };
        }
      in
      let target, _, _ =
        match Memory.create_tuple storage ancestor rel t with
        | Error _ -> assert false
        | Ok p -> p
      in
      let diffs = Management.Diff.diff ~ancestor ~target in
      assert (List.length diffs = 1);
      match diffs with
      | [
       Management.Diff.RelationModified
         { name; added_tuples; removed_tuples; _ };
      ] ->
          assert (name = "r");
          assert (List.length added_tuples = 1);
          assert (removed_tuples = [])
      | _ -> assert false)

module MergeMemory =
  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 Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let base_db, _ =
        match
          Memory.create_relation storage base_db ~name:"r" ~schema
        with
        | Error _ -> assert false
        | Ok p -> p
      in
      (match Memory.store_database storage base_db with
      | Error _ -> assert false
      | Ok () -> ());
      let rel = Option.get (Management.Database.get_relation base_db "r") in
      let t1 : Tuple.materialized =
        {
          Tuple.relation = "r";
          attributes =
            Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 1 };
        }
      in
      let left_db, _, _ =
        match Memory.create_tuple storage base_db rel t1 with
        | Error _ -> assert false
        | Ok p -> p
      in
      (match Memory.store_database storage left_db with
      | Error _ -> assert false
      | Ok () -> ());
      match
        MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft
          ~left_tip:left_db.Management.Database.hash
          ~right_tip:base_db.Management.Database.hash
      with
      | Error _ -> assert false
      | Ok (Management.Merge.Failed _) -> assert false
      | Ok (Management.Merge.Clean merged) ->
          let merged_rel =
            Option.get (Management.Database.get_relation merged "r")
          in
          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 Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let base_db, _ =
        match
          Memory.create_relation storage base_db ~name:"r" ~schema
        with
        | Error _ -> assert false
        | Ok p -> p
      in
      (match Memory.store_database storage base_db with
      | Error _ -> assert false
      | Ok () -> ());
      let rel = Option.get (Management.Database.get_relation base_db "r") in
      let t_left : Tuple.materialized =
        {
          Tuple.relation = "r";
          attributes =
            Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 10 };
        }
      in
      let left_db, _, _ =
        match Memory.create_tuple storage base_db rel t_left with
        | Error _ -> assert false
        | Ok p -> p
      in
      (match Memory.store_database storage left_db with
      | Error _ -> assert false
      | Ok () -> ());
      let t_right : Tuple.materialized =
        {
          Tuple.relation = "r";
          attributes =
            Tuple.AttributeMap.singleton "val" { Attribute.value = Obj.repr 20 };
        }
      in
      let right_db, _, _ =
        match Memory.create_tuple storage base_db rel t_right with
        | Error _ -> assert false
        | Ok p -> p
      in
      (match Memory.store_database storage right_db with
      | Error _ -> assert false
      | Ok () -> ());
      match
        MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft
          ~left_tip:left_db.Management.Database.hash
          ~right_tip:right_db.Management.Database.hash
      with
      | Error _ -> assert false
      | Ok (Management.Merge.Failed _) -> assert false
      | Ok (Management.Merge.Clean merged) ->
          let merged_rel =
            Option.get (Management.Database.get_relation merged "r")
          in
          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 Memory.create_database storage ~name:"db" with
        | Error _ -> assert false
        | Ok db -> db
      in
      (match Memory.store_database storage base_db with
      | Error _ -> assert false
      | Ok () -> ());
      match
        MergeMemory.merge ~storage ~strategy:Management.Merge.PreferLeft
          ~left_tip:base_db.Management.Database.hash
          ~right_tip:base_db.Management.Database.hash
      with
      | Error _ -> assert false
      | Ok (Management.Merge.Failed _) -> assert false
      | Ok (Management.Merge.Clean merged) ->
          assert (
            Management.Database.get_relation_names merged
            = Management.Database.get_relation_names base_db))

(* Helper: look up polarity for a relation name in the result map *)
let find_polarity name pols = Constraint.polarity_find name pols

let%test_unit "polarity: MemberOf target is Positive" =
  let c =
    Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }
  in
  assert (
    find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive)

let%test_unit "polarity: Not MemberOf flips to Negative" =
  let c =
    Constraint.Not
      {
        body =
          Constraint.MemberOf
            { target = "R"; binding = Constraint.BindingMap.empty };
        universe = "U";
      }
  in
  assert (
    find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Negative)

let%test_unit "polarity: Exists quantifier is Positive" =
  let c =
    Constraint.Exists
      {
        variable = "x";
        quantifier = "Q";
        body =
          Constraint.MemberOf
            { target = "Q"; binding = Constraint.BindingMap.empty };
      }
  in
  assert (
    find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Positive)

let%test_unit "polarity: Forall quantifier is Negative" =
  let c =
    Constraint.Forall
      {
        variable = "x";
        quantifier = "Q";
        body =
          Constraint.MemberOf
            { target = "T"; binding = Constraint.BindingMap.empty };
      }
  in
  assert (
    find_polarity "Q" (Constraint.polarity_of c) = Some Constraint.Negative);
  assert (
    find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive)

let%test_unit "polarity: same relation with both polarities merges to Both" =
  (* Not(MemberOf R) AND MemberOf R => R appears Negative and Positive => Both *)
  let c =
    Constraint.And
      [
        Constraint.Not
          {
            body =
              Constraint.MemberOf
                { target = "R"; binding = Constraint.BindingMap.empty };
            universe = "U";
          };
        Constraint.MemberOf
          { target = "R"; binding = Constraint.BindingMap.empty };
      ]
  in
  assert (find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Both)

let%test_unit "polarity: Forall body MemberOf keeps Positive" =
  (* Forall x in Q, MemberOf(T): T still has positive polarity *)
  let c =
    Constraint.Forall
      {
        variable = "x";
        quantifier = "Q";
        body =
          Constraint.MemberOf
            { target = "T"; binding = Constraint.BindingMap.empty };
      }
  in
  assert (
    find_polarity "T" (Constraint.polarity_of c) = Some Constraint.Positive)

let%test_unit "polarity: nested Not double-negation restores Positive" =
  let c =
    Constraint.Not
      {
        body =
          Constraint.Not
            {
              body =
                Constraint.MemberOf
                  { target = "R"; binding = Constraint.BindingMap.empty };
              universe = "U";
            };
        universe = "V";
      }
  in
  assert (
    find_polarity "R" (Constraint.polarity_of c) = Some Constraint.Positive)

let%test_unit "polarity: unrelated relation absent from result" =
  let c =
    Constraint.MemberOf { target = "R"; binding = Constraint.BindingMap.empty }
  in
  assert (find_polarity "S" (Constraint.polarity_of c) = None)

let abs i = Obj.magic (i : int) (* lift int to AbstractValue for tests *)

let%test_unit
    "focused_filter: Var binding maps deleted value to constrained attr" =
  (* Constraint: MemberOf Dept (dept_id = Var "dept_id")
     Deleted:    Dept { dept_id = 99 }
     Expected filter: [("dept_id", 99)]

     This is the core FK pattern. The Var "dept_id" in the binding says:
     "the constrained tuple's dept_id must equal whatever the Dept tuple's
     dept_id is." When we delete Dept{dept_id=99}, focused_filter resolves
     the Var to the deleted value and returns [("dept_id", 99)].

     The cascade checker uses this to scan only Employee tuples where
     dept_id=99 rather than re-checking every Employee row. *)
  let binding =
    Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id")
  in
  let c = Constraint.MemberOf { target = "Dept"; binding } in
  let deleted = [ ("dept_id", abs 99) ] in
  let filter = Constraint.focused_filter c "Dept" deleted in
  assert (List.length filter = 1);
  assert (fst (List.hd filter) = "dept_id");
  assert (Stdlib.( = ) (snd (List.hd filter)) (abs 99))

let%test_unit "focused_filter: Const binding is ignored (no var link)" =
  (* Constraint: MemberOf Dept (code = Const "eng")
     Deleted:    Dept { code = "eng" }
     Expected filter: []

     A Const binding is a fixed literal that restricts which rows the constraint
     *applies to*: it is not a join condition. There is no Var, so no link
     exists between the deleted tuple's attributes and the attributes of any
     constrained relation. focused_filter correctly returns [] here.

     [] does NOT mean "nothing is affected." It means "no tighter filter could
     be derived": the caller must fall back to re-checking every tuple in the
     constrained relation. The tempting but wrong reading would be to see
     that the deleted value "eng" matches Const "eng" and emit [("code","eng")].
     Doing so would conflate a constraint literal with a join variable. *)
  let binding =
    Constraint.BindingMap.singleton "code"
      (Constraint.Const (Obj.magic ("eng" : string)))
  in
  let c = Constraint.MemberOf { target = "Dept"; binding } in
  let filter =
    Constraint.focused_filter c "Dept" [ ("code", Obj.magic ("eng" : string)) ]
  in
  assert (filter = [])

let%test_unit "focused_filter: Exists body MemberOf same relation is followed" =
  (* Constraint on Employee: Exists d in Dept, MemberOf Dept (dept_id = Var "dept_id")
     Deleted: Dept { dept_id = 7 }
     Expected filter on Employee: [("dept_id", 7)]

     Real FK constraints are wrapped in Exists: "there exists a dept d such
     that this employee's dept_id matches d's dept_id." The dep_rel ("Dept")
     appears as the Exists quantifier, not directly in a top-level MemberOf.

     focused_filter must recognise this pattern and recurse into the Exists
     body to find the Var binding. If it stopped at the Exists node and
     returned [], the cascade checker would lose the narrowing and fall back
     to scanning every Employee, defeating the optimisation entirely. *)
  let binding =
    Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id")
  in
  let c =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Dept";
        body = Constraint.MemberOf { target = "Dept"; binding };
      }
  in
  let filter = Constraint.focused_filter c "Dept" [ ("dept_id", abs 7) ] in
  assert (List.length filter = 1);
  assert (fst (List.hd filter) = "dept_id")

let%test_unit "focused_filter: unrelated dep_rel yields empty filter" =
  (* Constraint references relation R. We are deleting from relation S.
     Expected filter: []

     If the deleted relation does not appear anywhere in the constraint,
     the deletion cannot possibly affect any constrained tuple since no join
     variable links them. The cascade checker uses [] as a signal to skip
     the re-check for this constraint entirely, not to re-check everything. *)
  let binding = Constraint.BindingMap.singleton "x" (Constraint.Var "x") in
  let c = Constraint.MemberOf { target = "R"; binding } in
  let filter = Constraint.focused_filter c "S" [ ("x", abs 1) ] in
  assert (filter = [])

let%test_unit "trigger_constants: Const value in binding is extracted" =
  (* Constraint: MemberOf R (status = Const "active")
     Expected constants: [("status", "active")]

     trigger_constants answers: "for a DELETE from dep_rel to even risk
     violating this constraint, what attribute values must the deleted tuple
     have?" A Const binding says the constraint only applies when the dep_rel
     tuple has that exact value. If the deleted tuple's status ≠ "active",
     this constraint can never be violated by that deletion, so it is skipped.

     The cascade checker calls trigger_constants before doing any tuple scan
     and bails out early if the deleted tuple doesn't match. *)
  let binding =
    Constraint.BindingMap.singleton "status"
      (Constraint.Const (Obj.magic ("active" : string)))
  in
  let c = Constraint.MemberOf { target = "R"; binding } in
  let consts = Constraint.trigger_constants c "R" in
  assert (List.length consts = 1);
  assert (fst (List.hd consts) = "status")

let%test_unit "trigger_constants: Var binding produces no constant" =
  (* Constraint: MemberOf R (id = Var "id")
     Expected constants: []

     A Var binding imposes no fixed-value precondition on the deleted tuple.
     It is a join variable, not a filter. Any deleted tuple from R could
     match a constrained tuple via the Var link, so no early-exit is possible.
     [] means: always proceed to the cascade scan. *)
  let binding = Constraint.BindingMap.singleton "id" (Constraint.Var "id") in
  let c = Constraint.MemberOf { target = "R"; binding } in
  let consts = Constraint.trigger_constants c "R" in
  assert (consts = [])

let%test_unit "trigger_constants: unrelated dep_rel yields empty" =
  (* Constraint references relation R. We are deleting from relation S.
     Expected constants: []

     When dep_rel does not appear in the constraint at all, trigger_constants
     returns [], meaning no precondition was found so the cascade scan proceeds. However,
     focused_filter will also return [] for an unrelated dep_rel, causing the
     cascade checker to skip the re-check for a different reason (no join
     link). Both [] cases ultimately mean no affected tuples are found. *)
  let binding =
    Constraint.BindingMap.singleton "x" (Constraint.Const (abs 1))
  in
  let c = Constraint.MemberOf { target = "R"; binding } in
  let consts = Constraint.trigger_constants c "S" in
  assert (consts = [])

let%test_unit
    "substitute_transition: Var \"variable.attr\" is replaced by Const from \
     transition tuple" =
  (* Constraint: Exists d in Department, MemberOf Target (key = Var "d.dept_id")
     Transition: Department row { dept_id = 99 }
     After substitution: Exists d in Department, MemberOf Target (key = Const 99)
     The namespaced Var "d.dept_id" (quantifier-scoped) is replaced;
     a base-tuple Var "dept_id" would not be. *)
  let c =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body =
          Constraint.MemberOf
            {
              target = "Target";
              binding =
                Constraint.BindingMap.singleton "key"
                  (Constraint.Var "d.dept_id");
            };
      }
  in
  let result =
    Constraint.substitute_transition c "Department" [ ("dept_id", abs 99) ]
  in
  match result with
  | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> (
      match Constraint.BindingMap.find_opt "key" binding with
      | Some (Constraint.Const v) -> assert (Stdlib.( = ) v (abs 99))
      | _ -> assert false)
  | _ -> assert false

let%test_unit "substitute_transition: base-tuple Var is not substituted" =
  (* Constraint: Exists d in Department, MemberOf Target (key = Var "dept_id")
     Var "dept_id" is a base-tuple reference (no "d." prefix), so it must
     survive substitution unchanged. Only "d.dept_id" would be replaced. *)
  let c =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body =
          Constraint.MemberOf
            {
              target = "Target";
              binding =
                Constraint.BindingMap.singleton "key" (Constraint.Var "dept_id");
            };
      }
  in
  let result =
    Constraint.substitute_transition c "Department" [ ("dept_id", abs 99) ]
  in
  match result with
  | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> (
      match Constraint.BindingMap.find_opt "key" binding with
      | Some (Constraint.Var "dept_id") -> ()
      | _ -> assert false)
  | _ -> assert false

let%test_unit
    "substitute_transition: non-matching quantifier relation is unchanged" =
  (* Constraint: Exists d in Department, MemberOf Target (key = Var "d.dept_id")
     Transition is for relation "Other", not "Department".
     The body must survive unmodified. *)
  let c =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body =
          Constraint.MemberOf
            {
              target = "Target";
              binding =
                Constraint.BindingMap.singleton "key"
                  (Constraint.Var "d.dept_id");
            };
      }
  in
  let result =
    Constraint.substitute_transition c "Other" [ ("dept_id", abs 99) ]
  in
  match result with
  | Constraint.Exists { body = Constraint.MemberOf { binding; _ }; _ } -> (
      match Constraint.BindingMap.find_opt "key" binding with
      | Some (Constraint.Var "d.dept_id") -> ()
      | _ -> assert false)
  | _ -> assert false

let%test_unit "substitute_transition: substitution applies through And and Not"
    =
  (* Constraint:
       Exists d in Department,
         And [
           MemberOf A (x = Var "d.x");
           Not { MemberOf B (y = Var "d.y"); universe = "B" }
         ]
     Transition: { x = 1, y = 2 }
     After substitution: Var "d.x" -> Const 1, Var "d.y" -> Const 2 *)
  let c =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body =
          Constraint.And
            [
              Constraint.MemberOf
                {
                  target = "A";
                  binding =
                    Constraint.BindingMap.singleton "x" (Constraint.Var "d.x");
                };
              Constraint.Not
                {
                  universe = "B";
                  body =
                    Constraint.MemberOf
                      {
                        target = "B";
                        binding =
                          Constraint.BindingMap.singleton "y"
                            (Constraint.Var "d.y");
                      };
                };
            ];
      }
  in
  let result =
    Constraint.substitute_transition c "Department"
      [ ("x", abs 1); ("y", abs 2) ]
  in
  match result with
  | Constraint.Exists
      {
        body =
          Constraint.And
            [
              Constraint.MemberOf { binding = b1; _ };
              Constraint.Not
                { body = Constraint.MemberOf { binding = b2; _ }; _ };
            ];
        _;
      } -> (
      match
        ( Constraint.BindingMap.find_opt "x" b1,
          Constraint.BindingMap.find_opt "y" b2 )
      with
      | Some (Constraint.Const v1), Some (Constraint.Const v2) ->
          assert (Stdlib.( = ) v1 (abs 1));
          assert (Stdlib.( = ) v2 (abs 2))
      | _ -> assert false)
  | _ -> assert false

(* Build a minimal db with two relations and an FK constraint:
   Department { dept_id }  <--  Employee { emp_id, dept_id }
   Constraint on Employee: Exists d in Department, MemberOf Department (dept_id = Var "dept_id") *)
let setup_fk_db storage =
  let db =
    match Memory.create_database storage ~name:"hr" with
    | Error _ -> assert false
    | Ok db -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Department"
        ~schema:(Schema.empty |> Schema.add "dept_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Employee"
        ~schema:
          (Schema.empty
          |> Schema.add "emp_id" "natural"
          |> Schema.add "dept_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let fk_body =
    let binding =
      Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id")
    in
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body = Constraint.MemberOf { target = "Department"; binding };
      }
  in
  let db =
    match
      Memory.register_constraint storage db
        ~constraint_name:"fk_dept" ~relation_name:"Employee" ~body:fk_body
    with
    | Error _ -> assert false
    | Ok db -> db
  in
  db

let%test_unit
    "extend_tuple namespacing: insert Employee with non-existent dept_id is \
     rejected" =
  (* Regression test for the extend_tuple namespacing bug.
     Without namespacing, extend_tuple would overwrite the Employee's dept_id=99
     with the Department row's dept_id=1 during Exists iteration.  Var "dept_id"
     would then resolve to 1, check_membership would succeed, and the insertion
     would be accepted despite dept_id=99 not existing in Department.
     With namespacing, Department attributes are stored as d.dept_id=1 and the
     base Employee attribute dept_id=99 is preserved, so the check correctly fails. *)
  with_storage (fun storage ->
      let db = setup_fk_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      match
        Dml.Executor.Memory.execute storage db
          (Dml.Ast.InsertTuple
             {
               relation = "Employee";
               attributes =
                 [ ("emp_id", Drl.Ast.Int 1); ("dept_id", Drl.Ast.Int 99) ];
             })
      with
      | Ok _ -> assert false (* dept_id=99 does not exist in Department *)
      | Error _ -> ())

let%test_unit "cascade: delete referenced row violates FK and is rejected" =
  with_storage (fun storage ->
      let db = setup_fk_db storage in
      (* Insert Dept 1 and Employee referencing it *)
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let dept_rel =
        match Memory.get_relation db ~name:"Department" with
        | None -> assert false
        | Some r -> r
      in
      let dept_hash =
        Hashing.hash_tuple
          {
            Tuple.relation = "Department";
            attributes =
              Tuple.AttributeMap.singleton "dept_id"
                { Attribute.value = Obj.magic (1 : int) };
          }
      in
      (* Deleting Dept 1 while Employee references it must fail *)
      match
        Memory.retract_tuple storage db dept_rel
          ~tuple_hash:dept_hash
      with
      | Ok _ -> assert false (* should have been rejected *)
      | Error (Error.ConstraintViolation msg) ->
          assert (String.length msg > 0)
      | Error _ -> assert false)

let%test_unit "cascade: delete unreferenced row succeeds" =
  with_storage (fun storage ->
      let db = setup_fk_db storage in
      (* Insert two departments; employee only references dept 1 *)
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 2) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let dept_rel =
        match Memory.get_relation db ~name:"Department" with
        | None -> assert false
        | Some r -> r
      in
      let dept2_hash =
        Hashing.hash_tuple
          {
            Tuple.relation = "Department";
            attributes =
              Tuple.AttributeMap.singleton "dept_id"
                { Attribute.value = Obj.magic (2 : int) };
          }
      in
      (* Deleting unreferenced Dept 2 must succeed *)
      match
        Memory.retract_tuple storage db dept_rel
          ~tuple_hash:dept2_hash
      with
      | Error _ -> assert false
      | Ok (new_db, _) ->
          let dept =
            match
              Memory.get_relation new_db ~name:"Department"
            with
            | None -> assert false
            | Some r -> r
          in
          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"))
     Blacklist has Negative polarity (INSERT into Blacklist could violate).
     DELETE from Blacklist should never trigger a cascade check. *)
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"hr" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"Blacklist"
            ~schema:(Schema.empty |> Schema.add "emp_id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"Employee"
            ~schema:(Schema.empty |> Schema.add "emp_id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let not_body =
        let binding =
          Constraint.BindingMap.singleton "emp_id" (Constraint.Var "emp_id")
        in
        Constraint.Not
          {
            body = Constraint.MemberOf { target = "Blacklist"; binding };
            universe = "Employee";
          }
      in
      let db =
        match
          Memory.register_constraint storage db
            ~constraint_name:"not_blacklisted" ~relation_name:"Employee"
            ~body:not_body
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Insert emp_id=5 into Blacklist, then insert emp_id=99 into Employee (unrelated) *)
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Blacklist";
                 attributes = [ ("emp_id", Drl.Ast.Int 5) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes = [ ("emp_id", Drl.Ast.Int 99) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let bl_rel =
        match Memory.get_relation db ~name:"Blacklist" with
        | None -> assert false
        | Some r -> r
      in
      let bl_hash =
        Hashing.hash_tuple
          {
            Tuple.relation = "Blacklist";
            attributes =
              Tuple.AttributeMap.singleton "emp_id"
                { Attribute.value = Obj.magic (5 : int) };
          }
      in
      (* Deleting from Blacklist (negative polarity) must not trigger cascade check *)
      match
        Memory.retract_tuple storage db bl_rel ~tuple_hash:bl_hash
      with
      | Error _ -> assert false
      | Ok _ -> ())

let%test_unit "cascade: deferred constraint not checked during retract_tuple" =
  with_storage (fun storage ->
      let db =
        match Memory.create_database storage ~name:"hr" with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"Department"
            ~schema:(Schema.empty |> Schema.add "dept_id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let db =
        match
          Memory.create_relation storage db ~name:"Employee"
            ~schema:
              (Schema.empty
              |> Schema.add "emp_id" "natural"
              |> Schema.add "dept_id" "natural")
        with
        | Error _ -> assert false
        | Ok (db, _) -> db
      in
      let fk_body =
        let binding =
          Constraint.BindingMap.singleton "dept_id" (Constraint.Var "dept_id")
        in
        Constraint.Exists
          {
            variable = "d";
            quantifier = "Department";
            body = Constraint.MemberOf { target = "Department"; binding };
          }
      in
      (* Register as DEFERRED *)
      let db =
        match
          Memory.attach_constraint storage db
            ~constraint_name:"fk_dept_deferred" ~relation_name:"Employee"
            ~body:fk_body ~timing:Constraint.Deferred
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let dept_rel =
        match Memory.get_relation db ~name:"Department" with
        | None -> assert false
        | Some r -> r
      in
      let dept_hash =
        Hashing.hash_tuple
          {
            Tuple.relation = "Department";
            attributes =
              Tuple.AttributeMap.singleton "dept_id"
                { Attribute.value = Obj.magic (1 : int) };
          }
      in
      (* Deferred: retract_tuple itself should NOT reject the deletion *)
      match
        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
            Memory.check_deferred_constraints storage new_db
          with
          | Ok () -> assert false (* should have caught the violation *)
          | Error (Error.ConstraintViolation _) -> ()
          | Error _ -> assert false))

(* INSERT cascade tests.

   Schema:
     Blacklist { emp_id }
     Employee  { emp_id }

   Constraint on Employee (negative polarity on Blacklist):
     Not { body = MemberOf Blacklist (emp_id = Var "emp_id"); universe = "Employee" }

   Blacklist has Negative polarity in this constraint, so inserting into Blacklist
   must trigger a re-check of Employee tuples. *)
let setup_blacklist_db storage =
  let db =
    match Memory.create_database storage ~name:"hr" with
    | Error _ -> assert false
    | Ok db -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Blacklist"
        ~schema:(Schema.empty |> Schema.add "emp_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Employee"
        ~schema:(Schema.empty |> Schema.add "emp_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let not_body =
    Constraint.Not
      {
        body =
          Constraint.MemberOf
            {
              target = "Blacklist";
              binding =
                Constraint.BindingMap.singleton "emp_id"
                  (Constraint.Var "emp_id");
            };
        universe = "Employee";
      }
  in
  match
    Memory.register_constraint storage db
      ~constraint_name:"not_blacklisted" ~relation_name:"Employee"
      ~body:not_body
  with
  | Error _ -> assert false
  | Ok db -> db

let%test_unit
    "cascade INSERT: inserting into Blacklist violates constraint on existing \
     Employee" =
  (* Employee emp_id=5 already exists. Inserting Blacklist{emp_id=5} must be
     rejected because the Employee constraint (NOT member of Blacklist) would
     be violated for the existing emp_id=5 row. *)
  with_storage (fun storage ->
      let db = setup_blacklist_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes = [ ("emp_id", Drl.Ast.Int 5) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      match
        Dml.Executor.Memory.execute storage db
          (Dml.Ast.InsertTuple
             {
               relation = "Blacklist";
               attributes = [ ("emp_id", Drl.Ast.Int 5) ];
             })
      with
      | Ok _ -> assert false (* emp_id=5 exists in Employee, must be rejected *)
      | Error _ -> ())

let%test_unit
    "cascade INSERT: inserting into Blacklist with no matching Employee \
     succeeds" =
  (* Employee emp_id=99 does not exist. Inserting Blacklist{emp_id=5} must
     succeed because no Employee tuple is affected. *)
  with_storage (fun storage ->
      let db = setup_blacklist_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes = [ ("emp_id", Drl.Ast.Int 99) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      match
        Dml.Executor.Memory.execute storage db
          (Dml.Ast.InsertTuple
             {
               relation = "Blacklist";
               attributes = [ ("emp_id", Drl.Ast.Int 5) ];
             })
      with
      | Error _ -> assert false (* emp_id=5 not in Employee, must succeed *)
      | Ok _ -> ())

(* commit tests.

   Uses the same Department/Employee FK schema with a DEFERRED constraint.
   Individual mutations succeed even when they temporarily violate the constraint;
   commit is the boundary where deferred violations are caught. *)
let setup_deferred_fk_db storage =
  let db =
    match Memory.create_database storage ~name:"hr" with
    | Error _ -> assert false
    | Ok db -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Department"
        ~schema:(Schema.empty |> Schema.add "dept_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let db =
    match
      Memory.create_relation storage db ~name:"Employee"
        ~schema:
          (Schema.empty
          |> Schema.add "emp_id" "natural"
          |> Schema.add "dept_id" "natural")
    with
    | Error _ -> assert false
    | Ok (db, _) -> db
  in
  let fk_body =
    Constraint.Exists
      {
        variable = "d";
        quantifier = "Department";
        body =
          Constraint.MemberOf
            {
              target = "Department";
              binding =
                Constraint.BindingMap.singleton "dept_id"
                  (Constraint.Var "dept_id");
            };
      }
  in
  match
    Memory.attach_constraint storage db ~constraint_name:"fk_dept"
      ~relation_name:"Employee" ~body:fk_body ~timing:Constraint.Deferred
  with
  | Error _ -> assert false
  | Ok db -> db

let%test_unit "commit: no deferred constraints, returns Ok with db unchanged" =
  with_storage (fun storage ->
      let db = setup_deferred_fk_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* All constraints satisfied, commit must pass *)
      match Memory.commit storage db with
      | Error _ -> assert false
      | Ok _ -> ())

let%test_unit "commit: deferred violation is caught at commit boundary" =
  with_storage (fun storage ->
      let db = setup_deferred_fk_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let dept_rel =
        match Memory.get_relation db ~name:"Department" with
        | None -> assert false
        | Some r -> r
      in
      let dept_hash =
        Hashing.hash_tuple
          {
            Tuple.relation = "Department";
            attributes =
              Tuple.AttributeMap.singleton "dept_id"
                { Attribute.value = Obj.magic (1 : int) };
          }
      in
      (* Delete the referenced department. Deferred, so retract succeeds *)
      let db =
        match
          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 Memory.commit storage db with
      | Ok _ -> assert false
      | Error (Error.ConstraintViolation _) -> ()
      | Error _ -> assert false)

let%test_unit "commit: clears deferred list, second commit passes" =
  (* After a successful commit the deferred list is empty.
     A follow-up mutation + commit on the returned db must also work correctly
     rather than re-running stale entries from the previous window. *)
  with_storage (fun storage ->
      let db = setup_deferred_fk_db storage in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Department";
                 attributes = [ ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match
          Dml.Executor.Memory.execute storage db
            (Dml.Ast.InsertTuple
               {
                 relation = "Employee";
                 attributes =
                   [ ("emp_id", Drl.Ast.Int 10); ("dept_id", Drl.Ast.Int 1) ];
               })
        with
        | Error _ -> assert false
        | Ok db -> db
      in
      let db =
        match Memory.commit storage db with
        | Error _ -> assert false
        | Ok db -> db
      in
      (* Second commit with no new mutations must also pass *)
      match Memory.commit storage db with
      | Error _ -> assert false
      | Ok _ -> ())