diff options
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.ml | 78 | ||||
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.mli | 12 | ||||
| -rw-r--r-- | test/test_temporal_ef.ml | 56 |
3 files changed, 145 insertions, 1 deletions
diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml index 2575c26..9e8bcc4 100644 --- a/lib/rites/rite_ef/temporal_ef.ml +++ b/lib/rites/rite_ef/temporal_ef.ml @@ -105,3 +105,81 @@ let named d = else if same d (christ_the_king y) then Some (Time_after_pentecost, "ef-christ-the-king", Colour.White, Class1, None) else None + +let days_between a b = Date.to_rata b - Date.to_rata a + +(* Floor division. OCaml's [/] truncates toward zero, so a date before a + season's week origin would round up into week 1 instead of falling out of the + numbering: Ash Wednesday is 4 days before the Lent I origin, and -4/7 = 0 + would make it week 1. *) +let floor_div a b = if a >= 0 then a / b else ((a + 1) / b) - 1 + +(* The Sunday on which week 1 of a season begins. Every origin is a Sunday, so + week numbers are constant Sunday-to-Saturday. + + Christmastide has no numbered weeks. Time after Epiphany counts from the + first Sunday after Epiphany -- which itself falls 7-13 January and is + therefore inside Christmastide (RG 72-73), so the season's own days start + part-way through week 1. Time after Pentecost counts from Pentecost, making + Trinity Sunday the first Sunday after Pentecost. *) +let week_origin s y = + let easter = Computus.gregorian_easter y in + match s with + | Advent -> Some (advent_start y) + | Christmastide -> None + | Time_after_epiphany -> Some (Date.add_days (sunday_on_or_before (mk y 1 6)) 7) + | Septuagesima -> Some (Date.add_days easter (-63)) + | Lent -> Some (Date.add_days easter (-42)) (* Lent I Sunday *) + | Passiontide -> Some (Date.add_days easter (-14)) + | Paschaltide -> Some easter + | Time_after_pentecost -> Some (Date.add_days easter 49) (* Pentecost *) + +let week d = + let s = season d in + match week_origin s (Date.year d) with + | None -> None + | Some origin -> + let n = floor_div (days_between origin d) 7 in + let n = match s with Time_after_pentecost -> n | _ -> n + 1 in + if n < 1 then None else Some n + +(* Sunday slugs. These are lectionary keys: they use [season_slug_word], and for + Christmastide they keep lectio's keys even though colitur's season differs + (spec §4.4 -- slugs are opaque keys, not truth). *) +let sunday_slug d = + if Date.weekday d <> Date.Sun then None + else + let y = Date.year d in + let m = Date.month d and dd = Date.day d in + let s = season d in + match s with + | Christmastide -> + if m = 12 && dd >= 26 then Some "ef-christmas-sunday-0" + else if m = 1 && dd >= 7 && dd <= 13 then + (* 1st Sunday after Epiphany (Holy Family). Season is Christmastide per + RG 72-73; the key stays lectio's. *) + Some "ef-time-after-epiphany-sunday-1" + else if m = 1 && dd >= 2 && dd <= 5 then + (* Most Holy Name of Jesus. Colitur slug -- lectionary gap; confirm the + placement against MR1962 while coding (register §6). *) + Some "ef-holy-name-sunday" + else None + | Time_after_pentecost -> ( + let easter = Computus.gregorian_easter y in + let pentecost = Date.add_days easter 49 in + let last_sunday = Date.add_days (advent_start y) (-7) in + let n = days_between pentecost d / 7 in + if same d last_sunday then + (* The last Sunday before Advent always keeps the 24th (Last) Mass. *) + Some "ef-time-after-pentecost-sunday-24" + else if n > 23 then + (* Surplus Sundays resume the Sundays after Epiphany that Septuagesima + cut short -- the highest-numbered ones, so the 6th sits just before + the Last. *) + let total = days_between pentecost last_sunday / 7 in + Some (Printf.sprintf "ef-time-after-epiphany-sunday-%d" (n - total + 7)) + else Some (Printf.sprintf "ef-time-after-pentecost-sunday-%d" n)) + | _ -> ( + match week d with + | Some n -> Some (Printf.sprintf "ef-%s-sunday-%d" (season_slug_word s) n) + | None -> None) diff --git a/lib/rites/rite_ef/temporal_ef.mli b/lib/rites/rite_ef/temporal_ef.mli index 0a9656a..46187c9 100644 --- a/lib/rites/rite_ef/temporal_ef.mli +++ b/lib/rites/rite_ef/temporal_ef.mli @@ -18,3 +18,15 @@ val christ_the_king : int -> Date.t the Octave of the Nativity. Returns (season, slug, colour, rank, week). *) val named : Date.t -> (Vocab_ef.season * string * Colour.t * Vocab_ef.rank * int option) option + +(** The Sunday on which week 1 of a season begins, in civil year [y]. [None] for + [Christmastide], which has no numbered weeks. *) +val week_origin : Vocab_ef.season -> int -> Date.t option + +(** Week within the season. Sunday-aligned, so it is constant Sunday-to-Saturday. + The origin is season-specific: time after Pentecost counts from Pentecost, + time after Epiphany from the first Sunday after Epiphany. *) +val week : Date.t -> int option + +(** The lectionary key for a Sunday, or [None] if [d] is not a Sunday. *) +val sunday_slug : Date.t -> string option diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index 1353c43..84ee031 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -88,12 +88,66 @@ let test_nativity_octave () = Alcotest.(check string) "29 Dec" "ef-nativity-octave-day-5" (named_slug (d 2026 12 29)); Alcotest.(check string) "31 Dec" "ef-nativity-octave-day-7" (named_slug (d 2026 12 31)) +let sunday_slug_of dt = match T.sunday_slug dt with Some s -> s | None -> "<none>" + +let test_week_numbers () = + Alcotest.(check (option int)) "Advent I 2026" (Some 1) (T.week (T.advent_start 2026)); + Alcotest.(check (option int)) "Advent II 2026" (Some 2) + (T.week (D.add_days (T.advent_start 2026) 7)); + (* Weeks are Sunday-aligned: the Saturday of week 1 is still week 1. *) + Alcotest.(check (option int)) "Advent I Saturday" (Some 1) + (T.week (D.add_days (T.advent_start 2026) 6)); + (* Time after Pentecost counts from Pentecost, so Trinity is week 1. *) + Alcotest.(check (option int)) "Trinity 2026 is week 1" (Some 1) (T.week (d 2026 5 31)); + (* Christmastide has no numbered weeks. *) + Alcotest.(check (option int)) "Christmastide has no week" None (T.week (d 2026 12 30)) + +let test_sunday_slugs () = + Alcotest.(check string) "Advent I" "ef-advent-sunday-1" (sunday_slug_of (T.advent_start 2026)); + Alcotest.(check string) "Lent I 2026 (22 Feb)" "ef-lent-sunday-1" (sunday_slug_of (d 2026 2 22)); + (* Slugs use lectio's season words: Paschaltide slugs as "easter". *) + Alcotest.(check string) "Paschaltide III 2026 (19 Apr)" "ef-easter-sunday-3" + (sunday_slug_of (d 2026 4 19)); + (* The Sunday within the Octave of the Nativity keeps lectio's key. *) + Alcotest.(check string) "27 Dec 2026" "ef-christmas-sunday-0" (sunday_slug_of (d 2026 12 27)); + (* The Sunday falling 7-13 Jan is the 1st Sunday after Epiphany. Its season is + Christmastide (RG 72-73) but its lectionary key stays lectio's. *) + Alcotest.(check string) "11 Jan 2026" "ef-time-after-epiphany-sunday-1" + (sunday_slug_of (d 2026 1 11)) + +(* The resumed-Sunday tail: when Easter is early there are more than 23 Sundays + after Pentecost, and the surplus resume the Sundays after Epiphany that + Septuagesima cut short. 2038 has Easter on 25 April (the latest possible) and + 1943-style early years have the most Sundays; 2035 (Easter 25 March) is an + early-Easter year with a long tail. *) +let test_resumed_sundays () = + let last_sunday_before_advent y = D.add_days (T.advent_start y) (-7) in + (* The last Sunday before Advent always keeps the 24th (Last) Mass. *) + Alcotest.(check string) "2035 last Sunday" "ef-time-after-pentecost-sunday-24" + (sunday_slug_of (last_sunday_before_advent 2035)); + Alcotest.(check string) "2026 last Sunday" "ef-time-after-pentecost-sunday-24" + (sunday_slug_of (last_sunday_before_advent 2026)); + (* In an early-Easter year the surplus Sundays route to Epiphany Masses. *) + let resumed = + List.filter_map + (fun n -> + let dt = D.add_days (T.advent_start 2035) (-7 - (7 * n)) in + let s = sunday_slug_of dt in + if String.length s >= 27 && String.sub s 0 27 = "ef-time-after-epiphany-sund" then Some s + else None) + [ 1; 2; 3; 4; 5 ] + in + Alcotest.(check bool) "2035 has resumed Epiphany Sundays" true (resumed <> []) + let suite_extra = [ Alcotest.test_case "advent start" `Quick test_advent_start; Alcotest.test_case "seasons" `Quick test_seasons; Alcotest.test_case "named feasts" `Quick test_named_feasts; Alcotest.test_case "christ the king" `Quick test_christ_the_king; - Alcotest.test_case "nativity octave" `Quick test_nativity_octave ] + 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 "resumed sundays" `Quick test_resumed_sundays ] let suite = ( "Rite_ef", |