summaryrefslogtreecommitdiff
path: root/test/test_temporal_of.ml
blob: 2522e44e67be3b872cc7e1f95c2901a74e0edab2 (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
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
(* Phase 1 of the OF rite module: Vocab_of + Temporal_of. Modelled on
   test_temporal_ef.ml's own shape (example-based unit tests for the named
   days and boundaries, QCheck properties for the domain-wide invariants),
   scoped to what Phase 1 actually delivers -- no Rite.t exists yet, so
   these properties are written directly against Temporal_of rather than
   through Colitur_kernel.Validate.run (which needs a full Rite.t bundle,
   Phase 2's own deliverable). *)

module V = Rite_of.Vocab_of
module T = Rite_of.Temporal_of
module D = Colitur_kernel.Date

let d y m dd = match D.make ~year:y ~month:m ~day:dd with Ok t -> t | Error e -> Alcotest.failf "%s" e
let iso = D.to_iso8601

(* ---- vocabulary ---- *)

let test_vocab_roundtrips () =
  List.iter
    (fun s -> Alcotest.(check bool) "season string roundtrip" true (V.season_of_string (V.season_to_string s) = Some s))
    V.seasons;
  List.iter
    (fun r -> Alcotest.(check bool) "rank string roundtrip" true (V.rank_of_string (V.rank_to_string r) = Some r))
    V.ranks;
  Alcotest.(check int) "five seasons" 5 (List.length V.seasons);
  Alcotest.(check int) "five ranks" 5 (List.length V.ranks)

(* ---- season boundaries (Normae n. 28/30/33/40/44 -- see temporal_of.ml's
   own citations) ---- *)

let season_str dt = V.season_to_string (T.season dt)

let test_advent_start () =
  Alcotest.(check string) "advent 2026" "2026-11-29" (iso (T.advent_start 2026));
  Alcotest.(check bool) "always a Sunday" true (D.weekday (T.advent_start 2026) = D.Sun)

let test_seasons () =
  (* Easter 2026 = 5 April; Ash Wednesday = 18 Feb; Palm Sunday = 29 Mar. *)
  Alcotest.(check string) "1 Dec 2026" "advent" (season_str (d 2026 12 1));
  Alcotest.(check string) "24 Dec 2026" "advent" (season_str (d 2026 12 24));
  Alcotest.(check string) "25 Dec 2026" "christmas" (season_str (d 2026 12 25));
  Alcotest.(check string) "1 Jan 2027 (Mary Mother of God)" "christmas" (season_str (d 2027 1 1));
  (* Baptism of the Lord 2027 = 10 Jan: Christmas Time runs through it inclusive. *)
  Alcotest.(check string) "10 Jan 2027 (Baptism Sunday)" "christmas" (season_str (d 2027 1 10));
  Alcotest.(check string) "11 Jan 2027 (Monday after Baptism)" "ordinary-time" (season_str (d 2027 1 11));
  Alcotest.(check string) "Ash Wed 18 Feb 2026" "lent" (season_str (d 2026 2 18));
  Alcotest.(check string) "Palm Sunday 29 Mar 2026" "lent" (season_str (d 2026 3 29));
  (* Normae n. 30 makes Holy Week Lent's own week VI: Holy Thursday, Good
     Friday and Holy Saturday all stay Lent (vocab_of.ml's own citation). *)
  Alcotest.(check string) "Holy Thursday 2 Apr 2026" "lent" (season_str (d 2026 4 2));
  Alcotest.(check string) "Good Friday 3 Apr 2026" "lent" (season_str (d 2026 4 3));
  Alcotest.(check string) "Holy Saturday 4 Apr 2026" "lent" (season_str (d 2026 4 4));
  Alcotest.(check string) "Easter 5 Apr 2026" "easter" (season_str (d 2026 4 5));
  Alcotest.(check string) "Pentecost 24 May 2026" "easter" (season_str (d 2026 5 24));
  Alcotest.(check string) "day after Pentecost 25 May 2026" "ordinary-time" (season_str (d 2026 5 25));
  Alcotest.(check string) "last Sunday before Advent, 22 Nov 2026" "ordinary-time" (season_str (d 2026 11 22))

(* ---- the three movable Christmas-time Sundays ---- *)

let test_baptism_of_the_lord () =
  Alcotest.(check string) "2026" "2026-01-11" (iso (T.baptism_of_the_lord 2026));
  Alcotest.(check string) "2027" "2027-01-10" (iso (T.baptism_of_the_lord 2027));
  Alcotest.(check string) "2024 (6 Jan is a Saturday)" "2024-01-07" (iso (T.baptism_of_the_lord 2024));
  (* 2030: 6 January itself is a Sunday. Normae n. 38 says "dominica POST
     diem 6 ianuarii" -- strictly after, never 6 January itself -- so the
     Baptism jumps a full week to 13 January, not 6. *)
  Alcotest.(check bool) "2030: 6 Jan is a Sunday" true (D.weekday (d 2030 1 6) = D.Sun);
  Alcotest.(check string) "2030 (Epiphany itself a Sunday)" "2030-01-13" (iso (T.baptism_of_the_lord 2030));
  Alcotest.(check bool) "always a Sunday" true (D.weekday (T.baptism_of_the_lord 2026) = D.Sun)

let test_holy_family () =
  Alcotest.(check string) "2026 (26 Dec is a Sunday)" "2026-12-27" (iso (T.holy_family 2026));
  (* 2022: no Sunday falls 26-31 December that year -- the n. 35(a) fallback,
     30 December, fires. *)
  Alcotest.(check bool) "2022: no Sunday 26-31 Dec"
    (List.for_all (fun dd -> D.weekday (d 2022 12 dd) <> D.Sun) [ 26; 27; 28; 29; 30; 31 ])
    true;
  Alcotest.(check string) "2022 fallback" "2022-12-30" (iso (T.holy_family 2022))

let test_second_sunday_of_christmas () =
  Alcotest.(check (option string)) "2026" (Some "2026-01-04") (Option.map iso (T.second_sunday_of_christmas 2026));
  (* 2024: Baptism is already 7 January (6 Jan a Saturday), so no Sunday
     falls in the 2-5 January window that year -- a genuine, uncovered
     [None], with no fallback in the primary text. *)
  Alcotest.(check (option string)) "2024 (none)" None (Option.map iso (T.second_sunday_of_christmas 2024))

let test_christ_the_king () =
  Alcotest.(check string) "2026" "2026-11-22" (iso (T.christ_the_king 2026));
  Alcotest.(check bool) "always a Sunday" true (D.weekday (T.christ_the_king 2026) = D.Sun);
  (* Normae n. 43's own heading (temporal_of.ml's own citation): always week 34. *)
  Alcotest.(check (option int)) "week 34" (Some 34) (T.week (T.christ_the_king 2026))

(* ---- named days ---- *)

let named_slug dt = match T.named dt with Some (_, slug, _, _) -> slug | None -> "<none>"
let named_colour dt = match T.named dt with Some (_, _, c, _) -> Some c | None -> None
let named_rank dt = match T.named dt with Some (_, _, _, r) -> Some r | None -> None

let test_named_feasts () =
  (* Easter 2026 = 5 April. *)
  Alcotest.(check string) "nativity vigil" "of-nativity-vigil" (named_slug (d 2026 12 24));
  Alcotest.(check string) "nativity" "of-nativity" (named_slug (d 2026 12 25));
  Alcotest.(check string) "mary mother of god" "of-mary-mother-of-god" (named_slug (d 2027 1 1));
  Alcotest.(check string) "epiphany" "of-epiphany" (named_slug (d 2027 1 6));
  Alcotest.(check string) "ash wednesday" "of-ash-wednesday" (named_slug (d 2026 2 18));
  Alcotest.(check string) "palm sunday" "of-palm-sunday" (named_slug (d 2026 3 29));
  Alcotest.(check string) "easter" "of-easter-sunday" (named_slug (d 2026 4 5));
  Alcotest.(check string) "ascension" "of-ascension" (named_slug (d 2026 5 14));
  Alcotest.(check string) "pentecost" "of-pentecost" (named_slug (d 2026 5 24));
  Alcotest.(check string) "trinity" "of-trinity" (named_slug (d 2026 5 31));
  Alcotest.(check string) "corpus christi" "of-corpus-christi" (named_slug (d 2026 6 4));
  Alcotest.(check string) "christ the king" "of-christ-the-king" (named_slug (d 2026 11 22));
  Alcotest.(check string) "an ordinary day is not named" "<none>" (named_slug (d 2026 7 15))

let test_named_colours_and_ranks () =
  (* IGMR 346(b): Palm/Passion Sunday and Pentecost are red, not their
     season's own colour. *)
  Alcotest.(check (option string)) "palm sunday is red" (Some "red")
    (Option.map Colitur_kernel.Colour.to_string (named_colour (d 2026 3 29)));
  Alcotest.(check (option string)) "pentecost is red" (Some "red")
    (Option.map Colitur_kernel.Colour.to_string (named_colour (d 2026 5 24)));
  Alcotest.(check (option string)) "nativity is white" (Some "white")
    (Option.map Colitur_kernel.Colour.to_string (named_colour (d 2026 12 25)));
  (* Ash Wednesday: rank Feria, not an elevated grade -- vocab_of.ml's own
     top-of-file argument for why OF's rank vocabulary keeps grade and
     precedence-table position separate, unlike EF's. *)
  Alcotest.(check (option string)) "ash wednesday is Feria" (Some "feria")
    (Option.map V.rank_to_string (named_rank (d 2026 2 18)));
  Alcotest.(check (option string)) "christmas is Sollemnitas" (Some "sollemnitas")
    (Option.map V.rank_to_string (named_rank (d 2026 12 25)))

let test_easter_octave () =
  (* Easter 2026 = 5 April; the octave's six weekdays are 6-11 April. *)
  Alcotest.(check string) "easter monday" "of-easter-octave-day-2" (named_slug (d 2026 4 6));
  Alcotest.(check string) "easter saturday" "of-easter-octave-day-7" (named_slug (d 2026 4 11));
  Alcotest.(check (option string)) "all octave weekdays are Sollemnitas white" (Some "sollemnitas white")
    (match T.named (d 2026 4 6) with
     | Some (_, _, c, r) -> Some (V.rank_to_string r ^ " " ^ Colitur_kernel.Colour.to_string c)
     | None -> None);
  (* The closing Sunday (12 Apr) is deliberately NOT in [named] -- it falls
     through to the generic Sunday-of-Easter slug, week 2. *)
  Alcotest.(check string) "closing Sunday is not in named" "<none>" (named_slug (d 2026 4 12));
  Alcotest.(check string) "closing Sunday's own slug" "of-easter-sunday-2"
    (match T.sunday_slug (d 2026 4 12) with Some s -> s | None -> "<none>")

(* ---- week numbering ---- *)

let test_week_numbers () =
  Alcotest.(check (option int)) "Advent I 2026" (Some 1) (T.week (T.advent_start 2026));
  Alcotest.(check (option int)) "Advent IV 2026" (Some 4) (T.week (D.add_days (T.advent_start 2026) 21));
  Alcotest.(check (option int)) "Christmas has no week" None (T.week (d 2026 12 27));
  (* Lent I Sunday = Easter - 42 = 2026-02-22; Ash Wednesday and the three
     days after it belong to no numbered week. *)
  Alcotest.(check (option int)) "Ash Wednesday has no week" None (T.week (d 2026 2 18));
  Alcotest.(check (option int)) "Lent I Sunday is week 1" (Some 1) (T.week (d 2026 2 22));
  (* Normae n. 30: Holy Week is Lent's own week VI. *)
  Alcotest.(check (option int)) "Palm Sunday is Lent week 6" (Some 6) (T.week (d 2026 3 29));
  Alcotest.(check (option int)) "Holy Saturday is Lent week 6" (Some 6) (T.week (d 2026 4 4));
  Alcotest.(check (option int)) "Easter Sunday is Easter week 1" (Some 1) (T.week (d 2026 4 5));
  Alcotest.(check (option int)) "Pentecost is Easter week 8" (Some 8) (T.week (d 2026 5 24))

(* ---- Ordinary Time's own resumption arithmetic: the hard part, pinned
   concretely (temporal_of.ml's own [ordinary_time_week] citation has the
   full derivation and its evidence). ---- *)

let test_ordinary_time_block_a () =
  (* 2026: Baptism Sunday 11 Jan is week 1's own origin; the Missale's own
     heading ("Dominica prima 'per annum' fit festum Baptismatis Domini")
     puts that Sunday itself at week 1, so the following Monday (12 Jan,
     the first day actually IN the Ordinary Time season) is ALSO week 1,
     and the next Sunday (18 Jan, "Dominica II 'per annum'") is week 2. *)
  Alcotest.(check (option int)) "12 Jan 2026 (Mon after Baptism) is week 1" (Some 1) (T.week (d 2026 1 12));
  Alcotest.(check (option int)) "18 Jan 2026 (Dominica II) is week 2" (Some 2) (T.week (d 2026 1 18));
  (* Ash Wednesday 2026 = 18 Feb; Shrove Tuesday (17 Feb) is block A's own
     last day, week 6. *)
  Alcotest.(check (option int)) "17 Feb 2026 (Shrove Tuesday) is week 6" (Some 6) (T.week (d 2026 2 17))

(* Every day of CIVIL year [y] -- deliberately not a liturgical-year walk
   ([T.year_start y] through [T.year_start (y + 1)]): that span crosses into
   the FOLLOWING civil year's January-onward Ordinary Time, governed by a
   DIFFERENT year's Easter, which would silently test the wrong year's own
   resumption arithmetic. *)
let civil_year_days y =
  let start = d y 1 1 in
  List.init (if Colitur_kernel.Date.is_leap y then 366 else 365) (fun i -> D.add_days start i)

let test_ordinary_time_resumption () =
  (* 2026: block A tops out at week 6; Pentecost is 24 May; the Monday
     after (25 May) resumes at week 8, SKIPPING week 7 entirely that
     year -- a concrete, verified instance of Normae n. 43's own "thirty-
     three OR thirty-four weeks". *)
  Alcotest.(check (option int)) "2026: 25 May (Mon after Pentecost) resumes at week 8" (Some 8)
    (T.week (d 2026 5 25));
  Alcotest.(check bool) "2026: Ordinary Time week 7 never occurs (Easter's own week 7, 17-23 May, is a
     different axis and does occur that year -- this checks only Ordinary-Time-season days)" true
    (List.for_all
       (fun dt -> T.season dt <> V.Ordinary_time || T.week dt <> Some 7)
       (civil_year_days 2026));
  (* 2024: block A tops out at week 6 (Ash Wed 14 Feb, Shrove Tue 13 Feb);
     Pentecost is 19 May; the Monday after (20 May) resumes at week 7 --
     NO skip that year, all 34 weeks used. *)
  Alcotest.(check (option int)) "2024: 13 Feb (Shrove Tuesday) is week 6" (Some 6) (T.week (d 2024 2 13));
  Alcotest.(check (option int)) "2024: 20 May (Mon after Pentecost) resumes at week 7" (Some 7)
    (T.week (d 2024 5 20));
  Alcotest.(check bool) "2024: every Ordinary Time week 1..34 occurs somewhere in civil 2024" true
    (let weeks =
       List.filter_map (fun dt -> if T.season dt = V.Ordinary_time then T.week dt else None) (civil_year_days 2024)
     in
     List.for_all (fun n -> List.mem n weeks) (List.init 34 (fun i -> i + 1)))

(* ---- Sunday and ferial slugs ---- *)

let sunday_slug_of dt = match T.sunday_slug dt with Some s -> s | None -> "<none>"
let slug_of dt = match T.temporal dt with t -> Colitur_kernel.Slug.to_string t.Colitur_kernel.Temporal.office.Colitur_kernel.Celebration.slug

let test_sunday_slugs () =
  Alcotest.(check string) "Advent I 2026" "of-advent-sunday-1" (sunday_slug_of (T.advent_start 2026));
  Alcotest.(check string) "Lent I 2026" "of-lent-sunday-1" (sunday_slug_of (d 2026 2 22));
  Alcotest.(check string) "18 Jan 2026 (Dominica II per annum)" "of-ordinary-time-sunday-2" (sunday_slug_of (d 2026 1 18));
  Alcotest.(check string) "holy family 2026" "of-holy-family" (sunday_slug_of (T.holy_family 2026));
  Alcotest.(check string) "baptism of the lord 2026" "of-baptism-of-the-lord" (sunday_slug_of (T.baptism_of_the_lord 2026));
  Alcotest.(check string) "2nd sunday of christmas 2026" "of-christmas-sunday-2"
    (sunday_slug_of (Option.get (T.second_sunday_of_christmas 2026)))

let test_ferial_slugs () =
  Alcotest.(check string) "26 Dec 2026 (stretch 0)" "of-christmas-0-saturday" (slug_of (d 2026 12 26));
  Alcotest.(check string) "2 Jan 2027 (stretch 1)" "of-christmas-1-saturday" (slug_of (d 2027 1 2));
  Alcotest.(check string) "7 Jan 2027 (stretch 2)" "of-christmas-2-thursday" (slug_of (d 2027 1 7));
  Alcotest.(check string) "after-ashes Thursday 2026" "of-lent-after-ashes-thursday" (slug_of (d 2026 2 19));
  Alcotest.(check string) "ordinary weekday" "of-ordinary-time-2-monday" (slug_of (d 2026 1 19));
  Alcotest.(check string) "lent weekday" "of-lent-6-monday" (slug_of (d 2026 3 30))

(* R8 fix: a Sunday 24 December must yield the Fourth Sunday of Advent, not
   the Vigil -- Tabula I.2/Normae n. 5, and temporal_of.ml's own [named]
   comment for the full argument (the same civil-day-granularity reasoning
   already applied to Holy Thursday). 2028-12-24 and 2034-12-24 are the two
   such Sundays inside the litcal fixture window (2023-12-03..2035-12-01);
   2026-12-24, a Thursday, is the non-Sunday control. *)
let test_nativity_vigil_yields_to_advent_sunday () =
  List.iter
    (fun (y, label) ->
      let dt = d y 12 24 in
      Alcotest.(check bool) (label ^ ": 24 Dec is a Sunday") true (D.weekday dt = D.Sun);
      Alcotest.(check string) (label ^ ": named claims nothing") "<none>" (named_slug dt);
      Alcotest.(check string) (label ^ ": temporal resolves to Advent IV") "of-advent-sunday-4" (slug_of dt);
      Alcotest.(check string) (label ^ ": season is still advent") "advent" (season_str dt);
      Alcotest.(check (option int)) (label ^ ": week 4") (Some 4) (T.week dt))
    [ (2028, "2028"); (2034, "2034") ];
  (* Non-Sunday 24 December: unaffected, the Vigil still wins. *)
  let thu = d 2026 12 24 in
  Alcotest.(check bool) "2026: 24 Dec is a Thursday, not a Sunday" true (D.weekday thu <> D.Sun);
  Alcotest.(check string) "2026: named still claims the vigil" "of-nativity-vigil" (named_slug thu);
  Alcotest.(check string) "2026: temporal still resolves to the vigil" "of-nativity-vigil" (slug_of thu)

(* FIX (celebrant-rubrics-phase1 review, 2026-08-26): [anchors] used to
   list ("of-nativity-vigil", 24 December) UNCONDITIONALLY -- a regression
   from the R8 fix just above, which added [named]'s own Sunday guard but
   never updated [anchors] to match, so in any year 24 December is itself
   a Sunday (2028 and 2034 among them, the SAME two years
   {!test_nativity_vigil_yields_to_advent_sunday} already exercises)
   [anchors] claimed the Vigil where [temporal] actually resolves to
   "of-advent-sunday-4". Checked the same way
   Colitur_kernel.Validate.run's own "anchor" check does: for EVERY
   (slug, date) pair [anchors] returns, not only the 24 December one --
   catching a drift anywhere else in the list, not merely confirming this
   one entry. *)
let test_anchors_agree_with_temporal () =
  let check_year y =
    List.iter
      (fun (expected_slug, date) ->
        Alcotest.(check string)
          (Printf.sprintf "%d: anchors' %S (%s) agrees with temporal" y expected_slug (iso date))
          expected_slug (slug_of date))
      (T.anchors y)
  in
  List.iter check_year [ 2026; 2027; 2028; 2029; 2034; 2035 ]

(* The specific regression, restated directly (not merely implied by the
   agreement check above passing): on a Sunday-24-December year [anchors]
   must not claim the Vigil AT ALL, since it is a generic week-numbered
   Sunday ("of-advent-sunday-4") [anchors]'s own doc comment says it never
   restates ("Independent restatement of [named]'s... dates") -- adding a
   replacement entry would be a second, equally wrong shape (a NAMED
   restatement of a non-named day). On a non-Sunday year, unaffected: the
   Vigil entry is unchanged. *)
let test_anchors_omit_vigil_on_advent_sunday_years () =
  List.iter
    (fun y ->
      Alcotest.(check bool) (Printf.sprintf "%d: anchors omits of-nativity-vigil (24 Dec is Advent IV)" y) false
        (List.mem_assoc "of-nativity-vigil" (T.anchors y)))
    [ 2028; 2034 ];
  List.iter
    (fun y ->
      Alcotest.(check bool) (Printf.sprintf "%d: anchors still lists of-nativity-vigil" y) true
        (List.mem_assoc "of-nativity-vigil" (T.anchors y)))
    [ 2026; 2027; 2029; 2035 ]

let test_colours () =
  let colour_of dt = (T.temporal dt).Colitur_kernel.Temporal.office.Colitur_kernel.Celebration.colour in
  Alcotest.(check string) "Good Friday is red" "red" (Colitur_kernel.Colour.to_string (colour_of (d 2026 4 3)));
  Alcotest.(check string) "Holy Thursday is white" "white" (Colitur_kernel.Colour.to_string (colour_of (d 2026 4 2)));
  Alcotest.(check string) "ordinary time weekday is green" "green"
    (Colitur_kernel.Colour.to_string (colour_of (d 2026 1 19)));
  Alcotest.(check string) "advent weekday is violet" "violet" (Colitur_kernel.Colour.to_string (colour_of (d 2026 12 1)));
  Alcotest.(check string) "gaudete sunday is rose" "rose"
    (Colitur_kernel.Colour.to_string (colour_of (D.add_days (T.advent_start 2026) 14)));
  Alcotest.(check string) "laetare sunday is rose" "rose"
    (Colitur_kernel.Colour.to_string (colour_of (D.add_days (Colitur_kernel.Computus.gregorian_easter 2026) (-21))))

(* ---- properties over the whole domain ---- *)

(* Walk one liturgical year, [T.year_start y] through the day before
   [T.year_start (y + 1)]. Callers must keep [y] within 1583..9998 --
   [T.year_start (y + 1)] calls [Date.make] internally (via [mk]) and
   raises for civil year 10000, out of the kernel's domain, the same
   reason Colitur_kernel.Validate.run's own walk clamps at 9999. *)
let walk_year y =
  let start = T.year_start y in
  let stop = D.add_days (T.year_start (y + 1)) (-1) in
  let rec go dt acc = if D.compare dt stop > 0 then List.rev acc else go (D.add_days dt 1) ((dt, T.temporal dt) :: acc) in
  go start []

let compressed_seasons days =
  List.fold_left
    (fun acc (_, t) -> match acc with s :: _ when s = t.Colitur_kernel.Temporal.season -> acc | _ -> t.Colitur_kernel.Temporal.season :: acc)
    [] days
  |> List.rev

let expected_season_runs = [ V.Advent; V.Christmas; V.Ordinary_time; V.Lent; V.Easter; V.Ordinary_time ]

(* Normae n. 43-44: seasons contiguous, no gaps or overlaps, over the whole
   liturgical year -- the run-length-compressed sequence is always these
   six runs, in this order (Ordinary Time genuinely appears twice, per
   design 2026-08-24-colitur-of-rite-module-design.md §4.2). *)
let prop_season_runs_contiguous y = compressed_seasons (walk_year y) = expected_season_runs

(* Ordinary Time weeks are always 1..34 (Normae n. 43), and every
   Ordinary-Time-season day carries a week number at all (the two-block
   arithmetic never silently drops one). *)
let prop_ordinary_time_week_in_range y =
  List.for_all
    (fun (_, t) ->
      match t.Colitur_kernel.Temporal.season with
      | V.Ordinary_time -> ( match t.Colitur_kernel.Temporal.week with Some n -> n >= 1 && n <= 34 | None -> false)
      | _ -> true)
    (walk_year y)

(* Advent always has exactly four Sundays (Normae n. 41). *)
let prop_advent_four_sundays y =
  List.length
    (List.filter
       (fun (dt, t) -> t.Colitur_kernel.Temporal.season = V.Advent && D.weekday dt = D.Sun)
       (walk_year y))
  = 4

(* No two dates within one liturgical year share a slug (spec's own
   requirement 3; Colitur_kernel.Validate's own ["slugs"] check, for EF,
   asserts the identical thing once a Rite.t exists -- this is that same
   invariant, checked directly here since Phase 1 has no Rite.t yet). *)
let prop_slug_uniqueness y =
  let slugs =
    List.map (fun (_, t) -> Colitur_kernel.Slug.to_string t.Colitur_kernel.Temporal.office.Colitur_kernel.Celebration.slug) (walk_year y)
  in
  List.length slugs = List.length (List.sort_uniq String.compare slugs)

(* [Temporal.t.weekday] always agrees with [Date.weekday] of the date it was
   computed for. *)
let prop_weekday_agrees y = List.for_all (fun (dt, t) -> t.Colitur_kernel.Temporal.weekday = D.weekday dt) (walk_year y)

(* [temporal] is a pure, deterministic function: calling it twice on the
   same date gives structurally equal results. *)
let prop_determinism y = List.for_all (fun (dt, t) -> T.temporal dt = t) (walk_year y)

(* The year is covered exactly once: three consecutive liturgical years'
   walks, concatenated and sorted by date, form one strictly consecutive
   run with no duplicate and no gap -- catches an off-by-one in
   [advent_start]/[season] that a single year's own walk could not (it
   would show up only as a wrong boundary DATE within that walk, not as a
   missing or doubled civil day, since [walk_year] itself always produces a
   contiguous sequence by construction). *)
let prop_liturgical_years_partition_civil_time y =
  let dates = List.concat_map (fun yy -> List.map fst (walk_year yy)) [ y - 1; y; y + 1 ] in
  let sorted = List.sort D.compare dates in
  let rec check = function
    | a :: (b :: _ as rest) -> D.to_rata b - D.to_rata a = 1 && check rest
    | _ -> true
  in
  check sorted

let year_gen = QCheck.int_range 1584 9997 (* leaves room for [y - 1] and [y + 1] *)

let make_prop name f = QCheck.Test.make ~count:200 ~name year_gen f

let prop_tests =
  [ make_prop "OF: season runs are Advent,Christmas,Ordinary_time,Lent,Easter,Ordinary_time" prop_season_runs_contiguous;
    make_prop "OF: Ordinary Time weeks are always 1..34" prop_ordinary_time_week_in_range;
    make_prop "OF: Advent always has exactly four Sundays" prop_advent_four_sundays;
    make_prop "OF: no two dates in one liturgical year share a slug" prop_slug_uniqueness;
    make_prop "OF: temporal's weekday always agrees with Date.weekday" prop_weekday_agrees;
    make_prop "OF: temporal is deterministic" prop_determinism;
    make_prop "OF: consecutive liturgical years partition civil time with no gap or overlap"
      prop_liturgical_years_partition_civil_time ]

(* ---- the committed exhaustive sweep, mirroring test_validate.ml's own
   COLITUR_EXHAUSTIVE_SWEEP convention: every year 1583..9998, not a
   200-year sample, gated behind the same environment variable so the
   default `dune test` stays fast and reports the skip honestly. *)
let colitur_exhaustive_sweep_env = "COLITUR_EXHAUSTIVE_SWEEP"

let test_exhaustive_domain_sweep () =
  if Sys.getenv_opt colitur_exhaustive_sweep_env = None then Alcotest.skip ()
  else begin
    (* FIX (celebrant-rubrics-phase1 review, 2026-08-26): the audit half of
       the anchors/temporal task brief -- does any OTHER {!T.anchors} entry
       drift from {!T.temporal} the same way "of-nativity-vigil" used to
       (fixed just above, {!test_anchors_agree_with_temporal})? Checked for
       EVERY entry [anchors y] returns, across the WHOLE exhaustive domain,
       not merely 24 December, folded into this loop rather than a separate
       one so it shares its own env-var gate. Answer: no NEW drift -- the
       only mismatch found is the ALREADY-KNOWN "of-holy-family" gap
       (Normae n.35(a)'s own 30-December fallback, whenever 26-31 December
       holds no Sunday): there, unlike the Vigil bug, {!T.anchors} (via
       {!T.holy_family}) computes the RIGHT date and it is {!T.temporal}
       that fails to reach it (its Holy-Family test lives inside
       [sunday_slug]'s own Sunday-only dispatch arm) -- a different shape,
       already found, pinned and explicitly deferred by test_rite_of.ml's
       own [test_holy_family_fallback_1583_known_wrong_ferial]/
       [is_known_holy_family_fallback_gap] (see that file's own extensive
       citation), collected below rather than failing the sweep on it a
       second time in a second place. *)
    let holy_family_fallback_years = ref [] in
    for y = 1584 to 9997 do
      let days = walk_year y in
      if compressed_seasons days <> expected_season_runs then
        Alcotest.failf "%d: season runs %s" y
          (String.concat "," (List.map V.season_to_string (compressed_seasons days)));
      if not (prop_ordinary_time_week_in_range y) then Alcotest.failf "%d: an Ordinary Time week is out of 1..34" y;
      if not (prop_advent_four_sundays y) then Alcotest.failf "%d: Advent does not have exactly four Sundays" y;
      if not (prop_slug_uniqueness y) then Alcotest.failf "%d: a slug repeats within the liturgical year" y;
      if not (prop_weekday_agrees y) then Alcotest.failf "%d: a weekday disagrees with Date.weekday" y;
      List.iter
        (fun (expected_slug, date) ->
          let actual = slug_of date in
          if actual <> expected_slug then
            if expected_slug = "of-holy-family" then holy_family_fallback_years := y :: !holy_family_fallback_years
            else
              Alcotest.failf
                "%d: anchors' %S (%s) disagrees with temporal (%S) -- an UNEXPECTED drift, not the known \
                 Holy Family fallback shape"
                y expected_slug (iso date) actual)
        (T.anchors y)
    done;
    (* The known shape is real, not vacuous, and really is the Normae
       n.35(a) trigger, for every year collected above, not merely
       plausible-sounding. *)
    Alcotest.(check bool) "the Holy Family fallback shape is real and not empty" true
      (!holy_family_fallback_years <> []);
    List.iter
      (fun y ->
        Alcotest.(check bool) (Printf.sprintf "%d is really a Christmas-Day-is-Sunday year" y) true
          (D.weekday (d y 12 25) = D.Sun))
      !holy_family_fallback_years
  end

(* 1583 and 9999 themselves sit at the domain edges, where the [y-1]/[y+1]
   probes the properties above use would call [T.year_start] on an
   out-of-range civil year and raise -- covered separately here instead,
   confirming [T.temporal] itself stays total right up to both edges. *)
let test_domain_edges_do_not_raise () =
  let check_civil_year y =
    let start = match D.make ~year:y ~month:1 ~day:1 with Ok t -> t | Error e -> Alcotest.failf "%s" e in
    for i = 0 to 364 do
      ignore (T.temporal (D.add_days start i))
    done
  in
  check_civil_year 1583;
  check_civil_year 9999

let suite =
  ( "temporal-of",
    [ Alcotest.test_case "vocab roundtrips" `Quick test_vocab_roundtrips;
      Alcotest.test_case "advent start" `Quick test_advent_start;
      Alcotest.test_case "seasons" `Quick test_seasons;
      Alcotest.test_case "baptism of the lord" `Quick test_baptism_of_the_lord;
      Alcotest.test_case "holy family" `Quick test_holy_family;
      Alcotest.test_case "second sunday of christmas" `Quick test_second_sunday_of_christmas;
      Alcotest.test_case "christ the king" `Quick test_christ_the_king;
      Alcotest.test_case "named feasts" `Quick test_named_feasts;
      Alcotest.test_case "named colours and ranks" `Quick test_named_colours_and_ranks;
      Alcotest.test_case "easter octave" `Quick test_easter_octave;
      Alcotest.test_case "week numbers" `Quick test_week_numbers;
      Alcotest.test_case "ordinary time block A" `Quick test_ordinary_time_block_a;
      Alcotest.test_case "ordinary time resumption" `Quick test_ordinary_time_resumption;
      Alcotest.test_case "sunday slugs" `Quick test_sunday_slugs;
      Alcotest.test_case "ferial slugs" `Quick test_ferial_slugs;
      Alcotest.test_case "nativity vigil yields to Advent Sunday IV" `Quick test_nativity_vigil_yields_to_advent_sunday;
      Alcotest.test_case "anchors agree with temporal" `Quick test_anchors_agree_with_temporal;
      Alcotest.test_case "anchors omit the vigil on an Advent-IV-Sunday year" `Quick
        test_anchors_omit_vigil_on_advent_sunday_years;
      Alcotest.test_case "colours" `Quick test_colours;
      Alcotest.test_case "domain edges do not raise" `Quick test_domain_edges_do_not_raise;
      Alcotest.test_case "exhaustive domain sweep" `Slow test_exhaustive_domain_sweep ]
    @ List.map QCheck_alcotest.to_alcotest prop_tests )