1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
|
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.vigil_feast = (fun _ -> None); 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:_ ~temporal:_ cs ->
List.filteri (fun i _ -> i < 2) cs |> List.map (fun (c, p, (_ : int)) -> (c, p))) }
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)
(* RG 111(a): sung_mass_commemorations -- see precedence.mli's own citation.
Pure function, no {!resolve} needed: exercised directly against
hand-built Low-Mass admitted lists, the same shape {!P.resolve} would
produce, rather than through a full resolution. *)
let sung_test_cand rank slug = cand ~rank slug
let test_sung_mass_no_privileged () =
let low_mass = [ (sung_test_cand Lo "a", P.Ordinary); (sung_test_cand Lo "b", P.Ordinary) ] in
Alcotest.(check (list string)) "no privileged commemoration -> sung Mass keeps none" []
(List.map (fun (c, _) -> slug_of c) (P.sung_mass_commemorations low_mass))
let test_sung_mass_one_privileged () =
let low_mass =
[ (sung_test_cand Lo "ordinary-one", P.Ordinary); (sung_test_cand Hi "privileged-one", P.Privileged) ]
in
Alcotest.(check (list string)) "the ordinary commemoration is dropped, the privileged one kept"
[ "privileged-one" ]
(List.map (fun (c, _) -> slug_of c) (P.sung_mass_commemorations low_mass))
let test_sung_mass_privileged_first_already () =
let low_mass =
[ (sung_test_cand Hi "privileged-one", P.Privileged); (sung_test_cand Lo "ordinary-one", P.Ordinary) ]
in
Alcotest.(check (list string)) "a privileged commemoration already first is kept alone" [ "privileged-one" ]
(List.map (fun (c, _) -> slug_of c) (P.sung_mass_commemorations low_mass))
let test_sung_mass_empty_low_mass_set () =
Alcotest.(check (list string)) "an empty Low-Mass set stays empty at Sung Mass" []
(List.map (fun (c, _) -> slug_of c) (P.sung_mass_commemorations []))
(* If two privileged commemorations were ever admitted together (not known
to occur on any shipped rite's data -- precedence.mli's own citation),
[sung_mass_commemorations] keeps only the FIRST -- input order is
already RG 113 precedence order, so this is "the highest-precedence
privileged entry survives", not an arbitrary truncation. *)
let test_sung_mass_two_privileged_keeps_first () =
let low_mass =
[ (sung_test_cand Hi "first-privileged", P.Privileged); (sung_test_cand Hi "second-privileged", P.Privileged) ]
in
Alcotest.(check (list string)) "only the first (higher-precedence) privileged commemoration survives"
[ "first-privileged" ]
(List.map (fun (c, _) -> slug_of c) (P.sung_mass_commemorations low_mass))
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;
Alcotest.test_case "RG 111(a): sung Mass, no privileged commemoration" `Quick
test_sung_mass_no_privileged;
Alcotest.test_case "RG 111(a): sung Mass keeps the one privileged commemoration" `Quick
test_sung_mass_one_privileged;
Alcotest.test_case "RG 111(a): sung Mass, privileged already first" `Quick
test_sung_mass_privileged_first_already;
Alcotest.test_case "RG 111(a): sung Mass, empty Low-Mass set" `Quick
test_sung_mass_empty_low_mass_set;
Alcotest.test_case "RG 111(a): sung Mass keeps only the first of two privileged" `Quick
test_sung_mass_two_privileged_keeps_first ] )
|
