1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
|
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)
|
