aboutsummaryrefslogtreecommitdiff
path: root/test/test_precedence.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-12 11:38:35 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-12 11:38:35 +0200
commite19adb9c7ea369cafe76e7eff50e9248a4a954d0 (patch)
tree57824e121606286ebdf8fff68439986dd3300eae /test/test_precedence.ml
parent0506388da160a15ceddb0cea1a697d737103d5c4 (diff)
parent36df2bd0af9a555a09334e14b0d89118be1dbbc0 (diff)
downloadcolitur-e19adb9c7ea369cafe76e7eff50e9248a4a954d0.tar.gz
colitur-e19adb9c7ea369cafe76e7eff50e9248a4a954d0.zip
Merge branch 'ef-plan3': Plan 3, the EF resolution engine
Adds the rite-parameterised Precedence resolver, Liturgical_day, Rite, and Calendar (year as the primitive, because transfers need whole-year knowledge), the full EF precedence ruleset (RG 91's 28-entry table, occurrence RG 92-95, commemorations RG 108-111, transfers RG 96-98), 322 bootstrapped sanctoral entries, colitur day <year>, and validation layers 3-5. Layer 3 diffs 16801 days against lectio; layer 4 diffs 730 days against missalemeum; layer 5 pins ~30 dates on the known-tricky years. Both comparison layers carry cited allow-lists that name the governing RG paragraph and which engine is right. The oracle layer earned its place immediately: Holy Thursday was violet in colitur and lectio alike, because colitur's data was bootstrapped from lectio and both carried the same error. Only an independent source could see it. RG 128(b) and RG 122 name it white.
Diffstat (limited to 'test/test_precedence.ml')
-rw-r--r--test/test_precedence.ml108
1 files changed, 108 insertions, 0 deletions
diff --git a/test/test_precedence.ml b/test/test_precedence.ml
new file mode 100644
index 0000000..369c490
--- /dev/null
+++ b/test/test_precedence.ml
@@ -0,0 +1,108 @@
+module P = Colitur_kernel.Precedence
+module Cel = Colitur_kernel.Celebration
+module S = Colitur_kernel.Slug
+module Col = Colitur_kernel.Colour
+module D = Colitur_kernel.Date
+
+type rank = Hi | Lo [@@deriving sexp]
+type season = Green [@@deriving sexp]
+
+let cand ?(origin = P.Sanctoral) ?(status = Cel.Feast) ~rank slug =
+ { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~status ~colour:Col.White
+ ~layer:"base" (); origin }
+
+let ctx =
+ { P.date = (match D.make ~year:2026 ~month:7 ~day:15 with Ok d -> d | Error e -> failwith e);
+ season = Green; weekday = D.Wed }
+
+(* Band: Hi beats Lo. Temporal breaks a tie in its own favour. *)
+let rules =
+ { P.band = (fun _ c -> (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20)
+ - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0));
+ disposition =
+ (fun ~winner:_ ~loser ->
+ match loser.P.cel.Cel.status with
+ | Cel.Commemoration_only -> P.Commemorate P.Ordinary
+ | Cel.Feast -> (match loser.P.cel.Cel.rank with
+ | Hi -> P.Transfer
+ | Lo -> P.Commemorate P.Ordinary));
+ admit = (fun ~observed:_ cs -> List.filteri (fun i _ -> i < 2) cs) }
+
+let slug_of c = S.to_string c.P.cel.Cel.slug
+
+let test_highest_band_wins () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
+ ~sanctoral:[ cand ~rank:Hi "big-feast" ] in
+ Alcotest.(check string) "feast wins" "big-feast" (slug_of r.P.observed)
+
+let test_temporal_wins_a_tie () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
+ ~sanctoral:[ cand ~rank:Hi "saint" ] in
+ Alcotest.(check string) "temporal wins tie" "sunday" (slug_of r.P.observed)
+
+let test_loser_dispositions () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
+ ~sanctoral:[ cand ~rank:Hi "transferable"; cand ~rank:Lo "commemorated" ] in
+ Alcotest.(check (list string)) "deferred" [ "transferable" ]
+ (List.map slug_of r.P.deferred);
+ Alcotest.(check (list string)) "commemorated" [ "commemorated" ]
+ (List.map (fun (c, _) -> slug_of c) r.P.commemorations)
+
+(* A commemoration-only entry can never be observed, even at a winning band. *)
+let test_commemoration_only_never_observed () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
+ ~sanctoral:[ cand ~rank:Hi ~status:Cel.Commemoration_only "suppressed" ] in
+ Alcotest.(check string) "feria still observed" "feria" (slug_of r.P.observed);
+ Alcotest.(check (list string)) "suppressed commemorated" [ "suppressed" ]
+ (List.map (fun (c, _) -> slug_of c) r.P.commemorations)
+
+(* Anything the admit limit drops is recorded in `omitted`, never dropped silently
+ -- and each input candidate lands in exactly one bucket, not zero or two. *)
+let test_nothing_silently_lost () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Hi "sunday")
+ ~sanctoral:[ cand ~rank:Lo "a"; cand ~rank:Lo "b"; cand ~rank:Lo "c" ] in
+ let bucketed =
+ (slug_of r.P.observed
+ :: List.map (fun (c, _) -> slug_of c) r.P.commemorations)
+ @ List.map slug_of r.P.deferred
+ @ List.map (fun (c, _) -> slug_of c) r.P.omitted
+ in
+ Alcotest.(check (slist string compare)) "every candidate appears exactly once"
+ [ "a"; "b"; "c"; "sunday" ] bucketed;
+ Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations)
+
+(* The result must not depend on the order sanctoral candidates arrive in;
+ ties break on slug, not on list position. *)
+let test_order_independent () =
+ let a = cand ~rank:Lo "a" and b = cand ~rank:Lo "b" and c = cand ~rank:Lo "c" in
+ let t = cand ~origin:P.Temporal ~rank:Hi "sunday" in
+ let observed_for sanctoral = slug_of (P.resolve rules ctx ~temporal:t ~sanctoral).P.observed in
+ let comms_for sanctoral =
+ List.map (fun (x, _) -> slug_of x) (P.resolve rules ctx ~temporal:t ~sanctoral).P.commemorations
+ in
+ List.iter
+ (fun perm ->
+ Alcotest.(check string) "same observed" (observed_for [ a; b; c ]) (observed_for perm);
+ Alcotest.(check (list string)) "same commemorations" (comms_for [ a; b; c ]) (comms_for perm))
+ [ [ c; b; a ]; [ b; a; c ]; [ c; a; b ] ]
+
+(* The case the "pass temporal separately" design exists to make safe: a day
+ with no sanctoral candidate at all. *)
+let test_temporal_only_day () =
+ let r = P.resolve rules ctx ~temporal:(cand ~origin:P.Temporal ~rank:Lo "feria")
+ ~sanctoral:[] in
+ Alcotest.(check string) "feria observed" "feria" (slug_of r.P.observed);
+ Alcotest.(check int) "no commemorations" 0 (List.length r.P.commemorations);
+ Alcotest.(check int) "nothing deferred" 0 (List.length r.P.deferred);
+ Alcotest.(check int) "nothing omitted" 0 (List.length r.P.omitted)
+
+let suite =
+ ( "Precedence",
+ [ Alcotest.test_case "highest band wins" `Quick test_highest_band_wins;
+ Alcotest.test_case "temporal wins a tie" `Quick test_temporal_wins_a_tie;
+ Alcotest.test_case "loser dispositions" `Quick test_loser_dispositions;
+ Alcotest.test_case "commemoration-only never observed" `Quick
+ test_commemoration_only_never_observed;
+ Alcotest.test_case "nothing silently lost" `Quick test_nothing_silently_lost;
+ Alcotest.test_case "order independent" `Quick test_order_independent;
+ Alcotest.test_case "temporal-only day" `Quick test_temporal_only_day ] )