diff options
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.ml | 89 | ||||
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.mli | 7 | ||||
| -rw-r--r-- | test/test_temporal_ef.ml | 116 |
3 files changed, 201 insertions, 11 deletions
diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index 7782876..0647aac 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -64,6 +64,46 @@ let season d = citation gap. *) let christ_the_king y = sunday_on_or_before (mk y 10 31) +(* RG 17(b) (Caput III, "De Dominicis"), primary text, verified against BOTH + photographic scans (missale-romanum-1962.pdf and "Missale Romanum + 1962_text.pdf" -- the electronic transcription, 1962-06-23,_SS_Ioannes + _XXIII,_Missale_Romanum,_LT.pdf, carries the SAME text here, so this one + paragraph is not itself a transcription-vs-scan divergence): "17. + Dominica excludit, per se, assignationem perpetuam festorum. Excipiuntur: + a) festum Ssmi Nominis Iesu, celebrandum dominica quae occurrit a die 2 + ad 5 ianuarii (secus die 2 ianuarii); b) festum S. Familiae Iesu, Mariae, + Ioseph, celebrandum dominica prima post Epiphaniam; ... Haec festa locum + tenent dominicae occurrentis cum omnibus iuribus et privilegiis: de + dominica, proinde, nulla fit commemoratio" -- a Sunday of itself excludes + the perpetual assignment of feasts to it; EXCEPTED: (a) the Most Holy + Name of Jesus, celebrated on the Sunday falling 2-5 January (otherwise 2 + January); (b) the HOLY FAMILY of Jesus, Mary and Joseph, celebrated on + the FIRST SUNDAY AFTER EPIPHANY; ... these feasts hold the place of the + occurring Sunday with ALL its rights and privileges: of the Sunday, + therefore, NO commemoration is made -- the identical "cum omnibus + iuribus et privilegiis: nulla fit commemoratio" formula RG 16(a) already + uses for a FIXED-date Lord feast impeding a Sunday (register §6.0), + stated here for the Sunday-ASSIGNED feasts RG 17 itself lists by letter. + + UNLIKE (a)'s own narrow 2-5 January window (which CAN be empty of a + Sunday -- the calendarium's own January table carries an explicit "vel ea + deficiente, die 2 ianuarii" fallback for it, scan-verified), (b)'s 7-13 + January window can NEVER be empty: [sunday_on_or_before (mk y 1 6)] is, + by construction, at most 6 days before 6 January, so adding 7 always + lands in [7, 13] regardless of which weekday 6 January falls on (every + one of the 7 possible cases is exercised by test_temporal_ef.ml's own + [test_holy_family]). The calendarium's own text for (b), both in RG 17 + itself and in its January table entry ("Dominica I post Epiphaniam: + S. Familiae, Iesu, Mariae, Ioseph, II classis"), carries no fallback + clause of any kind -- consistent with there being no gap for one to + cover. + + Formula IDENTICAL to [week_origin]'s own [Time_after_epiphany] case below + (the first Sunday after Epiphany) -- not re-derived a second time, just + named here for its own citation and so [temporal] can test a specific + date against it without reaching into [week_origin]'s implementation. *) +let holy_family_sunday y = Date.add_days (sunday_on_or_before (mk y 1 6)) 7 + let same a b = Date.compare a b = 0 (* Named temporal days: the I-class feasts of the Lord (RG 91 entries 1 and 3), @@ -404,15 +444,15 @@ let temporal d = let easter = Computus.gregorian_easter y in let s = season d in let weekday = Date.weekday d in - let build ~season ~slug ~colour ~rank ~week = + let build ?(subject = Colitur_kernel.Subject.Temporal) ~season ~slug ~colour ~rank ~week () = let office = - Colitur_kernel.Celebration.make ~slug:(Slug.of_string_exn slug) ~rank ~colour - ~subject:Colitur_kernel.Subject.Temporal ~layer:"temporal" () + Colitur_kernel.Celebration.make ~slug:(Slug.of_string_exn slug) ~rank ~colour ~subject + ~layer:"temporal" () in { Colitur_kernel.Temporal.season; week; weekday; office } in match named d with - | Some (season, slug, colour, rank) -> build ~season ~slug ~colour ~rank ~week:(week d) + | Some (season, slug, colour, rank) -> build ~season ~slug ~colour ~rank ~week:(week d) () | None -> ( (* Rogations (the Minor Litanies only -- RG 87, Monday and Tuesday before Ascension). The Major Litanies (25 April, RG 80) are a fixed @@ -441,10 +481,10 @@ let temporal d = if rogation = 36 || rogation = 37 then build ~season:s ~slug:(if rogation = 36 then "ef-rogation-monday" else "ef-rogation-tuesday") - ~colour:Colour.Violet ~rank:(ferial_rank d s) ~week:(week d) + ~colour:Colour.Violet ~rank:(ferial_rank d s) ~week:(week d) () else match ember d with - | Some (slug, rank, colour) -> build ~season:s ~slug ~colour ~rank ~week:(week d) + | Some (slug, rank, colour) -> build ~season:s ~slug ~colour ~rank ~week:(week d) () | None -> ( match sunday_slug d with | Some slug -> @@ -456,11 +496,29 @@ let temporal d = reaches this fallback -- leaving II class here except the remaining Advent and Lent Sundays. *) let rank = match s with Advent | Lent -> Class1 | _ -> Class2 in - build ~season:s ~slug ~colour ~rank ~week:(week d) + (* RG 17(b) (this file's own [holy_family_sunday], full + citation there): the ONE Sunday a year this branch must + NOT leave [subject = Temporal] (this function's own + default) -- the Holy Family, whose slug/rank/colour are + otherwise EXACTLY what this branch already computes for + the 7-13 January Sunday (an accident this task's own + oracle-strengthening work exposed: rank/colour alone + could never distinguish "Holy Family" from "an ordinary, + unnamed Sunday", since they happen to coincide). Every + OTHER Sunday this branch ever builds -- including the + narrower Holy Name of Jesus window, RG 17(a), still + unbuilt as its own named day, register §6 -- keeps + [Temporal], unaffected. *) + let subject = + if same d (holy_family_sunday y) then Colitur_kernel.Subject.Lord + else Colitur_kernel.Subject.Temporal + in + build ~subject ~season:s ~slug ~colour ~rank ~week:(week d) () | None -> ( match christmastide_feria_slug d with | Some slug -> - build ~season:s ~slug ~colour:(season_colour s) ~rank:(ferial_rank d s) ~week:(week d) + build ~season:s ~slug ~colour:(season_colour s) ~rank:(ferial_rank d s) + ~week:(week d) () | None -> (* The days between Ash Wednesday and Lent I have proper Masses and belong to no numbered week. *) @@ -468,7 +526,7 @@ let temporal d = if after_ashes >= -45 && after_ashes <= -43 then build ~season:s ~slug:(Printf.sprintf "ef-lent-after-ashes-%s" (weekday_word d)) - ~colour:Colour.Violet ~rank:Class3 ~week:None + ~colour:Colour.Violet ~rank:Class3 ~week:None () else let colour = (* The Pentecost octave weekdays are red, not Paschaltide's white. *) @@ -508,14 +566,22 @@ let temporal d = Printf.sprintf "ef-%s-%d-%s" (season_slug_word s) (Option.value week_n ~default:0) (weekday_word d) in - build ~season:s ~slug ~colour ~rank:(ferial_rank d s) ~week:week_n))) + build ~season:s ~slug ~colour ~rank:(ferial_rank d s) ~week:week_n ()))) (* Independent restatement of [named]'s fixed and Easter-relative dates, paired with the slug each should carry, for civil year [y]. Deliberately NOT derived from [named] itself -- consumed by [Validate]'s anchor- agreement check (design spec §5.7), which exists precisely to catch an accidental single-site drift (e.g. Ascension's [off 39] silently becoming - [off 40]) that both sides moving together would hide. *) + [off 40]) that both sides moving together would hide. + + [holy_family_sunday] is NOT one of [named]'s own outputs (its own + citation above explains why -- [temporal] applies it as a targeted + [subject] override inside [sunday_slug]'s branch, not through [named]'s + 4-tuple), but it is exactly the same kind of independently-computed + anchor this list exists to guard -- an accidental drift in + [holy_family_sunday]'s own [+7] would silently move Holy Family without + this guard catching it, same as any other entry here. *) let anchors y = let easter = Computus.gregorian_easter y in let off n = Date.add_days easter n in @@ -526,6 +592,7 @@ let anchors y = ("ef-nativity-octave-day-7", mk y 12 31); ("ef-circumcision", mk y 1 1); ("ef-epiphany", mk y 1 6); + ("ef-time-after-epiphany-sunday-1", holy_family_sunday y); ("ef-ash-wednesday", off (-46)); ("ef-passion-sunday", off (-14)); ("ef-palm-sunday", off (-7)); diff --git a/lib/rites/rite_ef/temporal_ef.mli b/lib/rites/rite_ef/temporal_ef.mli index a07ffa2..68fe64e 100644 --- a/lib/rites/rite_ef/temporal_ef.mli +++ b/lib/rites/rite_ef/temporal_ef.mli @@ -14,6 +14,13 @@ val season : Date.t -> Vocab_ef.season (** Last Sunday of October, per the 1960 calendar. *) val christ_the_king : int -> Date.t +(** RG 17(b): the first Sunday after Epiphany, in civil year [y] -- the + Feast of the Holy Family's own date. Always falls 7-13 January + inclusive; never empty of a Sunday (unlike RG 17(a)'s Holy Name, whose + narrower 2-5 January window can be, and carries an explicit calendarium + fallback for it), so this needs none. *) +val holy_family_sunday : int -> Date.t + (** The named temporal days: I-class feasts of the Lord, vigils, and days within the Octave of the Nativity. Returns (season, slug, colour, rank). Carries no week of its own -- {!temporal} computes it uniformly via {!week} for diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index 751abd2..7837fb5 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -167,13 +167,95 @@ let test_resumed_sundays () = module Cel = Colitur_kernel.Celebration module Sl = Colitur_kernel.Slug module Colr = Colitur_kernel.Colour +module Sub = Colitur_kernel.Subject let office dt = (T.temporal dt).Colitur_kernel.Temporal.office let slug_of dt = Sl.to_string (office dt).Cel.slug let rank_of dt = V.rank_to_string (office dt).Cel.rank let colour_of dt = Colr.to_string (office dt).Cel.colour +let subject_of dt = (office dt).Cel.subject let temporal_week dt = (T.temporal dt).Colitur_kernel.Temporal.week +(* RG 17(b) (Caput III, "De Dominicis"), primary text (scan-verified, + docs/research/rules-register.md §4): "festum S. Familiae Iesu, Mariae, + Ioseph, celebrandum dominica prima post Epiphaniam" -- the Holy Family is + celebrated on the first Sunday after Epiphany, EVERY year (unlike RG + 17(a)'s Holy Name, whose narrower 2-5 January window can be empty and + carries an explicit "vel ea deficiente, die 2 ianuarii" fallback in the + calendarium itself -- 7-13 January can never be empty of a Sunday, so + Holy Family needs, and the calendarium carries, no such fallback). + [T.holy_family_sunday] is [named]'s own [week_origin Time_after_epiphany] + formula, restated for its own citation -- not re-derived a second time. + + Deliberately NOT part of [T.named]: [named] is checked before + [T.sunday_slug]'s own Christmastide branch in [T.temporal]'s dispatch, but + this feast's slug, rank and colour are EXACTLY what that branch already + computes for the 7-13 January Sunday (register's own pre-existing note on + [sunday_slug]: "the key stays lectio's") -- the only field that actually + needed to change is [subject] (silently always [Temporal] before this), + so [T.temporal] applies it as a targeted override inside that branch + rather than duplicating slug/rank/colour a second time through [named]'s + 4-tuple. *) +let test_holy_family () = + (* 2026: Epiphany (6 Jan) is a Tuesday, so Holy Family falls 11 January -- + an ordinary instance, no collision with the Baptism (13 Jan). *) + Alcotest.(check string) "2026: slug is the ordinary I-post-Epiphany Sunday key" + "ef-time-after-epiphany-sunday-1" (slug_of (d 2026 1 11)); + Alcotest.(check string) "2026: II class" "class-2" (rank_of (d 2026 1 11)); + Alcotest.(check string) "2026: white" "white" (colour_of (d 2026 1 11)); + Alcotest.(check bool) "2026: subject is Lord (RG 91 entry 14, \"Festa Domini II \ + classis\" -- the mystery of the Holy Family touches Christ)" + true + (subject_of (d 2026 1 11) = Sub.Lord); + (* 2019: Epiphany itself is a Sunday, so the first Sunday AFTER it is the + LATEST possible date, 13 January -- the one date Holy Family collides + with the fixed Commemoration of the Baptism of the Lord (data/ef/ + sanctoral.sexp: "commemoration-of-the-baptism-of-the-lord", also 13 + Jan, II class, subject Lord). [T.temporal]'s own resolution of WHO wins + that day is {!Rite_ef.Precedence_ef}'s business (band/disposition, see + test_precedence_ef.ml), not this function's -- this only proves + [T.temporal] itself still identifies 13 January 2019 as Holy Family's + own date, unconditionally, regardless of what else might compete for + the day once precedence is applied. *) + Alcotest.(check bool) "2019: 6 January is a Sunday" true (D.weekday (d 2019 1 6) = D.Sun); + Alcotest.(check string) "2019: Holy Family falls on the latest possible date, 13 Jan" + "2019-01-13" (D.to_iso8601 (T.holy_family_sunday 2019)); + Alcotest.(check string) "2019: still the same slug" "ef-time-after-epiphany-sunday-1" + (slug_of (T.holy_family_sunday 2019)); + Alcotest.(check bool) "2019: still subject Lord" true (subject_of (T.holy_family_sunday 2019) = Sub.Lord); + (* Every possible weekday for 6 January exercised, proving the formula + never leaves the 7-13 window empty (register's own citation above) -- + not merely the two years already checked above. *) + List.iter + (fun y -> + let hf = T.holy_family_sunday y in + Alcotest.(check bool) (Printf.sprintf "%d: Holy Family is a Sunday" y) true + (D.weekday hf = D.Sun); + Alcotest.(check bool) (Printf.sprintf "%d: Holy Family falls 7-13 January" y) true + (D.month hf = 1 && D.day hf >= 7 && D.day hf <= 13)) + [ 2019; 2020; 2021; 2022; 2023; 2024; 2025; 2026; 2027 ]; + (* Negative control: an ORDINARY Sunday after Epiphany (the 2nd) stays + [subject Temporal] -- the override is scoped to exactly one Sunday a + year, not every Time-after-Epiphany-shaped Sunday. *) + Alcotest.(check bool) "2026: the following Sunday (18 Jan, II after Epiphany) is NOT Lord" + true + (subject_of (d 2026 1 18) = Sub.Temporal) + +(* Three of [test_holy_family]'s own exhaustive-weekday sample, pinned to + their literal ISO dates and independently cross-checked against + `date -d <iso> +%A` (the same discipline test_golden.ml's own header + describes for its own weekday assertions) -- the earliest possible date + (Epiphany a Saturday), the latest (Epiphany a Sunday), and one ordinary + middle case, rather than trusting the structural "always 7-13" check + above on its own without ever anchoring it to real calendar dates. *) +let test_holy_family_no_gap_year () = + Alcotest.(check string) "2024 (6 Jan a Saturday): earliest possible date, 7 Jan" "2024-01-07" + (D.to_iso8601 (T.holy_family_sunday 2024)); + Alcotest.(check string) "2019 (6 Jan a Sunday): latest possible date, 13 Jan" "2019-01-13" + (D.to_iso8601 (T.holy_family_sunday 2019)); + Alcotest.(check string) "2025 (6 Jan a Monday): 12 Jan" "2025-01-12" + (D.to_iso8601 (T.holy_family_sunday 2025)) + (* Regression for a Task 14 Validate finding, reworked (register finding 4): [named] no longer carries its own week at all -- [temporal] computes it uniformly via [week] for every day, named or not -- so "a named day inside @@ -432,6 +514,36 @@ let test_anchors_erosion_is_caught () = [ "ef-ascension"; "ef-nativity" ] (missing_from_anchors ~named_slugs ~anchors:eroded_anchors) +(* Holy Family's own anchor coverage, kept SEPARATE from the two tests above: + it is genuinely NOT one of [T.named]'s outputs (test_holy_family's own + comment explains why -- [T.temporal] applies it as a targeted override + inside [T.sunday_slug]'s branch instead), so [named_slugs_for_year]'s scan + cannot see it, and folding it into [test_anchors_cover_all_named_days]/ + [test_anchors_erosion_is_caught] would misrepresent what those two are + actually proving ("everything [named] produces"). This proves the same + two properties directly against [T.holy_family_sunday] instead: the entry + is present, AND deleting it is caught -- {!Validate}'s own production + anchor check (validate.ml, register/spec §5.7) calls [temporal], not + [named], so it is unaffected by this distinction and already covers this + entry regardless; this is this file's own unit-level guard against the + same erosion. *) +let test_holy_family_anchor_present_and_erosion_is_caught () = + let y = 2026 in + let expected_slug = "ef-time-after-epiphany-sunday-1" in + let expected_date = T.holy_family_sunday y in + Alcotest.(check bool) "the anchor entry exists, at the right date" true + (List.mem (expected_slug, expected_date) (T.anchors y)); + (* Erosion: with the entry struck out, [T.temporal] itself still puts + [expected_slug] at [expected_date] (unaffected -- deleting an [anchors] + row never touches [temporal]'s own computation, only what is CHECKED + against it), so a reader who only trusted [anchors] would no longer be + told to look there at all. *) + let eroded = List.filter (fun (s, dt) -> not (String.equal s expected_slug && dt = expected_date)) (T.anchors y) in + Alcotest.(check bool) "the erosion is caught: the entry no longer appears" false + (List.mem (expected_slug, expected_date) eroded); + Alcotest.(check string) "sanity: temporal itself is unaffected by the anchors-list erosion" + expected_slug (slug_of expected_date) + let test_totality () = (* Every day of 2026 yields an office without raising. Not a slug re-validation -- Slug.t is a private string validated on construction, @@ -453,6 +565,8 @@ let suite_extra = Alcotest.test_case "nativity octave" `Quick test_nativity_octave; Alcotest.test_case "week numbers" `Quick test_week_numbers; Alcotest.test_case "sunday slugs" `Quick test_sunday_slugs; + Alcotest.test_case "holy family (RG 17(b))" `Quick test_holy_family; + Alcotest.test_case "holy family: no gap year (RG 17(b))" `Quick test_holy_family_no_gap_year; Alcotest.test_case "week/sunday_slug agree" `Quick test_week_sunday_slug_agree; Alcotest.test_case "resumed sundays" `Quick test_resumed_sundays; Alcotest.test_case "ferial slugs and ranks" `Quick test_ferial_slugs_and_ranks; @@ -465,6 +579,8 @@ let suite_extra = Alcotest.test_case "totality" `Quick test_totality; Alcotest.test_case "anchors cover all named days" `Quick test_anchors_cover_all_named_days; + Alcotest.test_case "holy family anchor present, erosion caught" `Quick + test_holy_family_anchor_present_and_erosion_is_caught; Alcotest.test_case "anchors erosion is caught" `Quick test_anchors_erosion_is_caught ] let suite = |