diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/kernel/date_spec.ml | 20 | ||||
| -rw-r--r-- | lib/kernel/layer.ml | 6 |
2 files changed, 23 insertions, 3 deletions
diff --git a/lib/kernel/date_spec.ml b/lib/kernel/date_spec.ml index 76e21e3..732f6b1 100644 --- a/lib/kernel/date_spec.ml +++ b/lib/kernel/date_spec.ml @@ -4,7 +4,11 @@ open Sexplib0.Sexp_conv 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 } [@@deriving sexp] +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. *) @@ -23,3 +27,17 @@ let 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 diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml index bf71206..515b052 100644 --- a/lib/kernel/layer.ml +++ b/lib/kernel/layer.ml @@ -52,5 +52,7 @@ let load rank_of_sexp path = | sexp -> ( match t_of_sexp rank_of_sexp sexp with | t -> Ok { t with entries = canonical t.entries } - | exception Sexplib0.Sexp_conv_error.Of_sexp_error (exn, _) -> - Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))) + (* [rank_of_sexp] is caller-supplied and may raise anything, not only + [Of_sexp_error] -- mirrors [Overlay.load]'s catch-all, so "never as + an exception" (layer.mli) actually holds. *) + | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))) |