path: root/lib/rites/rite_ef/temporal_ef.ml

(* EF (1962) temporal cycle. Every boundary and rank rule cites its Rubricae
   Generales paragraph; see docs/research/rules-register.md §3-§4. *)

open Colitur_kernel
open Vocab_ef

let mk y m d =
  match Date.make ~year:y ~month:m ~day:d with
  | Ok t -> t
  | Error e -> failwith ("temporal_ef: " ^ 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

(* The Sunday on or before [d]. *)
let sunday_on_or_before d = Date.add_days d (-(weekday_index d))

(* RG 71: Advent I is the Sunday nearest 30 November -- equivalently the fourth
   Sunday before Christmas, i.e. three weeks before the last Sunday on or before
   24 December. *)
let advent_start y = Date.add_days (sunday_on_or_before (mk y 12 24)) (-21)
let year_start = advent_start

let before a b = Date.compare a b < 0
let on_or_after a b = Date.compare a b >= 0

(* RG 71-77. Tested in chronological order within the civil year. *)
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_this = mk y 12 25 in
  let jan14 = mk y 1 14 in
  let septuagesima_sunday = Date.add_days easter (-63) in
  let ash_wednesday = Date.add_days easter (-46) in
  let passion_sunday = Date.add_days easter (-14) in
  let paschal_end = Date.add_days easter 55 in
  if on_or_after d advent_this && before d christmas_this then Advent (* RG 71 *)
  else if on_or_after d christmas_this then Christmastide (* RG 72-73: 25-31 Dec *)
  else if before d jan14 then Christmastide (* RG 72-73: 1-13 Jan inclusive *)
  else if before d septuagesima_sunday then Time_after_epiphany (* RG 77: from 14 Jan *)
  else if before d ash_wednesday then Septuagesima (* RG 73 *)
  else if before d passion_sunday then Lent (* RG 74 *)
  else if before d easter then Passiontide (* RG 75; Holy Saturday included *)
  else if Date.compare d paschal_end <= 0 then Paschaltide (* RG 76 *)
  else Time_after_pentecost (* RG 77 *)

(* Last Sunday of October, per the 1960 calendar -- NOT the OF's last Sunday
   before Advent. Register §6 flags this for primary-source confirmation. *)
let christ_the_king y = sunday_on_or_before (mk y 10 31)

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),
   the Vigil and Octave Day of the Nativity and the Vigil of Pentecost (RG
   28-34, RG 91 entries 5 and 9), the I-class Sundays of Passiontide and Low
   Sunday (RG 91 entry 6), Ash Wednesday (RG 91 entry 7), and the days within
   the Octave of the Nativity (RG 63-70, RG 91 entry 17).

   Returns (season, slug, colour, rank). Deliberately NOT week: an earlier
   version carried an explicit week option here, hand-set on some branches
   (Passion/Palm Sunday, Easter, Low Sunday, Pentecost and its Vigil, Christ
   the King) and left at [None] on others (Ascension and its Vigil, Corpus
   Christi, Sacred Heart) even though those sit inside a numbered season run
   just the same -- a manual-convention bug the guarding property could not
   even detect (see test_temporal_ef.ml's history). [temporal] now calls
   [week] itself for every day, named or not, which makes "a named day inside
   a run carries that run's week" hold by construction instead of by
   remembering to set it here. *)
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 = 25 then Some (Christmastide, "ef-nativity", Colour.White, Class1)
  else if m = 12 && dd = 24 then
    (* RG 91 entry 5: the Vigil of the Nativity is I class. lectio has no slug
       for it, so this key has no lectionary entry until Plan 3 fills it. *)
    Some (Advent, "ef-nativity-vigil", Colour.Violet, Class1)
  else if m = 12 && (dd = 29 || dd = 30 || dd = 31) then
    (* Days within the Octave of the Nativity; 26-28 Dec are Stephen, John and
       the Innocents, hence sanctoral (Plan 3). Colitur slugs -- lectionary gap. *)
    Some (Christmastide, Printf.sprintf "ef-nativity-octave-day-%d" (dd - 24), Colour.White, Class2)
  else if m = 1 && dd = 1 then
    (* RG 91 entry 5: 1 Jan is the Octave Day of the Nativity, the same table
       entry as the Nativity vigil above. *)
    Some (Christmastide, "ef-circumcision", Colour.White, Class1)
  else if m = 1 && dd = 6 then Some (Christmastide, "ef-epiphany", Colour.White, Class1)
  else if same d (off (-46)) then
    Some (Lent, "ef-ash-wednesday", Colour.Violet, Class1) (* RG 91 entry 7 *)
  else if same d (off (-14)) then
    Some (Passiontide, "ef-passion-sunday", Colour.Violet, Class1) (* RG 91 entry 6 *)
  else if same d (off (-7)) then
    Some (Passiontide, "ef-palm-sunday", Colour.Violet, Class1) (* RG 91 entry 6 *)
  else if same d easter then Some (Paschaltide, "ef-easter-sunday", Colour.White, Class1)
  else if same d (off 7) then
    Some (Paschaltide, "ef-low-sunday", Colour.White, Class1) (* RG 91 entry 6 *)
  else if same d (off 38) then
    (* RG 91 entry 21: II-class vigil. It is also Rogation Wednesday; with no
       precedence framework until Plan 3, temporal emits the higher-ranked
       vigil and the Rogation commemoration waits for RG 108-111. *)
    Some (Paschaltide, "ef-ascension-vigil", Colour.White, Class2)
  else if same d (off 39) then Some (Paschaltide, "ef-ascension", Colour.White, Class1)
  else if same d (off 48) then Some (Paschaltide, "ef-pentecost-vigil", Colour.Red, Class1) (* RG 91 entry 9 *)
  else if same d (off 49) then Some (Paschaltide, "ef-pentecost", Colour.Red, Class1)
  else if same d (off 56) then Some (Time_after_pentecost, "ef-trinity", Colour.White, Class1)
  else if same d (off 60) then Some (Time_after_pentecost, "ef-corpus-christi", Colour.White, Class1)
  else if same d (off 68) then Some (Time_after_pentecost, "ef-sacred-heart", Colour.White, Class1)
  else if same d (christ_the_king y) then Some (Time_after_pentecost, "ef-christ-the-king", Colour.White, Class1)
  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 *)

(* [week] is total and defined for every date, named or not: a named day
   inside a numbered season run carries that run's week by calling this same
   function, not by a separately hand-set value (see [named]'s docstring
   above). It naturally returns [None] for Christmastide (no season-wide
   numbering) and for the handful of proper-Mass days between Ash Wednesday
   and Lent I that precede any run's origin. *)
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

(* Christmastide has no numbered weeks ([week_origin] returns [None]), so the
   generic <season>-<week>-<weekday> ferial fallback below would collapse
   every feria to literal week "0" -- and because colitur's Christmastide
   spans 25 Dec - 13 Jan (RG 72-73, the deliberate divergence from lectio),
   the same weekday recurs two or three times across that span, producing
   duplicate slugs within a single liturgical year (register finding 1).
   Four sub-stretches, each given a key that cannot collide with the others:

   - 26-28 Dec (between the Nativity and its Octave days, which are named
     above): lectio has no narrower key here either, so this keeps its
     existing "ef-christmas-0-<weekday>" key unchanged -- nothing to lose by
     changing it, and nothing gained.
   - 2-5 Jan (between the Octave Day and Epiphany): lectio *also* collapses
     this to "ef-christmas-0-<weekday>", indistinguishable from the stretch
     above in lectio's own data. colitur cannot preserve a distinction lectio
     doesn't make, so this becomes "ef-christmas-1-<weekday>" -- a
     colitur-only key and a lectionary gap for the Plan 3 bootstrap to fill,
     exactly like the Nativity vigil and octave-day keys above.
   - 7-13 Jan, split in two by the *actual* first-Sunday-after-Epiphany
     origin ([week_origin Time_after_epiphany], which by construction always
     falls somewhere in this window -- see that function's own comment):
       - from the origin Sunday through 13 Jan: this genuinely is week 1 of
         Time after Epiphany, just still inside Christmastide by season
         (RG 72-73). lectio keys it "ef-time-after-epiphany-1-<weekday>", the
         same key [sunday_slug] already gives the Sunday in this window --
         and it is the *same computation* the ordinary Time-after-Epiphany
         ferial fallback below will give the rest of that same
         Sunday-to-Saturday week once the season turns on 14 Jan, so this
         cannot collide with it (a fixed 7-day week has each weekday once).
       - 7 Jan through the day *before* the origin (0-6 days, only present
         when Epiphany does not fall on a Saturday): these genuinely precede
         week 1 -- treating them as week 1 too, as a naive calendar-range
         read of lectio's behaviour would, collides with the days named just
         above, because they are exactly 7 days before them for whichever
         weekdays they cover (verified empirically: reusing "week 1" here
         produced duplicates in most years, not merely an edge case). No
         lectio key to preserve either way, so this is its own colitur-only
         "ef-christmas-2-<weekday>" -- a further lectionary gap. *)
let christmastide_feria_slug d =
  let y = Date.year d in
  let m = Date.month d and dd = Date.day d in
  let w = Date.weekday_to_string (Date.weekday d) in
  if m = 12 && dd >= 26 && dd <= 28 then Some (Printf.sprintf "ef-christmas-0-%s" w)
  else if m = 1 && dd >= 2 && dd <= 5 then Some (Printf.sprintf "ef-christmas-1-%s" w)
  else if m = 1 && dd >= 7 && dd <= 13 then
    match week_origin Time_after_epiphany y with
    | Some origin when Date.compare d origin >= 0 -> Some (Printf.sprintf "ef-time-after-epiphany-1-%s" w)
    | _ -> Some (Printf.sprintf "ef-christmas-2-%s" w)
  else None

(* 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 -> (
        (* Reuse [week] rather than recomputing the Pentecost-relative week
           number locally, so the two can never drift apart (see
           test_week_sunday_slug_agree). Only the last Sunday and the resumed
           tail are genuinely special. *)
        match week d with
        | None -> None
        | Some n ->
            let last_sunday = Date.add_days (advent_start y) (-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 = match week last_sunday with Some t -> t | None -> n 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)

let id = "ef"

(* The third Sunday of September: the Ember week's anchor.

   This specific date-derivation rule is one of the more contested points in
   the 1962 calendar: pre-1955 practice tied the September Ember days to the
   week following the Exaltation of the Holy Cross (14 Sept) instead. The two
   rules only disagree when 1 September is a Monday -- 2025 is such a year --
   and the primary-source scan available to this project does not contain an
   explicit numbered-paragraph statement of either rule (searched; see
   register §3 "Ember days"), so this citation is deliberately left at the
   rank rules only (RG 91 entries 18/22, cited on [ember] below), not the
   date-derivation rule itself: a wrong citation is worse than none.
   Empirically: for 2025 this rule gives 24/26/27 September, confirmed
   against an independent oracle; the Holy-Cross rule would give 17/19/20
   September instead. See register §3 for the full note. *)
let third_sunday_of_september y =
  let sep1 = mk y 9 1 in
  let first_sunday = Date.add_days sep1 ((7 - weekday_index sep1) mod 7) in
  Date.add_days first_sunday 14

(* Ember days: Wednesday, Friday and Saturday after the anchoring Sunday.
   RG 91 entry 18 makes the Advent, Lent and September sets II class; entry 22
   excepts the Lenten set from the III-class Lenten ferias. The Whitsun set
   falls inside the I-class Pentecost octave and takes its rank.

   The September and Advent sets match lectio's own Ember slugs. The Lent and
   Whitsun (Pentecost) sets do not -- lectio has no Ember slug for either, so
   "ef-lent-ember-*" and "ef-pentecost-ember-*" are colitur-only keys and a
   lectionary gap for the Plan 3 bootstrap to fill (spec §4.4), the same
   status as the Nativity vigil and the Rogation days below. *)
let ember d =
  let y = Date.year d in
  let easter = Computus.gregorian_easter y in
  let sets =
    [ (third_sunday_of_september y, "september", Class2, Colour.Violet);
      (Date.add_days (advent_start y) 14, "advent", Class2, Colour.Violet);
      (Date.add_days easter (-42), "lent", Class2, Colour.Violet);
      (Date.add_days easter 49, "pentecost", Class1, Colour.Red) ]
  in
  List.find_map
    (fun (anchor, name, rank, colour) ->
      let day_of = function 3 -> Some "wed" | 5 -> Some "fri" | 6 -> Some "sat" | _ -> None in
      let n = days_between anchor d in
      if n >= 3 && n <= 6 then
        match day_of n with
        | Some w -> Some (Printf.sprintf "ef-%s-ember-%s" name w, rank, colour)
        | None -> None
      else None)
    sets

(* RG 91 entry 7: Ash Wednesday (named above) and Monday-Wednesday of Holy
   Week are I-class ferias -- the primary text reads "feria IV cinerum et II,
   III et IV Hebdomadae sanctae", i.e. explicitly stops at Wednesday. Thursday
   to Saturday of Holy Week are the Sacred Triduum, RG 91 entry 2 -- ranked
   even above entry 7, not a mere feria -- but their own named offices are a
   Plan 3 sanctoral addition; until then this gives them the same I-class rank
   via the generic ferial path. RG 91 entry 10: the weekdays within the
   privileged Octaves of Easter and Pentecost are I class too. *)
let privileged_feria d =
  let easter = Computus.gregorian_easter (Date.year d) in
  let n = days_between easter d in
  (n >= -6 && n <= -1) || (n >= 1 && n <= 6) || (n >= 50 && n <= 55)

(* RG 117 enumerates the five colours (white, red, green, violet, black);
   RG 127 assigns green and RG 128 violet to the seasons de Tempore below.
   White's own specific paragraph (the "B) De colore albo" section, between
   117 and 123) was not pinned by the primary-source search available here --
   left uncited rather than guessed; see register §3 "Colours". *)
let season_colour = function
  | Advent | Septuagesima | Lent | Passiontide -> Colour.Violet (* RG 128 *)
  | Christmastide | Paschaltide -> Colour.White
  | Time_after_epiphany | Time_after_pentecost -> Colour.Green (* RG 127 *)

(* Gaudete (Advent III) and Laetare (Lent IV) are rose: RG 131, "may be used...
   for the Office and Mass of that Sunday only" -- an indult over the
   season's violet, not a season colour of its own. *)
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)
  | Lent -> same d (Date.add_days (Computus.gregorian_easter y) (-21))
  | _ -> false

(* RG 91 entry 28, "Feriae IV classis", is an unqualified catch-all: any feria
   not placed by a more specific entry above defaults to IV class. That is
   what a per annum or Septuagesima feria falls back to here -- and also an
   ordinary Paschaltide weekday (e.g. a Rogation day) outside the privileged
   octave, since the table has no entry of its own for Paschaltide ferias. *)
let ferial_rank d s =
  if privileged_feria d then Class1
  else
    match s with
    | Advent -> if Date.month d = 12 && Date.day d >= 17 then Class2 (* RG 91 e18 *) else Class3 (* e25 *)
    | Lent | Passiontide -> Class3 (* RG 91 e22 *)
    | _ -> Class4 (* RG 91 e28 *)

let weekday_word d = Date.weekday_to_string (Date.weekday d)

let temporal d =
  let y = Date.year d in
  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 office =
      Colitur_kernel.Celebration.make ~slug:(Slug.of_string_exn slug) ~rank ~colour
        ~subject:Colitur_kernel.Subject.Temporal ~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)
  | None -> (
      (* Rogations (the Minor Litanies only -- RG 87, Monday and Tuesday
         before Ascension). The Major Litanies (25 April, RG 80) are a fixed
         date and are not yet computed; they arrive with Plan 3's sanctoral
         (register §6). The Wednesday here is the Ascension vigil (see Task
         11). RG 88: "de Litaniis minoribus nihil fit in Officio" -- the
         Office (hence the day's rank) is unchanged by the Rogation; only the
         Mass is proper. No RG 91 table entry elevates these days, so they
         take the ordinary ferial rank of their season via [ferial_rank]
         rather than a fixed class. lectio has no Rogation slug at all, so
         "ef-rogation-monday"/"-tuesday" are colitur-only keys and a
         lectionary gap for Plan 3, like the Ember and Nativity-vigil keys
         above. *)
      let rogation = days_between easter d in
      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)
      else
        match ember d with
        | Some (slug, rank, colour) -> build ~season:s ~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
                (* RG 11-12: Sundays of Advent, Lent, Passiontide, Easter, Low
                   Sunday and Pentecost are I class; all others II. The I-class
                   ones are already named above -- Passiontide has only two
                   Sundays and both are named, so no Passiontide Sunday ever
                   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)
            | 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)
                | None ->
                    (* The days between Ash Wednesday and Lent I have proper
                       Masses and belong to no numbered week. *)
                    let after_ashes = days_between easter d in
                    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
                    else
                      let colour =
                        (* The Pentecost octave weekdays are red, not Paschaltide's white. *)
                        if days_between easter d >= 50 && days_between easter d <= 55 then Colour.Red
                        else season_colour s
                      in
                      let week_n = week d in
                      let slug =
                        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)))

(* 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. *)
let anchors y =
  let easter = Computus.gregorian_easter y in
  let off n = Date.add_days easter n in
  [ ("ef-nativity", mk y 12 25);
    ("ef-nativity-vigil", mk y 12 24);
    ("ef-nativity-octave-day-5", mk y 12 29);
    ("ef-nativity-octave-day-6", mk y 12 30);
    ("ef-nativity-octave-day-7", mk y 12 31);
    ("ef-circumcision", mk y 1 1);
    ("ef-epiphany", mk y 1 6);
    ("ef-ash-wednesday", off (-46));
    ("ef-passion-sunday", off (-14));
    ("ef-palm-sunday", off (-7));
    ("ef-easter-sunday", off 0);
    ("ef-low-sunday", off 7);
    ("ef-ascension-vigil", off 38);
    ("ef-ascension", off 39);
    ("ef-pentecost-vigil", off 48);
    ("ef-pentecost", off 49);
    ("ef-trinity", off 56);
    ("ef-corpus-christi", off 60);
    ("ef-sacred-heart", off 68);
    ("ef-christ-the-king", christ_the_king y) ]

(* Compile-time check that this module satisfies the kernel's rite contract. *)
module _ : Colitur_kernel.Temporal.RITE = struct
  let id = id

  type season = Vocab_ef.season
  type rank = Vocab_ef.rank

  let vocab = Vocab_ef.vocab
  let year_start = year_start
  let temporal = temporal
end