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, week). *)
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, None)
  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, None)
  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, None)
  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, None)
  else if m = 1 && dd = 6 then Some (Christmastide, "ef-epiphany", Colour.White, Class1, None)
  else if same d (off (-46)) then
    Some (Lent, "ef-ash-wednesday", Colour.Violet, Class1, None) (* RG 91 entry 7 *)
  else if same d (off (-14)) then
    Some (Passiontide, "ef-passion-sunday", Colour.Violet, Class1, Some 1) (* RG 91 entry 6 *)
  else if same d (off (-7)) then
    Some (Passiontide, "ef-palm-sunday", Colour.Violet, Class1, Some 2) (* RG 91 entry 6 *)
  else if same d easter then Some (Paschaltide, "ef-easter-sunday", Colour.White, Class1, Some 1)
  else if same d (off 7) then
    Some (Paschaltide, "ef-low-sunday", Colour.White, Class1, Some 2) (* 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, None)
  else if same d (off 39) then Some (Paschaltide, "ef-ascension", Colour.White, Class1, None)
  else if same d (off 48) then
    Some (Paschaltide, "ef-pentecost-vigil", Colour.Red, Class1, None) (* RG 91 entry 9 *)
  else if same d (off 49) then Some (Paschaltide, "ef-pentecost", Colour.Red, Class1, None)
  else if same d (off 56) then Some (Time_after_pentecost, "ef-trinity", Colour.White, Class1, Some 1)
  else if same d (off 60) then
    Some (Time_after_pentecost, "ef-corpus-christi", Colour.White, Class1, None)
  else if same d (off 68) then
    Some (Time_after_pentecost, "ef-sacred-heart", Colour.White, Class1, None)
  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 -> (
        (* 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. *)
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. *)
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)

let season_colour = function
  | Advent | Septuagesima | Lent | Passiontide -> Colour.Violet
  | Christmastide | Paschaltide -> Colour.White
  | Time_after_epiphany | Time_after_pentecost -> Colour.Green

(* Gaudete (Advent III) and Laetare (Lent IV) are rose. *)
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, week) -> build ~season ~slug ~colour ~rank ~week
  | None -> (
      (* Rogations: RG 80/87, Monday and Tuesday before Ascension. The
         Wednesday 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. *)
      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, so anything reaching here is
                   II class except the remaining Advent and Lent Sundays. *)
                let rank = match s with Advent | Lent | Passiontide -> Class1 | _ -> Class2 in
                build ~season:s ~slug ~colour ~rank ~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))

(* 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