(** Database state: a named collection of relations with a Merkle tree over their hashes, a domain registry, and a history chain of prior hashes. All mutations produce a new value; no in-place update. *) (* TODO: history is an unbounded list of hashes; there is no way to reconstruct a past state from a hash alone without a separate snapshot store. Either cap the history or make it actually useful. *) module RelationMap = Map.Make(String) type t = { hash : Conventions.Hash.t; name : Conventions.Name.t; tree : Merkle.t; relations : Relation.t RelationMap.t; domains : Domain.t RelationMap.t; history : Conventions.Hash.t list; timestamp : float; } let empty ~name = { hash = ""; name; tree = Merkle.empty; relations = RelationMap.empty; domains = RelationMap.empty; history = []; timestamp = Unix.gettimeofday (); } let compute_hash db = match Merkle.root_hash db.tree with | Some root -> root | None -> Conventions.Hash.hash_text db.name let update_state db ~relations ~tree = let new_hash = match Merkle.root_hash tree with | Some root -> root | None -> Conventions.Hash.hash_text db.name in let history = if db.hash = "" then db.history else db.hash :: db.history in { hash = new_hash; name = db.name; tree; relations; domains = db.domains; history; timestamp = Unix.gettimeofday () } let get_relation db name = RelationMap.find_opt name db.relations let get_relation_hash db name = match RelationMap.find_opt name db.relations with | None -> None | Some rel -> rel.Relation.hash let get_relation_names db = RelationMap.fold (fun name _ acc -> name :: acc) db.relations [] let has_relation db name = RelationMap.mem name db.relations (* TODO: computing the hash here for hash:None relations (ephemeral/prelude) is a layering violation — callers should assign the hash before calling add_relation, not rely on this fallback. *) let add_relation db ~(relation : Relation.t) = let relation_hash = match relation.hash with | Some h -> h | None -> let tree = Option.value relation.tree ~default:Merkle.empty in Hashing.hash_relation ~name:relation.name ~schema:relation.schema ~tree in let relation = { relation with hash = Some relation_hash } in let tree = Merkle.insert relation_hash db.tree in let relations = RelationMap.add relation.name relation db.relations in update_state db ~relations ~tree let remove_relation db ~name = match RelationMap.find_opt name db.relations with | None -> db | Some relation -> let relation_hash = Option.get relation.hash in let tree = Merkle.delete relation_hash db.tree in let relations = RelationMap.remove name db.relations in update_state db ~relations ~tree let update_relation db ~(relation : Relation.t) = let name = relation.name in match RelationMap.find_opt name db.relations with | None -> db | Some old_relation -> let old_hash = Option.get old_relation.hash in let new_hash = Option.get relation.hash in let tree = db.tree |> Merkle.delete old_hash |> Merkle.insert new_hash in let relations = RelationMap.add name relation db.relations in update_state db ~relations ~tree let add_domain db (domain : Domain.t) = { db with domains = RelationMap.add domain.name domain db.domains } let get_domain db name = RelationMap.find_opt name db.domains let get_domain_names db = RelationMap.fold (fun name _ acc -> name :: acc) db.domains [] let has_domain db name = RelationMap.mem name db.domains let remove_domain db name = { db with domains = RelationMap.remove name db.domains }