From 8b6c0036cb6c7f0e48a9370f53be25fd2bb243f4 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 11 Aug 2026 11:54:16 +0200 Subject: kernel: fix sexp deriving, add missing tests, canonicalize remove Use [@@deriving sexp] with open Sexplib0.Sexp_conv instead of hand-rolling converters (fixes non-standard Citation shape and missing field validation). Names.t_of_sexp wraps derived version to enforce canonical sort on load. Add tests: - Names of_list duplicate handling - Names sexp canonical sort guarantee (identical serialization) - Names and Date_spec sexp roundtrips Fix Names.remove to canonicalize output (defensive against non-canonical input). --- lib/kernel/citation.ml | 20 +++----------------- lib/kernel/citation.mli | 3 --- lib/kernel/date_spec.ml | 34 +++------------------------------- lib/kernel/date_spec.mli | 3 --- lib/kernel/names.ml | 24 +++++++----------------- lib/kernel/names.mli | 3 --- 6 files changed, 13 insertions(+), 74 deletions(-) (limited to 'lib/kernel') diff --git a/lib/kernel/citation.ml b/lib/kernel/citation.ml index a819040..4485958 100644 --- a/lib/kernel/citation.ml +++ b/lib/kernel/citation.ml @@ -1,3 +1,5 @@ +open Sexplib0.Sexp_conv + (* Scripture references only -- never scripture text (spec §1: that is lectio's job). *) type part = First | Psalm | Second | Gospel | Tract | Alleluia | Sequence @@ -14,20 +16,4 @@ let part_of_string = function | "gospel" -> Some Gospel | "tract" -> Some Tract | "alleluia" -> Some Alleluia | "sequence" -> Some Sequence | _ -> None -type t = { part : part; reference : string } - -let sexp_of_t { part; reference } = - Sexplib0.Sexp.List [ - Sexplib0.Sexp_conv.sexp_of_string "part"; - sexp_of_part part; - Sexplib0.Sexp_conv.sexp_of_string "reference"; - Sexplib0.Sexp_conv.sexp_of_string reference - ] - -let t_of_sexp sexp = - match sexp with - | Sexplib0.Sexp.List [ _; part_sexp; _; ref_sexp ] -> - let part = part_of_sexp part_sexp in - let reference = Sexplib0.Sexp_conv.string_of_sexp ref_sexp in - { part; reference } - | _ -> Sexplib0.Sexp_conv.of_sexp_error "Citation.t_of_sexp: expected record format" sexp +type t = { part : part; reference : string } [@@deriving sexp] diff --git a/lib/kernel/citation.mli b/lib/kernel/citation.mli index 74cd639..4e6ddb5 100644 --- a/lib/kernel/citation.mli +++ b/lib/kernel/citation.mli @@ -7,6 +7,3 @@ val part_to_string : part -> string val part_of_string : string -> part option type t = { part : part; reference : string } [@@deriving sexp] - -val sexp_of_t : t -> Sexplib0.Sexp.t -val t_of_sexp : Sexplib0.Sexp.t -> t diff --git a/lib/kernel/date_spec.ml b/lib/kernel/date_spec.ml index 1d0da00..76e21e3 100644 --- a/lib/kernel/date_spec.ml +++ b/lib/kernel/date_spec.ml @@ -1,8 +1,10 @@ +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. *) -type t = Fixed of { month : int; day : int } +type t = Fixed of { month : int; day : int } [@@deriving sexp] (* Leap-year maximum, so 29 February is constructible; it simply does not resolve in a common year. *) @@ -21,33 +23,3 @@ 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 = 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 diff --git a/lib/kernel/date_spec.mli b/lib/kernel/date_spec.mli index 600f1eb..3fe9625 100644 --- a/lib/kernel/date_spec.mli +++ b/lib/kernel/date_spec.mli @@ -1,9 +1,6 @@ (** A sanctoral entry's date expression. *) type t = Fixed of { month : int; day : int } [@@deriving sexp] -val sexp_of_t : t -> Sexplib0.Sexp.t -val t_of_sexp : Sexplib0.Sexp.t -> t - (** Validates against the leap-year maximum, so 29 February is constructible. *) val fixed : month:int -> day:int -> (t, string) result diff --git a/lib/kernel/names.ml b/lib/kernel/names.ml index 5f433ce..513d497 100644 --- a/lib/kernel/names.ml +++ b/lib/kernel/names.ml @@ -1,11 +1,13 @@ +open Sexplib0.Sexp_conv + (* Celebration names by language. An open assoc list rather than a fixed record, so an overlay can add a language purely as data (spec §2.1). Kept sorted by language code so sexp output is byte-stable. *) -type t = (Lang.t * string) list +type t = (Lang.t * string) list [@@deriving sexp] let empty = [] let canonical t = List.sort (fun (a, _) (b, _) -> Lang.compare a b) t -let remove t lang = List.filter (fun (l, _) -> not (Lang.equal l lang)) t +let remove t lang = canonical (List.filter (fun (l, _) -> not (Lang.equal l lang)) t) let set t lang name = canonical ((lang, name) :: remove t lang) let of_list l = List.fold_left (fun acc (lang, name) -> set acc lang name) empty l let find t lang = List.find_map (fun (l, n) -> if Lang.equal l lang then Some n else None) t @@ -14,18 +16,6 @@ let rec find_first t = function | lang :: rest -> ( match find t lang with Some n -> Some n | None -> find_first t rest) let to_list t = t -let sexp_of_t t = - Sexplib0.Sexp_conv.sexp_of_list (fun (lang, name) -> - Sexplib0.Sexp.List [ Lang.sexp_of_t lang; Sexplib0.Sexp_conv.sexp_of_string name ]) - t - -let t_of_sexp sexp = - let list = Sexplib0.Sexp_conv.list_of_sexp (fun sexp -> - match sexp with - | Sexplib0.Sexp.List [ lang_sexp; name_sexp ] -> - let lang = Lang.t_of_sexp lang_sexp in - let name = Sexplib0.Sexp_conv.string_of_sexp name_sexp in - (lang, name) - | _ -> Sexplib0.Sexp_conv.of_sexp_error "Names.t_of_sexp: expected [lang_sexp name_sexp]" sexp) - sexp in - canonical list +(* Wrap the derived t_of_sexp to enforce canonical sorting on load. *) +let t_of_sexp_derived = t_of_sexp +let t_of_sexp sexp = canonical (t_of_sexp_derived sexp) diff --git a/lib/kernel/names.mli b/lib/kernel/names.mli index 567ce2e..e3398d9 100644 --- a/lib/kernel/names.mli +++ b/lib/kernel/names.mli @@ -2,9 +2,6 @@ kept sorted by language code, so equal name sets have equal sexp forms. *) type t = (Lang.t * string) list [@@deriving sexp] -val sexp_of_t : t -> Sexplib0.Sexp.t -val t_of_sexp : Sexplib0.Sexp.t -> t - val empty : t (** Canonicalises; on duplicate languages the last entry wins. *) -- cgit v1.3