kernel: Names, Citation and Date_spec

Names is an open language-keyed assoc kept in canonical order so equal name
sets serialise identically. Citation carries references only, never text.
Date_spec ships the one form the EF sanctoral needs; 29 February is
constructible and resolves to None in common years.

6 files changed, 161 insertions, 0 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