aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--lib/kernel/citation.ml33
-rw-r--r--lib/kernel/citation.mli12
-rw-r--r--lib/kernel/date_spec.ml53
-rw-r--r--lib/kernel/date_spec.mli12
-rw-r--r--lib/kernel/names.ml31
-rw-r--r--lib/kernel/names.mli20
-rw-r--r--test/test_colitur.ml2
-rw-r--r--test/test_names.ml56
8 files changed, 218 insertions, 1 deletions
diff --git a/lib/kernel/citation.ml b/lib/kernel/citation.ml
new file mode 100644
index 0000000..a819040
--- /dev/null
+++ b/lib/kernel/citation.ml
@@ -0,0 +1,33 @@
+(* Scripture references only -- never scripture text (spec §1: that is lectio's
+ job). *)
+type part = First | Psalm | Second | Gospel | Tract | Alleluia | Sequence
+[@@deriving sexp]
+
+let all_parts = [ First; Psalm; Second; Gospel; Tract; Alleluia; Sequence ]
+
+let part_to_string = function
+ | First -> "first" | Psalm -> "psalm" | Second -> "second" | Gospel -> "gospel"
+ | Tract -> "tract" | Alleluia -> "alleluia" | Sequence -> "sequence"
+
+let part_of_string = function
+ | "first" -> Some First | "psalm" -> Some Psalm | "second" -> Some Second
+ | "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
diff --git a/lib/kernel/citation.mli b/lib/kernel/citation.mli
new file mode 100644
index 0000000..74cd639
--- /dev/null
+++ b/lib/kernel/citation.mli
@@ -0,0 +1,12 @@
+(** A scripture *reference* (e.g. ["Jn 3:16"]), never scripture text. *)
+type part = First | Psalm | Second | Gospel | Tract | Alleluia | Sequence
+[@@deriving sexp]
+
+val all_parts : part list
+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
new file mode 100644
index 0000000..1d0da00
--- /dev/null
+++ b/lib/kernel/date_spec.ml
@@ -0,0 +1,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
diff --git a/lib/kernel/date_spec.mli b/lib/kernel/date_spec.mli
new file mode 100644
index 0000000..600f1eb
--- /dev/null
+++ b/lib/kernel/date_spec.mli
@@ -0,0 +1,12 @@
+(** 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
+
+(** [None] when the spec does not occur in that year (29 February in a common
+ year) or falls outside the supported domain. *)
+val resolve : t -> year:int -> Date.t option
diff --git a/lib/kernel/names.ml b/lib/kernel/names.ml
new file mode 100644
index 0000000..5f433ce
--- /dev/null
+++ b/lib/kernel/names.ml
@@ -0,0 +1,31 @@
+(* 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
+
+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 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
+let rec find_first t = function
+ | [] -> None
+ | 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
diff --git a/lib/kernel/names.mli b/lib/kernel/names.mli
new file mode 100644
index 0000000..567ce2e
--- /dev/null
+++ b/lib/kernel/names.mli
@@ -0,0 +1,20 @@
+(** Celebration names keyed by language. The language set is open; entries are
+ 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. *)
+val of_list : (Lang.t * string) list -> t
+
+val set : t -> Lang.t -> string -> t
+val remove : t -> Lang.t -> t
+val find : t -> Lang.t -> string option
+
+(** [find_first t langs] returns the name for the first language present. *)
+val find_first : t -> Lang.t list -> string option
+
+val to_list : t -> (Lang.t * string) list
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 3341c36..af642d6 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -1,4 +1,4 @@
(* Aggregating test runner. Per-module suites live in test_<module>.ml. *)
let () =
Alcotest.run "colitur"
- [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite ]
+ [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite ]
diff --git a/test/test_names.ml b/test/test_names.ml
new file mode 100644
index 0000000..6089b5f
--- /dev/null
+++ b/test/test_names.ml
@@ -0,0 +1,56 @@
+module N = Colitur_kernel.Names
+module L = Colitur_kernel.Lang
+module C = Colitur_kernel.Citation
+module DS = Colitur_kernel.Date_spec
+module D = Colitur_kernel.Date
+
+let lang s = L.of_string_exn s
+
+let test_names_basics () =
+ let n = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
+ Alcotest.(check (option string)) "find la" (Some "Pascha") (N.find n (lang "la"));
+ Alcotest.(check (option string)) "find en" None (N.find n (lang "en"));
+ Alcotest.(check (option string)) "fallback la then en"
+ (Some "Pascha") (N.find_first n [ lang "en"; lang "la" ]);
+ (* canonical order is by language code, so sexp output is byte-stable *)
+ Alcotest.(check (list string)) "canonical order" [ "la"; "pl" ]
+ (List.map (fun (l, _) -> L.to_string l) (N.to_list n))
+
+let test_names_set_remove () =
+ let n = N.of_list [ (lang "la", "Pascha") ] in
+ let n = N.set n (lang "en") "Easter" in
+ Alcotest.(check (option string)) "set en" (Some "Easter") (N.find n (lang "en"));
+ let n = N.set n (lang "en") "Easter Sunday" in
+ Alcotest.(check (option string)) "last writer wins" (Some "Easter Sunday") (N.find n (lang "en"));
+ let n = N.remove n (lang "en") in
+ Alcotest.(check (option string)) "removed" None (N.find n (lang "en"))
+
+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);
+ Alcotest.(check string) "part string" "gospel" (C.part_to_string C.Gospel);
+ Alcotest.(check bool) "part of_string" true (C.part_of_string "first" = Some C.First)
+
+let test_date_spec () =
+ (match DS.fixed ~month:3 ~day:25 with
+ | Ok ds -> (
+ match DS.resolve ds ~year:2026 with
+ | Some d -> Alcotest.(check string) "resolve" "2026-03-25" (D.to_iso8601 d)
+ | None -> Alcotest.fail "resolve returned None")
+ | Error e -> Alcotest.failf "fixed: %s" e);
+ (* Feb 29 is a legitimate fixed date that simply does not occur every year. *)
+ (match DS.fixed ~month:2 ~day:29 with
+ | Ok ds ->
+ Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 <> None);
+ Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 = None)
+ | Error e -> Alcotest.failf "Feb 29 must be constructible: %s" e);
+ Alcotest.(check bool) "reject Feb 30" true (Result.is_error (DS.fixed ~month:2 ~day:30));
+ 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 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 "citation" `Quick test_citation;
+ Alcotest.test_case "date_spec" `Quick test_date_spec ] )
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 13:58:14 +0000