aboutsummaryrefslogtreecommitdiffstats
path: root/lib/management/database.ml
diff options
context:
space:
mode:
authorMarcos Magueta <maguetamarcos@gmail.com>2026-03-08 20:48:14 -0300
committerMarcos Magueta <maguetamarcos@gmail.com>2026-03-08 20:48:14 -0300
commitcce3bfba31b32c13ea116a214306d96fe1eb27eb (patch)
treea572e969d7c53686e047764b7fba3e52d3589215 /lib/management/database.ml
parent88dc315e454a695426becf928aef46668f9db0dc (diff)
downloadSakura-cce3bfba31b32c13ea116a214306d96fe1eb27eb.tar.gz
Sakura-cce3bfba31b32c13ea116a214306d96fe1eb27eb.zip
format todos and comment improvement
Diffstat (limited to '')
-rw-r--r--lib/management/database.ml67
1 files changed, 20 insertions, 47 deletions
diff --git a/lib/management/database.ml b/lib/management/database.ml
index 08e03b8..2dc0ae6 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -1,12 +1,10 @@
-(** Database state management.
+(** 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. *)
- A database is a collection of relations with:
- - A merkle tree of relation hashes (for integrity verification)
- - A map of relation names to their actual Relation.t objects (integrated cache)
- - A history of previous database hashes (for time-travel queries)
-
- All mutations produce a new database state with a new hash.
- The history chain allows reconstruction of any past state. *)
+(* 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)
@@ -14,8 +12,8 @@ type t = {
hash : Conventions.Hash.t;
name : Conventions.Name.t;
tree : Merkle.t;
- relations : Relation.t RelationMap.t; (* Stores actual relations, not just hashes *)
- domains : Domain.t RelationMap.t; (* Domain registry: prelude + user-defined *)
+ relations : Relation.t RelationMap.t;
+ domains : Domain.t RelationMap.t;
history : Conventions.Hash.t list;
timestamp : float;
}
@@ -30,13 +28,11 @@ let empty ~name = {
timestamp = Unix.gettimeofday ();
}
-(** Compute database hash from the merkle tree root *)
let compute_hash db =
match Merkle.root_hash db.tree with
| Some root -> root
| None -> Conventions.Hash.hash_text db.name
-(** Update database with new relations map and tree *)
let update_state db ~relations ~tree =
let new_hash =
match Merkle.root_hash tree with
@@ -44,21 +40,11 @@ let update_state db ~relations ~tree =
| 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 ();
- }
-
-(** Get a relation by name *)
-let get_relation db name =
- RelationMap.find_opt name db.relations
-
-(** Get a relation's hash by name *)
+ { 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
@@ -67,10 +53,11 @@ let get_relation_hash db name =
let get_relation_names db =
RelationMap.fold (fun name _ acc -> name :: acc) db.relations []
-let has_relation db name =
- RelationMap.mem name db.relations
+let has_relation db name = RelationMap.mem name db.relations
-(** Add a relation to the database *)
+(* 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
@@ -83,7 +70,6 @@ let add_relation db ~(relation : Relation.t) =
let relations = RelationMap.add relation.name relation db.relations in
update_state db ~relations ~tree
-(** Remove a relation from the database *)
let remove_relation db ~name =
match RelationMap.find_opt name db.relations with
| None -> db
@@ -93,11 +79,10 @@ let remove_relation db ~name =
let relations = RelationMap.remove name db.relations in
update_state db ~relations ~tree
-(** Update a relation in the database (after tuple insert/delete) *)
let update_relation db ~(relation : Relation.t) =
let name = relation.name in
match RelationMap.find_opt name db.relations with
- | None -> db (* Relation doesn't exist, no-op *)
+ | None -> db
| Some old_relation ->
let old_hash = Option.get old_relation.hash in
let new_hash = Option.get relation.hash in
@@ -105,27 +90,15 @@ let update_relation db ~(relation : Relation.t) =
let relations = RelationMap.add name relation db.relations in
update_state db ~relations ~tree
-(* ============================================================================
- Domain Registry - prelude and user-defined domains
- ============================================================================ *)
-
-(** Register a domain in the database. Overwrites any existing domain with
- the same name, allowing user-defined domains to shadow prelude ones. *)
let add_domain db (domain : Domain.t) =
{ db with domains = RelationMap.add domain.name domain db.domains }
-(** Look up a domain by name *)
-let get_domain db name =
- RelationMap.find_opt name db.domains
+let get_domain db name = RelationMap.find_opt name db.domains
-(** List all registered domain names *)
let get_domain_names db =
RelationMap.fold (fun name _ acc -> name :: acc) db.domains []
-(** Check whether a domain is registered *)
-let has_domain db name =
- RelationMap.mem name db.domains
+let has_domain db name = RelationMap.mem name db.domains
-(** Remove a domain from the registry *)
let remove_domain db name =
{ db with domains = RelationMap.remove name db.domains }