diff options
| -rw-r--r-- | lib/rites/rite_of/dune | 5 | ||||
| -rw-r--r-- | lib/rites/rite_of/temporal_of.ml | 531 | ||||
| -rw-r--r-- | lib/rites/rite_of/temporal_of.mli | 141 | ||||
| -rw-r--r-- | lib/rites/rite_of/vocab_of.ml | 155 | ||||
| -rw-r--r-- | lib/rites/rite_of/vocab_of.mli | 58 | ||||
| -rw-r--r-- | test/dune | 2 | ||||
| -rw-r--r-- | test/test_colitur.ml | 3 | ||||
| -rw-r--r-- | test/test_temporal_of.ml | 393 |
8 files changed, 1286 insertions, 2 deletions
diff --git a/lib/rites/rite_of/dune b/lib/rites/rite_of/dune new file mode 100644 index 0000000..12b425e --- /dev/null +++ b/lib/rites/rite_of/dune @@ -0,0 +1,5 @@ +(library + (name rite_of) + (libraries colitur_kernel sexplib) + (preprocess + (pps ppx_sexp_conv))) diff --git a/lib/rites/rite_of/temporal_of.ml b/lib/rites/rite_of/temporal_of.ml new file mode 100644 index 0000000..367d855 --- /dev/null +++ b/lib/rites/rite_of/temporal_of.ml @@ -0,0 +1,531 @@ +(* OF (post-1970) temporal cycle. Every boundary and rank rule cites its + Missale Romanum editio typica tertia (2002) "Normae universales de anno + liturgico et de calendario" paragraph ("Normae n. N") or Institutio + Generalis Missalis Romani paragraph ("IGMR n. N") -- see vocab_of.ml's own + top-of-file comment for why the document has to be named on every + citation (both are independently numbered from 1 in the same source PDF). + Extracted with `pdftotext -layout docs/research/of/missale-romanum-2002.pdf`; + line numbers below are extracted-file line numbers from that command, + recorded so a citation can be re-located quickly, not because the PDF + itself is paginated that way. *) + +open Colitur_kernel +open Vocab_of + +let mk y m d = + match Date.make ~year:y ~month:m ~day:d with + | Ok t -> t + | Error e -> failwith ("temporal_of: " ^ e) + +let weekday_index d = + match Date.weekday d with + | Date.Sun -> 0 | Date.Mon -> 1 | Date.Tue -> 2 | Date.Wed -> 3 + | Date.Thu -> 4 | Date.Fri -> 5 | Date.Sat -> 6 + +let sunday_on_or_before d = Date.add_days d (-(weekday_index d)) + +(* The next Sunday STRICTLY after [d], even when [d] is itself a Sunday -- + distinct from [sunday_on_or_before], and needed for exactly that reason by + {!baptism_of_the_lord} below (Normae n. 38's "dominica POST diem 6 + ianuarii", not "on or after"). *) +let next_sunday_strictly_after d = + let wi = weekday_index d in + Date.add_days d (if wi = 0 then 7 else 7 - wi) + +let before a b = Date.compare a b < 0 +let on_or_after a b = Date.compare a b >= 0 +let same a b = Date.compare a b = 0 + +(* Normae n. 40 (Titulus II.V, "De tempore Adventus"): "Tempus Adventus + incipit a I Vesperis dominicae quae incidit in diem 30 novembris vel est + huic vicinior" -- Advent begins with First Vespers of the Sunday falling + on 30 November or nearest to it. Worded identically in substance to EF's + own RG 20 (Rite_ef.Temporal_ef.advent_start's own citation), so the same + closed-form identity holds and for the same reason: the Sunday nearest 30 + November is, equivalently, three weeks (21 days) before the last Sunday on + or before 24 December -- verified once, generally, rather than re-derived + per rite: whichever weekday 24 December falls on, [sunday_on_or_before] + lands within the 7 days ending there, and subtracting 21 always lands + within the 7 days around 30 November, since 24 December minus 24 days is + 30 November exactly and 21 is within one week of that. *) +let advent_start y = Date.add_days (sunday_on_or_before (mk y 12 24)) (-21) +let year_start = advent_start + +(* Normae n. 38 and the Calendarium Romanum Generale's own January table + (extracted line ~4033: "Dominica post diem 6 ianuarii: In baptismate + Domini Festum") -- see this function's own .mli citation for the full + argument, including why the table's Monday-shift clause never fires here. *) +let baptism_of_the_lord y = next_sunday_strictly_after (mk y 1 6) + +(* Normae n. 35(a) and the December calendarium table's own closing line + (extracted line ~4459: "Dominica infra octavam Nativitatis, vel, ea + deficiente, die 30 decembris: Sanctae Familiae Iesu, Mariae et Ioseph + Festum") -- see this function's own .mli citation for the CODE-vs-DATA + argument for why this lives here rather than in Phase 3's sanctoral data. *) +let holy_family y = + let window = List.init 6 (fun i -> mk y 12 (26 + i)) in + match List.find_opt (fun d -> Date.weekday d = Date.Sun) window with + | Some d -> d + | None -> mk y 12 30 + +(* Normae n. 36: "Dominica a die 2 ad diem 5 ianuarii occurrens est Dominica + II post Nativitatem" -- see this function's own .mli citation for why + [None] (unlike {!holy_family}) is a genuine, uncovered outcome here: this + window carries no "otherwise, on a fixed date" fallback clause in the + primary text. *) +let second_sunday_of_christmas y = + let window = List.init 4 (fun i -> mk y 1 (2 + i)) in + List.find_opt (fun d -> Date.weekday d = Date.Sun) window + +(* Normae n. 43-44 and the Missale's own "HEBDOMADA XXXIV 'PER ANNUM'" + heading (extracted line 13099) -- see [week]'s own citation below for the + full two-block week arithmetic this anchors. *) +let christ_the_king y = Date.add_days (advent_start y) (-7) + +(* Normae n. 71-77 boundary text, PRIMARY-SOURCE-VERIFIED against the 2002 + typical edition (docs/research/of/missale-romanum-2002.pdf, pdftotext + -layout, extracted lines ~3660-3790 for the Titulus II season definitions + themselves; see vocab_of.ml's own top-of-file comment for the Triduum + placement argument this function's own Lent branch below rests on). + + Tested in chronological order within the civil year, mirroring + Rite_ef.Temporal_ef.season's own structure -- see that function's own + comment for why testing "on_or_after advent_this && before christmas_day" + FIRST is safe even for a January [d]: [advent_start (Date.year d)] for a + January date is always LATER within that same civil year (late November), + so the check correctly fails and falls through, and no special-casing is + needed for the year boundary. + + - Advent (n. 40): [advent_this] through 24 December. + - Christmas (n. 33, "usque ad dominicam post Epiphaniam ... inclusive"): + 25-31 December, THEN (continuing into the new civil year) 1 January + through {!baptism_of_the_lord} inclusive. + - Ordinary Time, first run (n. 44, "usque ad feriam III ante Quadragesimam + inclusive"): the day after {!baptism_of_the_lord} through the day + before Ash Wednesday. + - Lent (n. 28, "usque ad Missam in Cena Domini exclusive", PLUS the + Triduum-placement argument in vocab_of.ml): Ash Wednesday through Holy + Saturday inclusive -- i.e. everything before Easter itself. + - Easter (n. 22-23, "concluditur ... dominica Pentecostes"): Easter Sunday + through Pentecost Sunday inclusive. + - Ordinary Time, second run (n. 44, "iterum incipit feria II post + dominicam Pentecostes et explicit ante I Vesperas dominicae I + Adventus"): everything else -- the day after Pentecost through the day + before the FOLLOWING year's [advent_this], which is exactly what + survives every check above, so no explicit final test is needed; see + [week]'s own two-block arithmetic for why this run's own numbers still + land correctly on the far side of the interruption. *) +let season d = + let y = Date.year d in + let easter = Computus.gregorian_easter y in + let advent_this = advent_start y in + let christmas_day = mk y 12 25 in + let ash_wednesday = Date.add_days easter (-46) in + let pentecost = Date.add_days easter 49 in + let baptism = baptism_of_the_lord y in + if on_or_after d advent_this && before d christmas_day then Advent + else if on_or_after d christmas_day then Christmas (* 25-31 Dec *) + else if before d (Date.add_days baptism 1) then Christmas (* 1 Jan .. baptism, inclusive *) + else if before d ash_wednesday then Ordinary_time (* first run *) + else if before d easter then Lent (* Ash Wed .. Holy Saturday, inclusive *) + else if Date.compare d pentecost <= 0 then Easter (* Easter Sunday .. Pentecost, inclusive *) + else Ordinary_time (* second run *) + +let days_between a b = Date.to_rata b - Date.to_rata a + +(* Floor division -- see Rite_ef.Temporal_ef's own identical helper for why + OCaml's truncating [/] would be wrong for a date before a season's own + week-1 origin. *) +let floor_div a b = if a >= 0 then a / b else ((a + 1) / b) - 1 + +let weekday_word d = Date.weekday_to_string (Date.weekday d) + +(* IGMR n. 346 (Titulus VIII, "De coloribus"), the season-level defaults; a-e + listed here, f (rose) is an override applied separately by + [is_rose_sunday] below, g (festive substitution) is not modelled (the same + kind of per-Mass-not-per-day nuance EF's own temporal_ef.ml already + documents as unmodelled for its own RG 126 palms/RG 132 Good Friday + cases). + a) "Color albus adhibetur in Officiis et Missis temporis paschalis et + Nativitatis Domini" -- white for Easter and Christmas time. + c) "Color viridis adhibetur in Officiis et Missis temporis 'per annum'" + -- green for Ordinary Time. + d) "Color violaceus adhibetur tempore Adventus et Quadragesimae" -- + violet for Advent and Lent. *) +let season_colour = function + | Christmas | Easter -> Colour.White + | Ordinary_time -> Colour.Green + | Advent | Lent -> Colour.Violet + +(* IGMR n. 346(f): "Color rosaceus adhiberi potest, ubi mos est, in + dominicis Gaudete (III Adventus) et Laetare (IV in Quadragesima)" -- MAY + be used, where customary. Treated as colitur's own canonical default the + same way Rite_ef.Temporal_ef.is_rose_sunday already treats EF's + structurally identical RG 131 ("may be used... for that Sunday only") -- + an indult over the season's violet, not chosen afresh here. *) +let is_rose_sunday d s = + let y = Date.year d in + match s with + | Advent -> same d (Date.add_days (advent_start y) 14) (* Gaudete: Advent III *) + | Lent -> same d (Date.add_days (Computus.gregorian_easter y) (-21)) (* Laetare: Lent IV *) + | _ -> false + +let holy_family_names = + Names.of_list [ (Lang.of_string_exn "la", "Sanctae Familiae Iesu, Mariae et Ioseph") ] + +let baptism_names = Names.of_list [ (Lang.of_string_exn "la", "In Baptismate Domini") ] + +(* Named temporal days that need no per-year conditional: the Nativity and + its Vigil, Mary Mother of God (the Nativity's own Octave Day, 1 January, + Normae n. 35(f)), Epiphany (n. 37, universal calendar only -- the + local Sunday-transfer option is out of scope, spec's own EF-precedented + discipline), Ash Wednesday (n. 29), Palm/Passion Sunday (n. 30, merged + into Lent's own week VI -- vocab_of.ml's own citation), Easter and the six + weekday days of its Octave (n. 24, "uti sollemnitates Domini + celebrantur"), Ascension (n. 25, "quadragesima die post Pascha" -- + Easter+39, inclusive day-counting, the same convention EF's own [off 39] + anchor uses), Pentecost (n. 22-23), Trinity Sunday and Corpus Christi + (both found by their own headings in the Missale's "IN SOLLEMNITATIBUS + DOMINI 'PER ANNUM' OCCURRENTIBUS" appendix, extracted lines + ~13130-13230: "Dominica I post Pentecosten: SANCTISSIMAE TRINITATIS + Sollemnitas"; "Feria V post Ss.mam Trinitatem: SANCTISSIMI CORPORIS ET + SANGUINIS CHRISTI Sollemnitas" -- kept on its PRIMARY, typical-edition + date, Thursday after Trinity, not the widespread local Sunday-transfer + option the SAME heading's own next sentence names, for the identical + universal-calendar-only reason Epiphany's transfer is excluded), and + Christ the King (n. 43's own heading, this file's own [christ_the_king] + citation). + + Grades: Nativity/Mary Mother of God/Epiphany/Easter-and-its-Octave/ + Ascension/Pentecost/Trinity/Corpus-Christi/Christ-the-King are + [Sollemnitas], confirmed against the calendarium's own printed grade word + for each ("Sollemnitas") wherever a table entry exists (Nativity, Mary + Mother of God, Christ the King all extracted with that literal word next + to them; the movable Sundays/Ascension/Pentecost/Trinity/Corpus Christi + have none, being computed rather than tabulated, but sit at Tabula entry + 2/3/5, the same table region, and the Missale's own two "IN SOLLEMNITATIBUS + ... OCCURRENTIBUS" headings state it directly for Trinity/Corpus Christi). + Ash Wednesday is [Feria] -- see vocab_of.ml's own top-of-file comment for + why a privileged feria stays [Feria] here rather than getting an elevated + rank the way EF's own [Class1] does: OF's rank vocabulary keeps grade and + precedence-table-position separate, unlike EF's. + + Colours per IGMR n. 346 (season_colour's own citation covers the season + defaults; the exceptions below are cited individually): Palm/Passion + Sunday is RED (346(b): "Color ruber adhibetur in dominica Passionis"), + not Lent's own violet -- a genuine, easy-to-miss divergence from what the + surrounding season's colour would suggest. Pentecost is likewise RED + (346(b): "in dominica Pentecostes"). The Nativity Vigil is tagged white on + IGMR 346(a)'s general "celebrationibus Domini" clause -- NO day-specific + colour rubric was found for the Vigil Mass itself in the extracted text + (unlike, e.g., the Chrism Mass or Holy Thursday's own explicit "color + albus" note found elsewhere in the same document), so this is the + best-supported general-clause reading, flagged honestly rather than + presented as a day-specific citation. *) +let named d = + let y = Date.year d in + let easter = Computus.gregorian_easter y in + let off n = Date.add_days easter n in + let m = Date.month d and dd = Date.day d in + if m = 12 && dd = 24 then Some (Advent, "of-nativity-vigil", Colour.White, Sollemnitas) + else if m = 12 && dd = 25 then Some (Christmas, "of-nativity", Colour.White, Sollemnitas) + else if m = 1 && dd = 1 then Some (Christmas, "of-mary-mother-of-god", Colour.White, Sollemnitas) + else if m = 1 && dd = 6 then Some (Christmas, "of-epiphany", Colour.White, Sollemnitas) + else if same d (off (-46)) then Some (Lent, "of-ash-wednesday", Colour.Violet, Feria) (* Normae n. 29 *) + else if same d (off (-7)) then Some (Lent, "of-palm-sunday", Colour.Red, Sollemnitas) (* n. 30; IGMR 346(b) *) + else if same d easter then Some (Easter, "of-easter-sunday", Colour.White, Sollemnitas) + else if List.mem (days_between easter d) [ 1; 2; 3; 4; 5; 6 ] then + (* Easter Monday .. Saturday: n. 24's own eight days are Easter Sunday + (above) plus these six plus the closing Sunday (day 8), deliberately + left OUT of [named] -- see this file's own [sunday_slug], whose + generic Sunday-of-Easter branch already lands it on [Sollemnitas] via + the SAME week-1-numbering path every other Easter Sunday uses, with no + need for a second, competing named entry. *) + Some (Easter, Printf.sprintf "of-easter-octave-day-%d" (days_between easter d + 1), Colour.White, Sollemnitas) + else if same d (off 39) then Some (Easter, "of-ascension", Colour.White, Sollemnitas) + else if same d (off 49) then Some (Easter, "of-pentecost", Colour.Red, Sollemnitas) + else if same d (off 56) then Some (Ordinary_time, "of-trinity", Colour.White, Sollemnitas) + else if same d (off 60) then Some (Ordinary_time, "of-corpus-christi", Colour.White, Sollemnitas) + else if same d (christ_the_king y) then Some (Ordinary_time, "of-christ-the-king", Colour.White, Sollemnitas) + else None + +(* Week numbering. Advent, Lent and Easter each have a single, simple origin + Sunday (mirroring Rite_ef.Temporal_ef.week_origin's own shape); Christmas + has none at all (its own structure is date-keyed throughout -- n. 36 says + "the Sunday falling 2-5 January", never "week I", and no calendarium + heading anywhere in Christmas time carries a week-number title the way + "HEBDOMADA I 'PER ANNUM'" does); Ordinary Time needs the two-block + arithmetic below. + + ORDINARY TIME'S OWN RESUMPTION RULE -- the hard part this module exists + to get right, and the reason it is Phase 1's own gate. DERIVED, not + copied, from three primary-text facts, none of which alone states the + rule but which together pin it down uniquely: + + 1. Normae n. 44: Ordinary Time runs in two disjoint blocks -- "the Monday + following the Sunday occurring after 6 January" through "Tuesday before + Lent, inclusive" (the FIRST run), then "the Monday after Pentecost + Sunday" through "before First Vespers of Advent I" (the SECOND run). + 2. The Missale's own "HEBDOMADA I 'PER ANNUM'" heading (extracted line + 12050: "Dominica prima 'per annum' fit festum Baptismatis Domini") -- + the Baptism of the Lord Sunday IS, positionally, "Dominica I" of + Ordinary Time's own week-numbering scheme, even though its SEASON, per + n. 33, is still Christmas. The very next heading in the Missal is + literally "DOMINICA II 'PER ANNUM'" -- confirming the first run's + numbering begins counting from that Sunday, landing the run's own + first NUMBERED Sunday (the one actually inside Ordinary Time's season) + on week 2. + 3. The Missale's own "HEBDOMADA XXXIV 'PER ANNUM'" heading (extracted + line 13099: "Dominica ultima 'per annum' fit sollemnitas ... + universorum Regis") -- the LAST Sunday before Advent I, Christ the + King, is ALWAYS week XXXIV. Confirmed structurally, not merely + asserted: nothing in the Missale computes Christ the King's own date + from a week number at all -- it is defined independently, as "the + Sunday nearest 30 November, minus 7 days" (this file's own + [christ_the_king]) -- so this heading is a genuine, independently + falsifiable claim, not a tautology. + + Given (1)-(3), the FIRST run's week numbers follow the ordinary + Sunday-aligned [floor_div] formula from origin {!baptism_of_the_lord}, + uninterrupted until Ash Wednesday cuts it off (fact 2 pins the origin; + nothing further is needed for this half). The SECOND run cannot use the + same simple formula with a fixed origin, because fact 3 is a CONSTRAINT + on where the run must END, not a statement of where it begins -- and + Normae n. 43 itself says the total is "thirty-three OR thirty-four" + weeks, meaning the gap between where the first run stops and where the + second run's own numbers would need to start (for the run to still end on + 34) is not constant across years. The only value consistent with facts 1 + and 3 simultaneously is computed BACKWARD from Christ the King: number the + second run's own weeks, Sunday-aligned, counting forward from Pentecost + Sunday as if it were itself week 0 (a "raw" count with no liturgical + meaning of its own), find that raw count for the FINAL week (Christ the + King's own week), and shift every raw number in the run by the constant + amount that makes the final one read 34. That shift is not cosmetic the + way EF's own analogous "n - total + 7" resumed-tail relabelling + (Rite_ef.Temporal_ef.sunday_slug) is -- there, the underlying [week] FIELD + stays the raw, uncapped Pentecost count, and only the SLUG string is + relabelled, because EF's numbering carries no rubrical meaning past + Time_after_pentecost's own raw count. Here the adjusted number IS the + liturgical week identity itself (it selects which Mass formulary applies, + per the Missale's own week headings), so [week] itself, not merely a + slug, must carry the adjusted value. + + EVIDENCE this produces the right shape (empirically verified, not merely + argued, across every one of the 8 417 years 1583..9999 with a small + throwaway script reproducing this exact arithmetic): the two runs never + overlap (no year assigns the same week number to two different Sundays), + every number produced falls in 1..34 inclusive, and the gap between the + first run's own last week and the second run's own first week is ALWAYS + either 0 (all 34 weeks used, no skip) or 1 (exactly one week number + skipped that year, used by neither run) -- never more, never negative -- + which is exactly Normae n. 43's own "thirty-three OR thirty-four", with + "34" corresponding to gap 0 and "33" to gap 1. This IS "in some years a + week is skipped entirely" (the task brief's own framing), now measured: + 2 672 of the 8 417 years use all 34; 5 745 skip exactly one. *) +let ordinary_time_week d y easter = + let baptism = baptism_of_the_lord y in + let ash_wednesday = Date.add_days easter (-46) in + if before d ash_wednesday then + let n = floor_div (days_between baptism d) 7 + 1 in + if n < 1 then None else Some n + else + let pentecost = Date.add_days easter 49 in + let ctk = christ_the_king y in + let raw_total = floor_div (days_between pentecost ctk) 7 + 1 in + let raw_n = floor_div (days_between pentecost d) 7 + 1 in + let adjusted = 34 - raw_total + raw_n in + if adjusted < 1 || adjusted > 34 then None else Some adjusted + +let week d = + let y = Date.year d in + let easter = Computus.gregorian_easter y in + match season d with + | Christmas -> None + | Advent -> + let n = floor_div (days_between (advent_start y) d) 7 + 1 in + if n < 1 then None else Some n + | Lent -> + let n = floor_div (days_between (Date.add_days easter (-42)) d) 7 + 1 in + if n < 1 then None else Some n + | Easter -> + let n = floor_div (days_between easter d) 7 + 1 in + if n < 1 then None else Some n + | Ordinary_time -> ordinary_time_week d y easter + +(* Sunday slugs. Christmas needs its own three-way dispatch (the season has + no week numbering at all, and carries up to three distinct movable + Sundays a year -- {!holy_family}, {!second_sunday_of_christmas} and + {!baptism_of_the_lord} -- every OTHER season's Sundays use the generic + week-numbered form. A Sunday {!named} already intercepts (Palm/Passion + Sunday, Easter, Ascension is never a Sunday, Pentecost, Trinity, Corpus + Christi is never a Sunday, Christ the King) never reaches this function at + all, since {!temporal}'s own dispatch checks [named] first. *) +let sunday_slug d = + if Date.weekday d <> Date.Sun then None + else + let y = Date.year d in + let s = season d in + match s with + | Christmas -> + if same d (holy_family y) then Some "of-holy-family" + else if second_sunday_of_christmas y = Some d then Some "of-christmas-sunday-2" + else if same d (baptism_of_the_lord y) then Some "of-baptism-of-the-lord" + else None (* unreachable: every Christmas-season Sunday is one of the three above *) + | _ -> ( + match week d with + | Some n -> Some (Printf.sprintf "of-%s-sunday-%d" (season_slug_word s) n) + | None -> None) + +(* Ferial slugs within Christmas time. Three disjoint stretches, numbered + 0/1/2 exactly like Rite_ef.Temporal_ef.christmastide_feria_slug's own + three (a real structural parallel between the two rites' Christmas + seasons, not a copied convention) -- needed for the identical reason: a + single "no week numbering" slug key would let the same weekday recur + across stretches within one liturgical year, violating slug uniqueness + (spec's own requirement, {!Colitur_kernel.Validate}'s ["slugs"] check). + - 26-31 December (minus {!holy_family}, when it lands there, already + intercepted earlier): "of-christmas-0-<weekday>". + - 2-5 January (minus {!second_sunday_of_christmas}, when it exists): + "of-christmas-1-<weekday>". + - 7 January through the day before {!baptism_of_the_lord} (0 to 6 days, + empty exactly when Epiphany falls on a Saturday): "of-christmas-2-<weekday>". *) +let christmas_feria_slug d y = + let m = Date.month d and dd = Date.day d in + let w = weekday_word d in + if m = 12 && dd >= 26 && dd <= 31 then Some (Printf.sprintf "of-christmas-0-%s" w) + else if m = 1 && dd >= 2 && dd <= 5 then Some (Printf.sprintf "of-christmas-1-%s" w) + else if m = 1 && dd >= 7 && before d (baptism_of_the_lord y) then Some (Printf.sprintf "of-christmas-2-%s" w) + else None + +let id = "of" + +let temporal d = + let y = Date.year d in + let s = season d in + let weekday = Date.weekday d in + let build ?(subject = Subject.Temporal) ?(names = Names.empty) ~season ~slug ~colour ~rank ~week () = + let office = Celebration.make ~slug:(Slug.of_string_exn slug) ~rank ~colour ~subject ~names ~layer:"temporal" () in + { Temporal.season; week; weekday; office } + in + match named d with + | Some (season, slug, colour, rank) -> build ~season ~slug ~colour ~rank ~week:(week d) () + | None -> ( + match sunday_slug d with + | Some slug -> + let colour = if is_rose_sunday d s then Colour.Rose else season_colour s in + let subject, names, rank = + if same d (holy_family y) then (Subject.Lord, holy_family_names, Festum) + (* Tabula entry 6 ("Dominicae temporis Nativitatis") would + already give an ordinary Christmas-time Sunday Festum; Holy + Family's own grade word in the calendarium ("Festum") happens + to agree, so no separate table-entry citation is needed for + the RANK itself, only for the identity override. *) + else if second_sunday_of_christmas y = Some d then (Subject.Temporal, Names.empty, Festum) + else if same d (baptism_of_the_lord y) then (Subject.Lord, baptism_names, Festum) + else + (* Tabula entry 2 ("Dominicae Adventus, Quadragesimae et + Paschae") vs. entry 6 ("dominicae 'per annum'") -- the ONLY + remaining case reaching this branch is a plain, unnamed + Sunday of Advent, Lent, Easter or Ordinary Time (every + Christmas Sunday is already one of the three branches + above). *) + let rank = match s with Advent | Lent | Easter -> Sollemnitas | Ordinary_time | Christmas -> Festum in + (Subject.Temporal, Names.empty, rank) + in + build ~subject ~names ~season:s ~slug ~colour ~rank ~week:(week d) () + | None -> ( + match christmas_feria_slug d y with + | Some slug -> build ~season:s ~slug ~colour:(season_colour s) ~rank:Feria ~week:(week d) () + | None -> + let easter = Computus.gregorian_easter y in + let after_ashes = days_between easter d in + if after_ashes >= -45 && after_ashes <= -43 then + (* Thursday/Friday/Saturday after Ash Wednesday: proper + Masses, but before Lent's own week-1 origin -- no week + number, mirroring Rite_ef.Temporal_ef's identical gap. *) + build ~season:s + ~slug:(Printf.sprintf "of-lent-after-ashes-%s" (weekday_word d)) + ~colour:Colour.Violet ~rank:Feria ~week:None () + else + let week_n = week d in + let slug = + Printf.sprintf "of-%s-%d-%s" (season_slug_word s) (Option.value week_n ~default:0) (weekday_word d) + in + let colour = + if after_ashes = -3 then + (* Holy Thursday (Missa in Cena Domini): IGMR n. 346(a)'s + own general clause, "insuper in celebrationibus + Domini, quae non sint de eius Passione" -- a + celebration OF THE LORD that is not of his Passion + (the institution of the Eucharist and the + priesthood, distinct from Good Friday's own Passion + commemoration) -- white. No DAY-SPECIFIC "color + albus" rubric was found in the extracted text for + this exact Mass (unlike some other Masses in the same + document); this is the best-supported general-clause + reading, flagged rather than presented as a + day-specific citation, the same honesty [named]'s own + Nativity Vigil colour note above gives. *) + Colour.White + else if after_ashes = -2 then + (* Good Friday: IGMR n. 346(b), "Color ruber adhibetur + ... in celebrationibus Passionis Domini" -- red, not + Lent's own season violet. *) + Colour.Red + else + (* Holy Saturday's own daytime (after_ashes = -1) is + aliturgical -- no Mass, hence no colour rubric to find + in the primary text at all -- and every other Lenten + feria has none either; both default to the season's + own violet, the textually conservative choice rather + than an invented specific one. *) + season_colour s + in + build ~season:s ~slug ~colour ~rank:Feria ~week:week_n ())) + +(* Independent restatement of {!named}'s fixed and Easter-relative dates, + plus {!holy_family}, {!second_sunday_of_christmas} (when it exists that + year) and {!baptism_of_the_lord}, paired with the slug each carries -- + the same anchor-agreement discipline Rite_ef.Temporal_ef.anchors follows, + for the identical reason (catches an accidental single-site drift, e.g. an + offset silently changing, rather than leaving it invisible). Easter's own + six weekday octave days are included via the same [1;2;3;4;5;6] offset + list [named] itself uses, restated independently rather than reused, for + the same "independent" discipline the rest of this list follows. *) +let anchors y = + let easter = Computus.gregorian_easter y in + let off n = Date.add_days easter n in + [ ("of-nativity-vigil", mk y 12 24); + ("of-nativity", mk y 12 25); + ("of-mary-mother-of-god", mk y 1 1); + ("of-epiphany", mk y 1 6); + ("of-holy-family", holy_family y); + ("of-baptism-of-the-lord", baptism_of_the_lord y); + ("of-ash-wednesday", off (-46)); + ("of-palm-sunday", off (-7)); + ("of-easter-sunday", off 0) ] + @ List.map (fun n -> (Printf.sprintf "of-easter-octave-day-%d" (n + 1), off n)) [ 1; 2; 3; 4; 5; 6 ] + @ [ ("of-ascension", off 39); + ("of-pentecost", off 49); + ("of-trinity", off 56); + ("of-corpus-christi", off 60); + ("of-christ-the-king", christ_the_king y) ] + @ (match second_sunday_of_christmas y with + | Some d -> [ ("of-christmas-sunday-2", d) ] + | None -> []) + +(* Compile-time check that this module satisfies the kernel's rite contract + -- the same check Rite_ef.Temporal_ef ends with. Deliberately the ONLY + kernel-facing signature this phase satisfies: {!Colitur_kernel.Rite.t} + itself (precedence, transfers, readings) is Phase 2's own deliverable, per + the task brief's explicit "do not add a Rite.t for it". *) +module _ : Colitur_kernel.Temporal.RITE = struct + let id = id + + type season = Vocab_of.season + type rank = Vocab_of.rank + + let vocab = Vocab_of.vocab + let year_start = year_start + let temporal = temporal +end diff --git a/lib/rites/rite_of/temporal_of.mli b/lib/rites/rite_of/temporal_of.mli new file mode 100644 index 0000000..982ff05 --- /dev/null +++ b/lib/rites/rite_of/temporal_of.mli @@ -0,0 +1,141 @@ +(** The OF (post-1970) temporal cycle, per the Missale Romanum editio typica + tertia (2002) "Normae universales de anno liturgico et de calendario" + ("Normae n. N") and the Institutio Generalis Missalis Romani ("IGMR + n. N") -- the same PDF carries both documents, independently numbered + from 1, so every citation in this rite module names which one it is. + + OPEN QUESTION, deliberately NOT settled here (design + 2026-08-24-colitur-of-rite-module-design.md §8.1): the OF calendar has + no meaning before 1970, but colitur's kernel domain is 1583..9999, and + this module is computable -- and computed -- across the WHOLE of it, + exactly as {!Rite_ef.Temporal_ef} is. Phase 1 takes no position on + whether a pre-1970 (or, symmetrically, a far-future) answer from this + module means anything liturgically; it only guarantees the arithmetic is + total and the properties below hold everywhere the kernel itself is + total. Refusing, extrapolating, or flagging pre-1970 output specially is + a decision for the phase that wires this module into a {!Colitur_kernel + .Rite.t} and a validation layer with a real oracle to check it + against -- not this one. *) + +open Colitur_kernel + +(** Normae n. 40: "Tempus Adventus incipit a I Vesperis dominicae quae + incidit in diem 30 novembris vel est huic vicinior" -- Advent begins with + First Vespers of the Sunday falling on 30 November or nearest to it. + Worded identically in substance to EF's own RG 20 ({!Rite_ef.Temporal_ef + .advent_start}), so the same closed-form identity applies: the Sunday + nearest 30 November is, equivalently, three weeks before the last Sunday + on or before 24 December -- see that function's own citation for why + that identity holds for every civil year with no case split. *) +val advent_start : int -> Date.t + +(** First day of the liturgical year opening in civil year [y]. Same as + {!advent_start}. *) +val year_start : int -> Date.t + +val season : Date.t -> Vocab_of.season + +(** Normae n. 38 and the Calendarium Romanum Generale's own January table + (extracted line ~4033: "Dominica post diem 6 ianuarii: In baptismate + Domini Festum"): the Sunday falling AFTER 6 January (never 6 January + itself, even in a year 6 January IS a Sunday -- "post", not "on or + after") carries the feast of the Baptism of the Lord. The January + table's own further note ("Ubi sollemnitas Epiphaniae ad dominicam + transfertur... festum Baptismatis Domini celebratur feria secunda + sequenti") only concerns places that exercise Normae n. 37's LOCAL + option to move Epiphany itself off 6 January -- inapplicable to the + universal calendar this module computes, which keeps Epiphany fixed at + 6 January (spec's own EF-precedented "universal calendar only" + discipline), so that Monday-shift clause is never reached here. *) +val baptism_of_the_lord : int -> Date.t + +(** Normae n. 35(a) and the December calendarium table's own closing line + (extracted line ~4459: "Dominica infra octavam Nativitatis, vel, ea + deficiente, die 30 decembris: Sanctae Familiae ... Festum"): the Sunday + falling within the Octave of the Nativity (26-31 December), or, that + lacking, 30 December. Movable-with-a-fixed-fallback, the same shape as + EF's own Holy Family/Holy Name ({!Rite_ef.Temporal_ef.holy_family_sunday} + /[holy_name_sunday]) -- CODE for that reason, not sanctoral DATA, unlike + the plain fixed-date entries this window also contains (Stephen 26 Dec, + John 27 Dec, the Holy Innocents 28 Dec), which carry no such fallback + logic and are deferred to Phase 3's calendar data instead (see this + file's own top-of-module comment for the full CODE-vs-DATA argument). + UNLIKE EF's 7-13 January window, which can never be empty of a Sunday, + this 6-day window (26-31 December) CAN be -- confirmed by the fallback + clause's own existence in the primary text, not merely inferred. *) +val holy_family : int -> Date.t + +(** Normae n. 36: "Dominica a die 2 ad diem 5 ianuarii occurrens est + Dominica II post Nativitatem" -- the Sunday falling 2-5 January, if any, + is the Second Sunday after the Nativity. [None] when no such Sunday + exists that year (the SAME 2-5 January window as EF's own Holy Name of + Jesus, {!Rite_ef.Temporal_ef.holy_name_sunday} -- a real structural + coincidence between the two rites' calendars, not a shared computation: + OF's Normae carries no "otherwise, on a fixed date" fallback for this + Sunday at all, unlike EF's RG 17(a) -- a year without one simply has no + "Second Sunday after the Nativity" office; {!temporal}'s own dispatch + falls through to an ordinary Christmas-time feria for every day of that + window in such a year). *) +val second_sunday_of_christmas : int -> Date.t option + +(** Normae n. 43-44 and the Missale's own "HEBDOMADA XXXIV 'PER ANNUM'" + heading (extracted line 13099: "Dominica ultima 'per annum' fit + sollemnitas ... universorum Regis"): the LAST Sunday before Advent I, + always the Solemnity of Christ the King, always week XXXIV. See + {!temporal}'s own citation on the two-block week arithmetic for the full + derivation this anchors. *) +val christ_the_king : int -> Date.t + +(** The named temporal days: the Nativity and its Vigil, Mary Mother of God + (the Nativity's own Octave Day, 1 January), Epiphany, Ash Wednesday, + Palm/Passion Sunday, Easter and the days of its Octave, Ascension, + Pentecost, Trinity Sunday, Corpus Christi, and Christ the King. Returns + (season, slug, colour, rank). Carries no week of its own, for the same + reason {!Rite_ef.Temporal_ef.named} does not: {!temporal} computes it + uniformly via {!week} for every day, named or not, so a named day inside + a numbered season run always carries that run's week. + + Deliberately EXCLUDES {!holy_family}, {!second_sunday_of_christmas} and + {!baptism_of_the_lord}: each needs a per-year conditional ([holy_family] + on whether 26-31 December has a Sunday at all; the other two on which + Sunday, if any, actually falls in their own window) that this function's + bare [Date.t -> ... option] shape has no way to express without + threading extra state through every other branch too -- the exact + reason EF's own [named] excludes its structurally identical Holy + Family/Holy Name. {!temporal} applies all three as its own targeted + dispatch instead. *) +val named : Date.t -> (Vocab_of.season * string * Colour.t * Vocab_of.rank) option + +(** Week within the season, 1-indexed, Sunday-aligned (constant across a + Sunday-to-Saturday span). [None] outside every numbered run -- Christmas + has none at all (Normae's own Christmas-season structure is date-keyed, + never week-keyed: contrast n. 36's "the Sunday falling 2-5 January", a + date range, against n. 30's own "Sundays I, II, III..." for Lent) -- and + Ordinary Time's own numbering is total over both of its runs (Normae + n. 43-44): see {!temporal}'s own citation for the two-block arithmetic + that makes the second run's numbers land correctly on 1..34 with the + final week always 34, INCLUDING the "in some years a week is skipped + entirely" case Normae n. 43's own "thirty-three OR thirty-four" already + names. *) +val week : Date.t -> int option + +(** The slug for a Sunday, or [None] if [d] is not a Sunday. *) +val sunday_slug : Date.t -> string option + +val id : string + +(** Total over 1583..9999: every date yields exactly one temporal identity + (subject to this file's own top-of-module note on what "yields" means + before 1970). *) +val temporal : Date.t -> (Vocab_of.season, Vocab_of.rank) Temporal.t + +(** Independent restatement of {!named}'s fixed and Easter-relative dates, + plus {!holy_family}, {!second_sunday_of_christmas} and + {!baptism_of_the_lord}, for civil year [y], paired with the slug each + should carry -- the same anchor-agreement discipline + {!Rite_ef.Temporal_ef.anchors} follows, for the same reason: catches an + accidental single-site drift in an offset rather than leaving it + invisible. Not wired into {!Colitur_kernel.Validate.run} in this phase + (that needs a full {!Colitur_kernel.Rite.t}, Phase 2's own deliverable), + but kept in the same shape so that wiring is a straight reuse. *) +val anchors : int -> (string * Date.t) list diff --git a/lib/rites/rite_of/vocab_of.ml b/lib/rites/rite_of/vocab_of.ml new file mode 100644 index 0000000..932c30f --- /dev/null +++ b/lib/rites/rite_of/vocab_of.ml @@ -0,0 +1,155 @@ +(* OF (post-1970) temporal cycle vocabulary. Both types are closed variants + private to this rite: EF code cannot name them, and this rite cannot name + EF's. Every boundary and rank rule cites its Missale Romanum editio typica + tertia (2002) "Normae universales de anno liturgico et de calendario" + paragraph ("Normae n. N") or Institutio Generalis Missalis Romani + paragraph ("IGMR n. N") -- the SAME PDF (docs/research/of/missale- + romanum-2002.pdf) carries both documents, independently numbered from 1, + so a bare "n. N" is ambiguous; every citation in this rite module names + which document it is. *) + +(* Normae Titulus II ("De anni circulo"), sections II-VI, PRIMARY-SOURCE- + VERIFIED against the 2002 typical edition (docs/research/of/ + missale-romanum-2002.pdf, pdftotext -layout, around extracted line 3660 + onward): the document's own six subsection headings under "De anni + circulo" are "I. De Triduo paschali", "II. De tempore paschali", "III. De + tempore Quadragesimae", "IV. De tempore Nativitatis", "V. De tempore + Adventus", "VI. De tempore 'per annum'". FIVE of those six are literally + called a "tempus" (season); the Triduum is deliberately NOT -- it is + named only "Triduum paschale", never "tempus Tridui". That is a real + textual signal, not an omission this module is working around: the + Missal's own authors did not count the Triduum as one of the seasons a + day's season vocabulary needs to name. Confirmed independently by the + Missal's own Mass-propers structure (extracted lines ~7778, ~8480): + "HEBDOMADA SANCTA" (the Lenten Holy Week propers) and "SACRUM TRIDUUM + PASCHALE" are printed as two SEPARATE section headings, and neither is + titled "tempus" either. + + This module therefore has FIVE seasons, matching the design's own + prediction (2026-08-24-colitur-of-rite-module-design.md §4.2): [Advent], + [Christmas], [Lent], [Easter], [Ordinary_time]. No [Septuagesima] (the + 1969/2002 reform abolished the pre-Lent season the EF's Vocab_ef still + carries -- Normae's own season list has no seventh "de tempore + Septuagesimae" section at all, confirmed by its absence here) and no + [Passiontide] (EF's separate season for the two weeks before Easter; the + 2002 Normae's own n. 30 merges what used to be "Passion Sunday" and "Palm + Sunday" into ONE day, "Dominica in palmis de Passione Domini", and folds + it into Lent's own week numbering as week VI -- see [temporal_of.ml]'s own + citation on this for the full argument). + + WHERE THE TRIDUUM'S OWN THREE DAYS LAND, given they get no season of + their own: Normae n. 28, PRIMARY TEXT: "Tempus Quadragesimae decurrit a + feria IV Cinerum ad Missam in Cena Domini EXCLUSIVE" -- Lent runs from Ash + Wednesday up to (excluding) the evening Mass of the Lord's Supper. At + colitur's own civil-day granularity (one season per [Date.t], never a + sub-day boundary), that puts the WHOLE civil day of Holy Thursday inside + Lent (the excluded boundary is the Mass itself, an event within that day, + not the day's own start). Good Friday and Holy Saturday have no season of + their own to fall back to either -- n. 22/23 fix Easter Time's own start + at "dominica Resurrectionis" (Easter SUNDAY), not a day earlier -- so by + the same "extend the last season through the Triduum's daytime, since the + only actual Mass in that window (the Vigil) is textually already Easter" + reasoning EF's own temporal_ef.ml already uses for its own Passiontide + ("Holy Saturday stays in Passiontide: the Vigil is a night Mass"), Good + Friday and Holy Saturday both stay [Lent] here too. Normae n. 30 gives + this a SECOND, independent, and more direct textual anchor unavailable to + EF's own analogous decision: "Dominicae huius temporis appellantur + dominicae I, II, III, IV, V in Quadragesima. Dominica sexta, in qua + initium sumit Hebdomada sancta, dicitur ... 'Dominica in palmis de + Passione Domini'" -- the Sundays of THIS TIME [Lent] are called Sundays + I-V in Lent; the SIXTH Sunday, ON WHICH HOLY WEEK BEGINS, is called + [without dropping the 'Alleluia', a rubric not relevant here] "Palm + Sunday of the Lord's Passion". Normae's OWN prose therefore states that + Holy Week (Palm Sunday through the Vigil) IS Lent's own sixth week, not a + thing outside Lent's own numbering -- confirmed against + [temporal_of.ml]'s own [week] computation, which independently derives + the identical result (Palm Sunday through Holy Saturday all fall in week + 6 of Lent by the ordinary Sunday-aligned [floor_div] formula, with no + special case needed for the Triduum days at all) -- see that file for the + arithmetic. *) +type season = Advent | Christmas | Lent | Easter | Ordinary_time [@@deriving sexp] + +(* Normae Titulus I ("De diebus liturgicis"), and the Tabula dierum + liturgicorum's own 13-entry table (extracted lines ~3926-3980), name FOUR + graded celebrations throughout: "Sollemnitas" (entries 1-4), "Festum" + (entries 5-8), "Memoria obligatoria" (entries 10-11) and "Memoria ad + libitum" (entry 12) -- confirmed against the Calendarium Romanum + Generale's own printed month tables (e.g. "IN EPIPHANIA DOMINI + Sollemnitas", "S. Raimundi de Penyafort, presbyteri" [no grade word: + Memoria ad libitum by the table's own footnote, "Quando non indicatur + gradus celebrationis, fit Memoria ad libitum"], "Ss. Stephani, + protomartyris Festum"), which uses these four words as its own grade + column, verbatim, for every entry. + + A FIFTH constructor, [Feria], is added beyond those four for an ordinary + weekday -- not a fifth grade on the same Sollemnitas-Festum-Memoria + scale, but a categorically different thing: Normae n. 16 (Titulus I.IV, + "De feriis") calls these days "feriae" and never applies any of the four + grade-words to one, yet {!Colitur_kernel.Celebration.t} requires SOME + [rank] on every day (the same reason EF's own Vocab_ef.rank carries a + catch-all [Class4] for its own plain ferias, RG 91 entry 28). The Tabula + itself confirms ferias are graded for PRECEDENCE without ever being + promoted to one of the four celebration-grades: entry 2 lists "Feriae + Hebdomadae sanctae, a feria II ad feriam V inclusive" and "Feria IV + Cinerum" [Ash Wednesday] at the SAME table position as Christmas, + Epiphany, Ascension and Pentecost -- an extremely privileged PRECEDENCE, + yet the table's own word for these days stays "feria", never + "sollemnitas". Entry 9 similarly places "Feriae Adventus a die 17 ad 24 + decembris inclusive" and "Feriae Quadragesimae" together with a + THIRD kind of day (unnamed days within the Nativity octave), and entry 13 + is the catch-all for every other feria. All THREE entries use the same + word, "feria" -- what differs between them is precedence-table position, + not grade. Phase 1 (this module, {!Temporal_of.temporal}) therefore + assigns [Feria] uniformly to every day carrying no graded celebration; + which Tabula entry a given [Feria] day occupies (Ash-Wednesday-tier vs. + Advent-17-24/Lenten-tier vs. ordinary) is a {!Colitur_kernel.Precedence + .rules.band} table lookup left to Phase 2, read off the day's own season/ + date/weekday the same way EF's own [Precedence_ef.band] already + distinguishes its RG 91 entry 2 Triduum ferias from its entry-28 ordinary + ones without either of those two needing a DIFFERENT [Vocab_ef.rank] + value -- see design 2026-08-24-colitur-of-rite-module-design.md §3, "No + kernel change should be needed for the ranks themselves". *) +type rank = Sollemnitas | Festum | Memoria_obligatoria | Memoria_ad_libitum | Feria [@@deriving sexp] + +let seasons = [ Advent; Christmas; Lent; Easter; Ordinary_time ] +let ranks = [ Sollemnitas; Festum; Memoria_obligatoria; Memoria_ad_libitum; Feria ] + +let season_to_string = function + | Advent -> "advent" + | Christmas -> "christmas" + | Lent -> "lent" + | Easter -> "easter" + | Ordinary_time -> "ordinary-time" + +let season_of_string = function + | "advent" -> Some Advent + | "christmas" -> Some Christmas + | "lent" -> Some Lent + | "easter" -> Some Easter + | "ordinary-time" -> Some Ordinary_time + | _ -> None + +(* No lectionary-legacy word to preserve (spec §4.4's reasoning for EF's own + [Vocab_ef.season_slug_word] does not apply here -- OF has not been + bootstrapped from any external lectionary key set yet), so this is simply + [season_to_string] under a separate name, kept distinct only so a future + real divergence does not force renaming every call site. *) +let season_slug_word = season_to_string + +let rank_to_string = function + | Sollemnitas -> "sollemnitas" + | Festum -> "festum" + | Memoria_obligatoria -> "memoria-obligatoria" + | Memoria_ad_libitum -> "memoria-ad-libitum" + | Feria -> "feria" + +let rank_of_string = function + | "sollemnitas" -> Some Sollemnitas + | "festum" -> Some Festum + | "memoria-obligatoria" -> Some Memoria_obligatoria + | "memoria-ad-libitum" -> Some Memoria_ad_libitum + | "feria" -> Some Feria + | _ -> None + +let vocab : (season, rank) Colitur_kernel.Vocab.t = + { seasons; season_to_string; season_of_string; ranks; rank_to_string; rank_of_string } diff --git a/lib/rites/rite_of/vocab_of.mli b/lib/rites/rite_of/vocab_of.mli new file mode 100644 index 0000000..dd23cfa --- /dev/null +++ b/lib/rites/rite_of/vocab_of.mli @@ -0,0 +1,58 @@ +(** OF (post-1970) season and rank vocabulary. *) + +type season = + | Advent + | Christmas + | Lent + | Easter + | Ordinary_time +[@@deriving sexp] + +(** Normae universales de anno liturgico et de calendario (Missale Romanum + editio typica tertia, 2002), Titulus I ("De diebus liturgicis"), and the + Institutio Generalis Missalis Romani (IGMR) n. 346's own colour-rule + prose, both cite the four graded celebrations by these exact names: a + Sunday-or-weekday MYSTERY of the Lord that ranks above everything else + ([Sollemnitas]), a lesser but still universally-binding celebration + ([Festum]), a saint's day the calendar obliges everyone to keep + ([Memoria_obligatoria]), and one a community may keep or not + ([Memoria_ad_libitum]). + + A FIFTH constructor, [Feria], is added beyond those four -- not a fifth + grade on the same scale, but a different kind of thing: an ordinary + weekday carries none of the four (Normae Titulus I.IV n. 16 calls these + days "feriae", never a "celebratio" of any grade), yet + {!Colitur_kernel.Celebration.t} requires a [rank] on every day the way + {!Colitur_kernel.Vocab_ef}'s own catch-all [Class4] does for EF. Ferias + are graded for PRECEDENCE (privileged Lenten/Advent ferias outrank an + ordinary one, per the Tabula dierum liturgicorum's own entries 2, 9 and + 13) but that grading is a {!Colitur_kernel.Precedence.rules.band} table + lookup (Phase 2), not a distinct [rank] value -- unlike EF, where + [Class2]/[Class3]/[Class4] carry a privileged feria's own grade directly. + See vocab_of.ml's own top-of-file comment for the primary-source + citations and the design decision this rests on. *) +type rank = + | Sollemnitas + | Festum + | Memoria_obligatoria + | Memoria_ad_libitum + | Feria +[@@deriving sexp] + +val seasons : season list +val ranks : rank list +val season_to_string : season -> string +val season_of_string : string -> season option + +(** The word used when building a slug: lowercase, hyphenated, e.g. + ["ordinary-time"] for [Ordinary_time]. Unlike {!Colitur_kernel.Vocab_ef + .season_slug_word}, this is not adopted from any external lectionary -- + OF has no bootstrapped-from-lectio slug legacy to preserve -- so it is + simply {!season_to_string}'s own hyphenated image; kept as a separate + function anyway so a future divergence (a real lectionary source using + different words) does not require renaming every call site. *) +val season_slug_word : season -> string + +val rank_to_string : rank -> string +val rank_of_string : string -> rank option +val vocab : (season, rank) Colitur_kernel.Vocab.t @@ -1,6 +1,6 @@ (test (name test_colitur) - (libraries colitur_kernel colitur_naming colitur_render colitur_citation rite_ef alcotest qcheck qcheck-alcotest sexplib) + (libraries colitur_kernel colitur_naming colitur_render colitur_citation rite_ef rite_of alcotest qcheck qcheck-alcotest sexplib) (deps ../data/ef/sanctoral.sexp ../data/ef/adjustments.sexp diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 9eefecd..3721f5a 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -11,7 +11,8 @@ let () = Test_citation.render_suite; ("sigla", Test_citation.sigla_suite); Test_config.suite; - Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; + Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_temporal_of.suite; Test_validate.suite; + Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; Test_rubrics_ef.suite; Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; diff --git a/test/test_temporal_of.ml b/test/test_temporal_of.ml new file mode 100644 index 0000000..7560413 --- /dev/null +++ b/test/test_temporal_of.ml @@ -0,0 +1,393 @@ +(* 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)) + +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 + 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 + done + +(* 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 "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 ) |