diff options
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.ml | 145 | ||||
| -rw-r--r-- | lib/rites/rite_ef/temporal_ef.mli | 5 | ||||
| -rw-r--r-- | test/test_temporal_ef.ml | 102 |
3 files changed, 251 insertions, 1 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 diff --git a/lib/rites/rite_ef/temporal_ef.mli b/lib/rites/rite_ef/temporal_ef.mli index 46187c9..ddfcac2 100644 --- a/lib/rites/rite_ef/temporal_ef.mli +++ b/lib/rites/rite_ef/temporal_ef.mli @@ -30,3 +30,8 @@ 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 + +val id : string + +(** Total over 1583..9999: every date yields exactly one temporal identity. *) +val temporal : Date.t -> (Vocab_ef.season, Vocab_ef.rank) Temporal.t diff --git a/test/test_temporal_ef.ml b/test/test_temporal_ef.ml index 96c7761..aa84014 100644 --- a/test/test_temporal_ef.ml +++ b/test/test_temporal_ef.ml @@ -162,6 +162,100 @@ let test_resumed_sundays () = in Alcotest.(check bool) "2035 has resumed Epiphany Sundays" true (resumed <> []) +module Cel = Colitur_kernel.Celebration +module Sl = Colitur_kernel.Slug +module Colr = Colitur_kernel.Colour + +let office dt = (T.temporal dt).Colitur_kernel.Temporal.office +let slug_of dt = Sl.to_string (office dt).Cel.slug +let rank_of dt = V.rank_to_string (office dt).Cel.rank +let colour_of dt = Colr.to_string (office dt).Cel.colour + +let test_ferial_slugs_and_ranks () = + (* Ferias key on season-week-weekday, matching lectio's lectionary keys. *) + Alcotest.(check string) "Lent feria" "ef-lent-3-monday" (slug_of (d 2026 3 9)); + (* RG 91 entry 22: Lent and Passiontide ferias are III class. *) + Alcotest.(check string) "Lent feria is III class" "class-3" (rank_of (d 2026 3 9)); + (* RG 91 entry 25: Advent ferias to 16 December are III class ... *) + Alcotest.(check string) "Advent 15 Dec is III class" "class-3" (rank_of (d 2026 12 15)); + (* ... entry 18: Advent 17-23 December are II class. lectio marks all Advent + ferias III class; this is a deliberate divergence. 21 Dec (not 18 Dec) is + used deliberately: 18 Dec 2026 is also the Advent Ember Friday, which + would independently be II class via the Ember rule and so would not + isolate this one. *) + Alcotest.(check string) "Advent 21 Dec is II class" "class-2" (rank_of (d 2026 12 21)); + (* RG 91 entry 28: per annum ferias are IV class. *) + Alcotest.(check string) "per annum feria is IV class" "class-4" (rank_of (d 2026 7 15)); + (* RG 91 entries 7 and 10: Holy Week and the privileged octaves are I class. *) + Alcotest.(check string) "Holy Monday is I class" "class-1" (rank_of (d 2026 3 30)); + (* Good Friday: RG 91 entry 7 covers only Ash Wed and Mon-Wed of Holy Week -- + Thursday-Saturday are the Sacred Triduum, entry 2, still I class. *) + Alcotest.(check string) "Good Friday is I class" "class-1" (rank_of (d 2026 4 3)); + Alcotest.(check string) "Easter Monday is I class" "class-1" (rank_of (d 2026 4 6)); + Alcotest.(check string) "Whit Monday is I class" "class-1" (rank_of (d 2026 5 25)) + +let test_after_ashes () = + Alcotest.(check string) "Thursday after Ash Wednesday" "ef-lent-after-ashes-thursday" + (slug_of (d 2026 2 19)); + Alcotest.(check (option int)) "outside a numbered week" None + (T.temporal (d 2026 2 19)).Colitur_kernel.Temporal.week + +let test_ember_days () = + (* September Ember days: Wed/Fri/Sat after the third Sunday of September. + Third Sunday of September 2026 = 20 September. *) + Alcotest.(check string) "September Ember Wed" "ef-september-ember-wed" (slug_of (d 2026 9 23)); + Alcotest.(check string) "September Ember Sat" "ef-september-ember-sat" (slug_of (d 2026 9 26)); + Alcotest.(check string) "September Ember is II class" "class-2" (rank_of (d 2026 9 23)); + (* Advent Ember days: after Advent III (2026: 13 December). *) + Alcotest.(check string) "Advent Ember Wed" "ef-advent-ember-wed" (slug_of (d 2026 12 16)); + (* Lenten Ember days: after Lent I (2026: 22 February). RG 91 entry 18 makes + them II class -- entry 22 excepts them from the III-class Lenten ferias. + lectio treats them as ordinary Lenten ferias. *) + Alcotest.(check string) "Lent Ember Wed" "ef-lent-ember-wed" (slug_of (d 2026 2 25)); + Alcotest.(check string) "Lent Ember is II class" "class-2" (rank_of (d 2026 2 25)); + (* Whitsun Ember days sit inside the I-class Pentecost octave. *) + Alcotest.(check string) "Whit Ember Wed" "ef-pentecost-ember-wed" (slug_of (d 2026 5 27)); + Alcotest.(check string) "Whit Ember is I class" "class-1" (rank_of (d 2026 5 27)); + (* Thursday is not an Ember day: the [day_of] guard matches only Wed/Fri/Sat + (3/5/6 days after the anchor), never day 4. 24 Sept 2026 is the Thursday + after the September anchor and must fall back to an ordinary IV-class + per annum feria, not an Ember slug. *) + Alcotest.(check string) "Thursday after the September anchor is not Ember" "class-4" + (rank_of (d 2026 9 24)) + +let test_rogations () = + (* RG 80/87: Minor Litanies on the Monday and Tuesday before Ascension. The + Wednesday is the Ascension vigil (see Task 11). *) + Alcotest.(check string) "Rogation Monday" "ef-rogation-monday" (slug_of (d 2026 5 11)); + Alcotest.(check string) "Rogation Tuesday" "ef-rogation-tuesday" (slug_of (d 2026 5 12)); + Alcotest.(check string) "Wednesday is the vigil" "ef-ascension-vigil" (slug_of (d 2026 5 13)); + (* RG 88: "de Litaniis minoribus nihil fit in Officio" -- the Rogation + changes the Mass, not the Office, and no RG 91 table entry ranks these + days specially, so they keep the ordinary IV-class rank of an unprivileged + Paschaltide feria (entry 28's catch-all). *) + Alcotest.(check string) "Rogation Monday keeps the ordinary ferial rank" "class-4" + (rank_of (d 2026 5 11)) + +let test_colours () = + Alcotest.(check string) "Advent is violet" "violet" (colour_of (d 2026 12 1)); + Alcotest.(check string) "per annum is green" "green" (colour_of (d 2026 7 15)); + Alcotest.(check string) "Paschaltide is white" "white" (colour_of (d 2026 4 20)); + Alcotest.(check string) "Pentecost octave is red" "red" (colour_of (d 2026 5 25)); + (* Gaudete = Advent III, Laetare = Lent IV. *) + Alcotest.(check string) "Gaudete is rose" "rose" (colour_of (d 2026 12 13)); + Alcotest.(check string) "Laetare is rose" "rose" (colour_of (d 2026 3 15)) + +let test_totality () = + (* Every day of 2026 yields an office, and every slug is well-formed. *) + let jan1 = d 2026 1 1 in + for i = 0 to 364 do + let dt = D.add_days jan1 i in + let s = slug_of dt in + match Sl.of_string s with + | Ok _ -> () + | Error e -> Alcotest.failf "%s: %s" (D.to_iso8601 dt) e + done + let suite_extra = [ Alcotest.test_case "advent start" `Quick test_advent_start; Alcotest.test_case "seasons" `Quick test_seasons; @@ -171,7 +265,13 @@ let suite_extra = Alcotest.test_case "week numbers" `Quick test_week_numbers; Alcotest.test_case "sunday slugs" `Quick test_sunday_slugs; Alcotest.test_case "week/sunday_slug agree" `Quick test_week_sunday_slug_agree; - Alcotest.test_case "resumed sundays" `Quick test_resumed_sundays ] + Alcotest.test_case "resumed sundays" `Quick test_resumed_sundays; + Alcotest.test_case "ferial slugs and ranks" `Quick test_ferial_slugs_and_ranks; + Alcotest.test_case "after ashes" `Quick test_after_ashes; + Alcotest.test_case "ember days" `Quick test_ember_days; + Alcotest.test_case "rogations" `Quick test_rogations; + Alcotest.test_case "colours" `Quick test_colours; + Alcotest.test_case "totality" `Quick test_totality ] let suite = ( "Rite_ef", |