open Sexplib0.Sexp_conv (* How a sanctoral entry expresses its date. Plan 2 shipped [Fixed] alone, and this file's own header then said "Sunday-relative and Easter-relative forms arrive with the OF sanctoral". They arrive here instead, ahead of OF, because two things needed them at once: user-supplied overlays carrying LOCAL MOVABLE FEASTS (a patronal feast on "the first Sunday of October" was simply inexpressible), and ROGATION WEDNESDAY's own commemoration (RG 87/88/89), recorded as architecturally blocked since 2026-08-13 for exactly one reason -- its trigger is Easter+38, and there is no (month, day) pair a [Fixed] spec could anchor to. Sunday-relative forms ("the Sunday on or after 2 November") are still NOT built: no entry in this repository needs one, and the same mechanism adds them when one does. See docs/superpowers/specs/2026-08-17-colitur-movable-date-specs-design.md. *) module Repr = struct type t = | Fixed of { month : int; day : int } | Easter_offset of int | Nth_weekday of { month : int; nth : int; weekday : Date.weekday } [@@deriving sexp] end type t = Repr.t = | Fixed of { month : int; day : int } | Easter_offset of int | Nth_weekday of { month : int; nth : int; weekday : Date.weekday } (* Leap-year maximum, so 29 February is constructible; it simply does not resolve in a common year. *) let max_day = function | 1 | 3 | 5 | 7 | 8 | 10 | 12 -> 31 | 4 | 6 | 9 | 11 -> 30 | 2 -> 29 | _ -> 0 let fixed ~month ~day = if month < 1 || month > 12 then Error (Printf.sprintf "date_spec: month %d out of range 1..12" month) else if day < 1 || day > max_day month then Error (Printf.sprintf "date_spec: day %d out of range for month %d" day month) else Ok (Fixed { month; day }) (* Deliberately generous rather than tight. Septuagesima is Easter-63 and Time after Pentecost runs well past Easter+180, so a bound that merely LOOKED precise would reject legitimate specs; a full year either way is the point past which a spec is certainly a data error rather than a calendar. *) let easter_offset n = if n < -365 || n > 365 then Error (Printf.sprintf "date_spec: easter offset %d is further than a year from Easter" n) else Ok (Easter_offset n) (* [nth] is 1-based forward, or negative from the end (-1 = the last). Zero is meaningless, and no month has a sixth of any weekday. *) let nth_weekday ~month ~nth ~weekday = if month < 1 || month > 12 then Error (Printf.sprintf "date_spec: month %d out of range 1..12" month) else if nth = 0 then Error "date_spec: nth = 0 is meaningless (1 is the first, -1 the last)" else if nth < -5 || nth > 5 then Error (Printf.sprintf "date_spec: nth %d out of range (no month has six of a weekday)" nth) else Ok (Nth_weekday { month; nth; weekday }) (* The domain check on [Easter_offset] is load-bearing, not defensive decoration: date.mli states plainly that [add_days] is "unbounded total arithmetic (they may denote a date outside the domain)", so Easter+200 in 9999 yields a perfectly well-formed [Date.t] that is nonetheless outside 1583..9999. Returning it would leak an out-of-domain date into a [Layer] index and from there into resolution. [None] is the same answer 29 February already gives in a common year: "this spec does not occur". *) let in_domain d = Date.year d >= 1583 && Date.year d <= 9999 let weekday_index = function | Date.Sun -> 0 | Date.Mon -> 1 | Date.Tue -> 2 | Date.Wed -> 3 | Date.Thu -> 4 | Date.Fri -> 5 | Date.Sat -> 6 (* Total: every branch returns [option], and nothing here raises on an in-range year. *) let resolve t ~year ~easter = match t with | Fixed { month; day } -> Result.to_option (Date.make ~year ~month ~day) | Easter_offset n -> (* [easter] is the caller's Easter for THIS civil year -- the rite supplies it ({!Rite.t}'s own [easter] field), so a Julian-reckoning rite is never silently handed a Gregorian date. *) let d = Date.add_days easter n in if in_domain d then Some d else None | Nth_weekday { month; nth; weekday } -> ( match Date.make ~year ~month ~day:1 with | Error _ -> None | Ok first -> (* [Date.make] is the authority on month length, so no leap rule is duplicated here: probe downward from 31 for the last day that actually constructs. Every month has at least 28. *) let rec last_day d = if d <= 28 then d else if Result.is_ok (Date.make ~year ~month ~day:d) then d else last_day (d - 1) in let days_in_month = last_day 31 in let offset_to_first = (weekday_index weekday - weekday_index (Date.weekday first) + 7) mod 7 in let first_occurrence = 1 + offset_to_first in let count = ((days_in_month - first_occurrence) / 7) + 1 in (* Negative [nth] counts back from the end: -1 is the last. *) let index = if nth > 0 then nth else count + nth + 1 in if index < 1 || index > count then None else Result.to_option (Date.make ~year ~month ~day:(first_occurrence + ((index - 1) * 7)))) let sexp_of_t = Repr.sexp_of_t (* Validating parser, matching Slug and Lang: [ppx_sexp_conv]'s derived [t_of_sexp] (relocated to [Repr] above) accepts any in-range int, so [(Fixed (month 13) (day 40))] or [(Nth_weekday (month 10) (nth 0) ...)] would otherwise deserialise into a spec that silently never resolves -- a celebration quietly vanishing with no diagnostic. Re-running the value through the smart constructors closes that gap the same way loaders already close it for slugs and language codes. EVERY variant is re-validated here. Adding one without extending this function reopens exactly the hole it exists to close, and the failure mode is invisible: nothing errors, a feast simply never appears. *) let t_of_sexp sexp = let reject msg = Sexplib0.Sexp_conv.of_sexp_error msg sexp in match Repr.t_of_sexp sexp with | Fixed { month; day } -> ( match fixed ~month ~day with Ok t -> t | Error msg -> reject msg) | Easter_offset n -> ( match easter_offset n with Ok t -> t | Error msg -> reject msg) | Nth_weekday { month; nth; weekday } -> ( match nth_weekday ~month ~nth ~weekday with Ok t -> t | Error msg -> reject msg)