1 files changed, 78 insertions, 0 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)