blob: 732f6b19cb3d0b44a646ff6044604a771f72221a (
plain) (
blame)
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
|
open Sexplib0.Sexp_conv
(* How a sanctoral entry expresses its date. Plan 2 ships the only form the EF
sanctoral needs -- a fixed calendar date -- because EF movable feasts come
from the rite's temporal code, not from data. Sunday-relative and
Easter-relative forms arrive with the OF sanctoral. *)
module Repr = struct
type t = Fixed of { month : int; day : int } [@@deriving sexp]
end
type t = Repr.t = Fixed of { month : int; day : int }
(* 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 })
let resolve t ~year =
match t with
| Fixed { month; day } -> Result.to_option (Date.make ~year ~month ~day)
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 pair, so
[(Fixed (month 13) (day 40))] would otherwise deserialise into a spec that
silently never resolves -- a saint quietly vanishing with no diagnostic.
Re-running the value through [fixed] closes that gap the same way loaders
already close it for slugs and language codes. *)
let t_of_sexp sexp =
let (Fixed { month; day }) = Repr.t_of_sexp sexp in
match fixed ~month ~day with
| Ok t -> t
| Error msg -> Sexplib0.Sexp_conv.of_sexp_error msg sexp
|