lib/kernel/date_spec.ml


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

(* 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. *)
type 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 = function
  | Fixed { month; day } ->
      Sexplib0.Sexp.List [
        Sexplib0.Sexp_conv.sexp_of_string "Fixed";
        Sexplib0.Sexp.List [
          Sexplib0.Sexp.List [
            Sexplib0.Sexp_conv.sexp_of_string "month";
            Sexplib0.Sexp_conv.sexp_of_int month
          ];
          Sexplib0.Sexp.List [
            Sexplib0.Sexp_conv.sexp_of_string "day";
            Sexplib0.Sexp_conv.sexp_of_int day
          ]
        ]
      ]

let t_of_sexp sexp =
  match sexp with
  | Sexplib0.Sexp.List [
      Sexplib0.Sexp.Atom "Fixed";
      Sexplib0.Sexp.List [
        Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "month"; month_sexp ];
        Sexplib0.Sexp.List [ Sexplib0.Sexp.Atom "day"; day_sexp ]
      ]
    ] ->
      let month = Sexplib0.Sexp_conv.int_of_sexp month_sexp in
      let day = Sexplib0.Sexp_conv.int_of_sexp day_sexp in
      Fixed { month; day }
  | _ -> Sexplib0.Sexp_conv.of_sexp_error "Date_spec.t_of_sexp: expected Fixed record format" sexp