rite(ef): ferias, Ember days, Rogations and the temporal entry point

Ferial ranks per RG 91: I class in Holy Week and the privileged octaves
(entries 7, 10), II class for Advent 17-23 and the Ember days (entry 18), III
class for Advent to 16 December and Lent/Passiontide (entries 22, 25), IV class
per annum (entry 28). Two further divergences from lectio, both from the table:
Advent 17-23 are II class, and the Lenten Ember days are II class rather than
ordinary Lenten ferias. Rogations (RG 80/87) exist at all, which lectio does
not compute. Gaudete and Laetare are rose.

Two corrections against the primary source beyond the task brief's draft.
Entry 7 (verified against the Latin: "feria IV cinerum et II, III et IV
Hebdomadae sanctae") covers only Ash Wednesday and Monday-Wednesday of Holy
Week; Thursday-Saturday are the Sacred Triduum, entry 2, cited separately.
Rogation Monday and Tuesday keep the ordinary ferial rank of their season
(RG 88: "de Litaniis minoribus nihil fit in Officio") rather than a fixed
class, since no RG 91 entry ranks them specially.

A module-type constraint proves Temporal_ef satisfies the kernel RITE contract.

1 files changed, 145 insertions, 0 deletions

diff --git a/lib/rites/rite_ef/temporal_ef.ml b/lib/rites/rite_ef/temporal_ef.ml
index 6786cd2..4eac99f 100644
--- a/lib/rites/rite_ef/temporal_ef.ml
+++ b/lib/rites/rite_ef/temporal_ef.ml
@@ -187,3 +187,148 @@ let sunday_slug d =
         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