kernel(overlay): ordered layer-merge algebra with diagnostics

add/suppress/replace/field-edit folded in order, last writer wins per field,
empty the identity. A directive naming an unknown slug, or adding one that
already exists, yields a diagnostic rather than silence or a hard failure:
overlays must survive a shifted base while still surfacing authoring errors.

1 files changed, 100 insertions, 1 deletions

diff --git a/test/test_overlay.ml b/test/test_overlay.ml
index b3a8f26..1b42eaf 100644
--- a/test/test_overlay.ml
+++ b/test/test_overlay.ml
@@ -111,6 +111,96 @@ let test_layer_load_invalid_slug () =
       | Ok _ -> Alcotest.fail "expected Error for an invalid slug"
       | Error _ -> ())
 
+module O = Colitur_kernel.Overlay
+module N = Colitur_kernel.Names
+module Lang = Colitur_kernel.Lang
+module Cit = Colitur_kernel.Citation
+
+let ov id directives = { O.id; directives }
+
+let rank_of l s = match L.find l (slug s) with
+  | Some e -> Some e.L.cel.Cel.rank | None -> None
+
+let test_empty_is_identity () =
+  let l = base () in
+  let l', diags = O.apply l O.empty in
+  Alcotest.(check bool) "layer unchanged" true (l' = l);
+  Alcotest.(check int) "no diagnostics" 0 (List.length diags)
+
+let test_add_and_suppress () =
+  let l = base () in
+  let l', _ = O.apply l (ov "o" [ O.Add (entry ~month:2 ~day:2 "candlemas") ]) in
+  Alcotest.(check bool) "added" true (L.mem l' (slug "candlemas"));
+  let l'', _ = O.apply l' (ov "o" [ O.Suppress (slug "candlemas") ]) in
+  Alcotest.(check bool) "suppressed" false (L.mem l'' (slug "candlemas"))
+
+(* Order matters, and this test pins which way. *)
+let test_order_matters () =
+  let l = base () in
+  let add = O.Add (entry ~month:2 ~day:2 "candlemas") in
+  let sup = O.Suppress (slug "candlemas") in
+  let a, _ = O.apply l (ov "o" [ add; sup ]) in
+  Alcotest.(check bool) "add then suppress -> absent" false (L.mem a (slug "candlemas"));
+  let b, _ = O.apply l (ov "o" [ sup; add ]) in
+  Alcotest.(check bool) "suppress then add -> present" true (L.mem b (slug "candlemas"))
+
+let test_edit_is_field_scoped () =
+  let l = base () in
+  let before = match L.find l (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in
+  let l', _ = O.apply l (ov "o" [ O.Edit (slug "hilary", [ O.Set_colour Col.Red ]) ]) in
+  let after = match L.find l' (slug "hilary") with Some e -> e | None -> Alcotest.fail "missing" in
+  Alcotest.(check bool) "colour changed" true (after.L.cel.Cel.colour = Col.Red);
+  Alcotest.(check bool) "every other field untouched" true
+    ({ after with L.cel = { after.L.cel with Cel.colour = before.L.cel.Cel.colour } } = before)
+
+let test_last_writer_wins () =
+  let l = base () in
+  let l', _ =
+    O.apply l (ov "o" [ O.Edit (slug "hilary", [ O.Set_rank Class1 ]);
+                        O.Edit (slug "hilary", [ O.Set_rank Class3 ]) ])
+  in
+  Alcotest.(check bool) "second edit wins" true (rank_of l' "hilary" = Some Class3)
+
+let test_diagnostics () =
+  let l = base () in
+  let _, diags =
+    O.apply l (ov "o" [ O.Suppress (slug "nobody");
+                        O.Edit (slug "nobody", [ O.Set_colour Col.Red ]);
+                        O.Add (entry ~month:1 ~day:14 "hilary") ])
+  in
+  (* unknown suppress, unknown edit, and add-over-existing: three, none silent *)
+  Alcotest.(check int) "three diagnostics" 3 (List.length diags);
+  Alcotest.(check bool) "add-over-existing still applied (last writer wins)" true
+    (L.mem (fst (O.apply l (ov "o" [ O.Add (entry ~month:1 ~day:14 "hilary") ]))) (slug "hilary"))
+
+let test_merge_order () =
+  let l = base () in
+  let l', _ =
+    O.merge l [ ov "a" [ O.Edit (slug "hilary", [ O.Set_rank Class1 ]) ];
+                ov "b" [ O.Edit (slug "hilary", [ O.Set_rank Class3 ]) ] ]
+  in
+  Alcotest.(check bool) "later overlay wins" true (rank_of l' "hilary" = Some Class3)
+
+let test_overlay_sexp () =
+  let o = ov "o" [ O.Edit (slug "hilary", [ O.Set_colour Col.Red ]);
+                   O.Suppress (slug "telesphorus") ] in
+  let sexp = O.sexp_of_t sexp_of_rank o in
+  Alcotest.(check bool) "roundtrip" true (O.t_of_sexp rank_of_sexp sexp = o)
+
+(* Property: applying the same overlay twice to the same layer is deterministic. *)
+let prop_deterministic =
+  QCheck.Test.make ~name:"overlay apply is deterministic" QCheck.(list (int_range 0 3))
+    (fun ops ->
+      let directive = function
+        | 0 -> O.Add (entry ~month:3 ~day:3 "extra")
+        | 1 -> O.Suppress (slug "hilary")
+        | 2 -> O.Edit (slug "hilary", [ O.Set_colour Col.Red ])
+        | _ -> O.Edit (slug "telesphorus", [ O.Set_rank Class1 ])
+      in
+      let o = ov "p" (List.map directive ops) in
+      let a, da = O.apply (base ()) o and b, db = O.apply (base ()) o in
+      a = b && da = db)
+
 let suite =
   ( "Layer/Overlay",
     [ Alcotest.test_case "layer basics" `Quick test_layer_basics;
@@ -121,4 +211,13 @@ let suite =
       Alcotest.test_case "layer load success round-trip" `Quick test_layer_load_success;
       Alcotest.test_case "layer load missing file" `Quick test_layer_load_missing_file;
       Alcotest.test_case "layer load malformed sexp" `Quick test_layer_load_malformed;
-      Alcotest.test_case "layer load invalid slug" `Quick test_layer_load_invalid_slug ] )
+      Alcotest.test_case "layer load invalid slug" `Quick test_layer_load_invalid_slug;
+      Alcotest.test_case "empty is identity" `Quick test_empty_is_identity;
+      Alcotest.test_case "add and suppress" `Quick test_add_and_suppress;
+      Alcotest.test_case "order matters" `Quick test_order_matters;
+      Alcotest.test_case "edit is field-scoped" `Quick test_edit_is_field_scoped;
+      Alcotest.test_case "last writer wins" `Quick test_last_writer_wins;
+      Alcotest.test_case "diagnostics" `Quick test_diagnostics;
+      Alcotest.test_case "merge order" `Quick test_merge_order;
+      Alcotest.test_case "overlay sexp" `Quick test_overlay_sexp ]
+    @ List.map QCheck_alcotest.to_alcotest [ prop_deterministic ] )