blob: 39be06cde424b573f090d693fa44f23434b3747e (
plain) (
blame)
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
|
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. *)
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
Alcotest.(check int) "two admitted" 2 (List.length r.P.commemorations);
Alcotest.(check int) "one recorded as omitted" 1 (List.length r.P.omitted);
let total = 1 + List.length r.P.commemorations + List.length r.P.deferred
+ List.length r.P.omitted in
Alcotest.(check int) "every candidate accounted for" 4 total
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 ] )
|
