aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/kernel/citation.ml20
-rw-r--r--lib/kernel/citation.mli3
-rw-r--r--lib/kernel/date_spec.ml34
-rw-r--r--lib/kernel/date_spec.mli3
-rw-r--r--lib/kernel/names.ml24
-rw-r--r--lib/kernel/names.mli3
-rw-r--r--test/test_names.ml32
7 files changed, 44 insertions, 75 deletions
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. *)
diff --git a/test/test_names.ml b/test/test_names.ml
index 6089b5f..9db8217 100644
--- a/test/test_names.ml
+++ b/test/test_names.ml
@@ -25,6 +25,24 @@ let test_names_set_remove () =
let n = N.remove n (lang "en") in
Alcotest.(check (option string)) "removed" None (N.find n (lang "en"))
+let test_names_of_list_duplicates () =
+ (* of_list with duplicate language: last entry wins *)
+ let n = N.of_list [ (lang "en", "Easter"); (lang "en", "Easter Sunday") ] in
+ Alcotest.(check (option string)) "of_list last wins" (Some "Easter Sunday") (N.find n (lang "en"))
+
+let test_names_sexp_canonical () =
+ (* Two Names.t with different input order must serialize identically *)
+ let n1 = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha"); (lang "en", "Easter") ] in
+ let n2 = N.of_list [ (lang "en", "Easter"); (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
+ Alcotest.(check bool) "same sexp despite different input order"
+ true (N.sexp_of_t n1 = N.sexp_of_t n2)
+
+let test_names_sexp_roundtrip () =
+ let n = N.of_list [ (lang "la", "Pascha"); (lang "en", "Easter") ] in
+ let sexp = N.sexp_of_t n in
+ let n' = N.t_of_sexp sexp in
+ Alcotest.(check bool) "sexp roundtrip" true (n = n')
+
let test_citation () =
let c = { C.part = C.Gospel; reference = "Jn 3:16" } in
Alcotest.(check bool) "sexp roundtrip" true (C.t_of_sexp (C.sexp_of_t c) = c);
@@ -48,9 +66,21 @@ let test_date_spec () =
Alcotest.(check bool) "reject Apr 31" true (Result.is_error (DS.fixed ~month:4 ~day:31));
Alcotest.(check bool) "reject month 13" true (Result.is_error (DS.fixed ~month:13 ~day:1))
+let test_date_spec_sexp_roundtrip () =
+ (match DS.fixed ~month:3 ~day:25 with
+ | Ok ds ->
+ let sexp = DS.sexp_of_t ds in
+ let ds' = DS.t_of_sexp sexp in
+ Alcotest.(check bool) "sexp roundtrip" true (ds = ds')
+ | Error e -> Alcotest.failf "fixed: %s" e)
+
let suite =
( "Names/Citation/DateSpec",
[ Alcotest.test_case "names basics" `Quick test_names_basics;
Alcotest.test_case "names set/remove" `Quick test_names_set_remove;
+ Alcotest.test_case "names of_list duplicates" `Quick test_names_of_list_duplicates;
+ Alcotest.test_case "names sexp canonical" `Quick test_names_sexp_canonical;
+ Alcotest.test_case "names sexp roundtrip" `Quick test_names_sexp_roundtrip;
Alcotest.test_case "citation" `Quick test_citation;
- Alcotest.test_case "date_spec" `Quick test_date_spec ] )
+ Alcotest.test_case "date_spec" `Quick test_date_spec;
+ Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip ] )
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 13:57:24 +0000