1 files changed, 43 insertions, 33 deletions

diff --git a/lib/management/database.ml b/lib/management/database.ml
index c4c6dc3..f4d18e8 100644
--- a/lib/management/database.ml
+++ b/lib/management/database.ml
@@ -1,12 +1,12 @@
 (** 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. *)
+    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)
+module RelationMap = Map.Make (String)
 
 type deferred_entry = {
   relation_name : string;
@@ -25,16 +25,17 @@ type t = {
   deferred : deferred_entry list;
 }
 
-let empty ~name = {
-  hash = "";
-  name;
-  tree = Merkle.empty;
-  relations = RelationMap.empty;
-  domains = RelationMap.empty;
-  history = [];
-  timestamp = Unix.gettimeofday ();
-  deferred = [];
-}
+let empty ~name =
+  {
+    hash = "";
+    name;
+    tree = Merkle.empty;
+    relations = RelationMap.empty;
+    domains = RelationMap.empty;
+    history = [];
+    timestamp = Unix.gettimeofday ();
+    deferred = [];
+  }
 
 let compute_hash db =
   match Merkle.root_hash db.tree with
@@ -44,8 +45,8 @@ let compute_hash db =
 let max_history = 128
 
 let rec take_at_most n = function
-  | []      -> []
-  | _  when n = 0 -> []
+  | [] -> []
+  | _ when n = 0 -> []
   | x :: xs -> x :: take_at_most (n - 1) xs
 
 let update_state db ~relations ~tree =
@@ -58,9 +59,16 @@ let update_state db ~relations ~tree =
     if db.hash = "" then db.history
     else take_at_most max_history (db.hash :: db.history)
   in
-  { hash = new_hash; name = db.name; tree; relations;
-    domains = db.domains; history; timestamp = Unix.gettimeofday ();
-    deferred = db.deferred }
+  {
+    hash = new_hash;
+    name = db.name;
+    tree;
+    relations;
+    domains = db.domains;
+    history;
+    timestamp = Unix.gettimeofday ();
+    deferred = db.deferred;
+  }
 
 let get_relation db name = RelationMap.find_opt name db.relations
 
@@ -74,16 +82,18 @@ let get_relation_names db =
 
 let has_relation db name = RelationMap.mem name db.relations
 
+let relation_hash_or_compute (relation : Relation.t) =
+  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
+
 (* 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_hash = relation_hash_or_compute relation 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
@@ -93,21 +103,21 @@ 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 relation_hash = relation_hash_or_compute relation 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 old_hash = relation_hash_or_compute old_relation in
+      let new_hash = relation_hash_or_compute relation 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 }