aboutsummaryrefslogtreecommitdiff
path: root/test/test_precedence_ef.ml
blob: fb055828d3e3ec02f346428ce136ce3a68f375bc (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
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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
(* RG 91's Table of Precedence, transcribed by Rite_ef.Precedence_ef.band.
   Table-driven, one row (hence one Alcotest.test_case) per RG 91 entry, so a
   misplaced or missing entry names itself in the failure output instead of
   failing anonymously (docs/research/rules-register.md §4). Each row's date
   is checked against the register to make sure it is not ALSO an instance of
   some other entry at the same band (the vacuous-test trap this project has
   caught before -- see the Advent-Ember-day note on entry 18 below). *)

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
module Sub = Colitur_kernel.Subject
module Comp = Colitur_kernel.Computus
module T = Rite_ef.Temporal_ef
module V = Rite_ef.Vocab_ef
module PE = Rite_ef.Precedence_ef

let mk y m dd = match D.make ~year:y ~month:m ~day:dd with Ok t -> t | Error e -> failwith e

(* [T.season] is the same function Calendar itself would use to build a
   context, so a row's [season]/[weekday] are exactly what the real engine
   would compute for that date, not a hand-picked value that might not
   actually occur together with it. *)
let ctx date = { P.date; season = T.season date; weekday = D.weekday date }

let cand ?(origin = P.Temporal) ?(rank = V.Class1) ?(subject = Sub.Temporal) ?(layer = "temporal")
    slug =
  { P.cel = Cel.make ~slug:(S.of_string_exn slug) ~rank ~colour:Col.White ~subject ~layer ();
    origin }

(* Every Easter-relative date below is anchored to this single computed
   Easter rather than a hand-typed calendar date, so an arithmetic slip in a
   test date cannot silently pass by accident. *)
let easter = Comp.gregorian_easter 2026
let off n = D.add_days easter n

(* (description, date, candidate, expected RG 91 entry). *)
let cases =
  [ (* Entry 1 -- register line 327: Nativity, Easter Sunday, Pentecost Sunday. *)
    ("1 Nativity", mk 2026 12 25, cand "ef-nativity", 1);
    ("1 Easter Sunday", off 0, cand "ef-easter-sunday", 1);
    ("1 Pentecost Sunday", off 49, cand "ef-pentecost", 1);
    (* Entry 2 -- register line 328: Sacred Triduum. Thu-Sat of Holy Week,
       NOT entry 7 (which stops at Wednesday -- see entry 7 below). *)
    ("2 Holy Thursday", off (-3), cand "ef-holy-thursday", 2);
    ("2 Good Friday", off (-2), cand "ef-good-friday", 2);
    ("2 Holy Saturday", off (-1), cand "ef-holy-saturday", 2);
    (* Entry 3 -- register line 329. *)
    ("3 Epiphany", mk 2026 1 6, cand "ef-epiphany", 3);
    ("3 Ascension", off 39, cand "ef-ascension", 3);
    ("3 Trinity", off 56, cand "ef-trinity", 3);
    ("3 Corpus Christi", off 60, cand "ef-corpus-christi", 3);
    ("3 Sacred Heart", off 68, cand "ef-sacred-heart", 3);
    ("3 Christ the King", T.christ_the_king 2026, cand "ef-christ-the-king", 3);
    (* Entry 4 -- register line 330. Sanctoral-origin: neither feast is part
       of temporal_ef's movable cycle. *)
    ( "4 Immaculate Conception", mk 2026 12 8,
      cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer
        "ef-immaculate-conception",
      4 );
    ("4 Assumption", mk 2026 8 15, cand ~origin:P.Sanctoral ~subject:Sub.Bvm ~layer:PE.universal_layer "ef-assumption", 4);
    (* Entry 5 -- register line 331. *)
    ("5 Nativity Vigil", mk 2026 12 24, cand "ef-nativity-vigil", 5);
    ("5 Octave day (Circumcision)", mk 2026 1 1, cand "ef-circumcision", 5);
    (* Entry 6 -- register line 332. *)
    ("6 Advent Sunday", T.advent_start 2026, cand "ef-advent-sunday-1", 6);
    ("6 Lent Sunday", off (-42), cand "ef-lent-sunday-1", 6);
    ("6 Passion Sunday (I Passiontide)", off (-14), cand "ef-passion-sunday", 6);
    ("6 Palm Sunday (II Passiontide)", off (-7), cand "ef-palm-sunday", 6);
    ("6 Low Sunday", off 7, cand "ef-low-sunday", 6);
    (* Entry 7 -- register line 333: Ash Wednesday and Mon/Tue/Wed of Holy
       Week ONLY -- Thu-Sat are entry 2 above, not this entry. *)
    ("7 Ash Wednesday", off (-46), cand "ef-ash-wednesday", 7);
    ("7 Monday of Holy Week", off (-6), cand "ef-holy-monday", 7);
    ("7 Tuesday of Holy Week", off (-5), cand "ef-holy-tuesday", 7);
    ("7 Wednesday of Holy Week", off (-4), cand "ef-holy-wednesday", 7);
    (* Entry 8 -- register line 334. *)
    ("8 All Souls", mk 2026 11 2, cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-all-souls", 8);
    (* Entry 9 -- register line 335. *)
    ("9 Pentecost Vigil", off 48, cand "ef-pentecost-vigil", 9);
    (* Entry 10 -- register line 336: both range boundaries, to guard the
       off-by-one an inclusive Easter-offset window invites. *)
    ("10 Easter octave, day+1", off 1, cand "ef-easter-1-mon", 10);
    ("10 Easter octave, day+6", off 6, cand "ef-easter-1-sat", 10);
    ("10 Pentecost octave, day+50", off 50, cand "ef-pentecost-1-mon", 10);
    ("10 Pentecost octave, day+55", off 55, cand "ef-pentecost-1-sat", 10);
    (* Entry 11 -- register line 337. *)
    ( "11 Universal I-class feast", mk 2026 6 29,
      cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:PE.universal_layer "ef-ss-peter-paul",
      11 );
    (* Entry 12 -- register line 338. The one non-base-layer case the brief
       asks for explicitly: same date/rank/subject as 11, only the layer
       differs, so this row isolates the layer test as the deciding factor. *)
    ( "12 Proper I-class feast (non-base layer)", mk 2026 6 29,
      cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:"diocese-warsaw" "ef-local-patron",
      12 );
    (* Entry 13 -- register line 339. *)
    ( "13 Indult I-class feast", mk 2026 6 29,
      cand ~origin:P.Sanctoral ~subject:Sub.Saint ~layer:(PE.indult_prefix ^ "local-grant")
        "ef-indult-feast-1",
      13 );
    (* Entry 14 -- register line 341. *)
    ( "14 Feast of the Lord, II class", mk 2026 7 1,
      cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Lord ~layer:PE.universal_layer
        "ef-precious-blood",
      14 );
    (* Entry 15 -- register line 342: an ordinary Sunday not named at entry 6
       -- Septuagesima is II class (RG 11-12 names only Advent/Lent/
       Passiontide/Easter/Low/Pentecost as I class). *)
    ("15 II-class Sunday (Septuagesima)", off (-63), cand ~rank:V.Class2 "ef-septuagesima-sunday", 15);
    (* Entry 16 -- register line 342. *)
    ( "16 Universal II-class feast, not of the Lord", mk 2026 1 20,
      cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:PE.universal_layer
        "ef-some-saint",
      16 );
    (* Entry 17 -- register line 343: days WITHIN the Nativity octave (26-28
       Dec are Stephen/John/Innocents -- sanctoral, not this entry; 1 Jan is
       entry 5's Octave DAY, not this entry either). *)
    ("17 Nativity octave, 29 Dec", mk 2026 12 29, cand ~rank:V.Class2 "ef-nativity-octave-day-5", 17);
    ("17 Nativity octave, 31 Dec", mk 2026 12 31, cand ~rank:V.Class2 "ef-nativity-octave-day-7", 17);
    (* Entry 18 -- register line 343-344: Advent 17-23 Dec ferias AND the
       Ember days of Advent/Lent/September share this one entry. The second
       row is deliberately a Lent date (season Lent, NOT Advent) to prove the
       Ember-slug path fires on its own, not merely because it also happens
       to fall in the Dec 17-23 window -- the exact trap the brief warns
       about, worked the other way round: this Ember day must NOT be
       mistaken for an ordinary entry-22 Lent feria either. *)
    ("18 Advent 17-23 Dec feria", mk 2026 12 21, cand ~rank:V.Class2 "ef-advent-4-mon", 18);
    ("18 Lent Ember Wednesday", off (-39), cand ~rank:V.Class2 "ef-lent-ember-wed", 18);
    (* Entry 19 -- register line 344. *)
    ( "19 Proper II-class feast", mk 2026 1 20,
      cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint ~layer:"diocese-warsaw"
        "ef-local-saint-2",
      19 );
    (* Entry 20 -- register line 345. *)
    ( "20 Indult II-class feast", mk 2026 1 20,
      cand ~origin:P.Sanctoral ~rank:V.Class2 ~subject:Sub.Saint
        ~layer:(PE.indult_prefix ^ "local-grant-2") "ef-indult-feast-2",
      20 );
    (* Entry 21 -- register line 345 (RG 28-34). Two rows: the Ascension
       Vigil is the one II-class vigil temporal_ef already produces today
       (temporal-origin); the Assumption Vigil stands in for the
       sanctoral-origin case no task has loaded data for yet -- proving
       [band] does not gate this entry on [origin] (see precedence_ef.ml's
       file comment). *)
    ("21 Ascension Vigil (temporal-origin)", off 38, cand ~rank:V.Class2 "ef-ascension-vigil", 21);
    ( "21 Assumption Vigil (sanctoral-origin)", mk 2026 8 14,
      cand ~origin:P.Sanctoral ~rank:V.Class2 ~layer:PE.universal_layer "ef-assumption-vigil",
      21 );
    (* Entry 22 -- register line 347-348 (corrected: ends at Palm Sunday, not
       Passion Sunday). Both a Lent and a Passiontide feria, clear of Ash
       Wednesday, Holy Week and the Ember days. *)
    ("22 Lent feria", off (-41), cand ~rank:V.Class3 "ef-lent-1-mon", 22);
    ("22 Passiontide feria", off (-12), cand ~rank:V.Class3 "ef-passiontide-1-tue", 22);
    (* Entry 23 -- register line 349. NOTE the table's own order here is the
       REVERSE of 11/12 and 14/16/19/20 above: entry 23 (particular
       calendars) is numbered BELOW entry 24 (universal), so a proper
       III-class feast outranks a universal one -- transcribed as the
       register states it, not "corrected" to match the other classes. *)
    ( "23 Proper III-class feast (non-base layer)", mk 2026 6 30,
      cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:"diocese-warsaw" "ef-local-saint-3",
      23 );
    (* Entry 24 -- register line 349. *)
    ( "24 Universal III-class feast", mk 2026 6 30,
      cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-some-saint-3",
      24 );
    (* Entry 25 -- register line 350. *)
    ("25 Advent feria to 16 Dec", mk 2026 12 1, cand ~rank:V.Class3 "ef-advent-1-tue", 25);
    (* Entry 26 -- register line 350. *)
    ( "26 III-class vigil", mk 2026 8 9,
      cand ~origin:P.Sanctoral ~rank:V.Class3 ~layer:PE.universal_layer "ef-lawrence-vigil",
      26 );
    (* Entry 27 -- register line 352: an otherwise-unoccupied IV-class
       Saturday. *)
    ( "27 Office of the BVM on Saturday", off 62,
      cand ~rank:V.Class4 "ef-time-after-pentecost-1-sat",
      27 );
    (* Entry 28 -- register line 352: the unqualified IV-class catch-all. *)
    ("28 IV-class feria", off 65, cand ~rank:V.Class4 "ef-time-after-pentecost-1-tue", 28);
    (* Not an RG 91 row at all: a I-class candidate marked as a vigil, which
       is not the Nativity or Pentecost (entries 5/9, the only I-class
       vigils the table names) and so has no entry to fall into. Proves the
       documented fallback -- not entry 11/12/13, which the [not is_vigil]
       guard exists specifically to keep this out of. *)
    ( "unclassified: I-class vigil outside Nativity/Pentecost", mk 2026 3 10,
      cand ~origin:P.Sanctoral ~layer:PE.universal_layer "ef-mystery-vigil",
      PE.unclassified );
    (* RG 91's own vigil list (register lines 381-384) stops at III class --
       there is no IV-class vigil for entry 28's ferial catch-all to absorb. *)
    ( "unclassified: IV-class candidate marked as a vigil", mk 2026 6 20,
      cand ~rank:V.Class4 "ef-second-mystery-vigil", PE.unclassified )
  ]

let suite =
  ( "Precedence_ef",
    List.map
      (fun (desc, date, c, expect) ->
        Alcotest.test_case desc `Quick (fun () ->
            Alcotest.(check int) desc expect (PE.band (ctx date) c)))
      cases )