kernel(layer): sanctoral layer with canonical order and date index

Entries sort by slug so equal layers serialise identically. The by-date index
is built once per layer rather than per year, since fixed dates are
year-independent; a full-domain sweep would otherwise rescan every entry for
every day. load turns parse and validation failures into result.

4 files changed, 128 insertions, 1 deletions

diff --git a/lib/kernel/layer.ml b/lib/kernel/layer.ml
new file mode 100644
index 0000000..bf71206
--- /dev/null
+++ b/lib/kernel/layer.ml
@@ -0,0 +1,56 @@
+open Sexplib0.Sexp_conv
+
+(* One calendar layer: a rite's base sanctoral, or any data file with the same
+   shape. Entries are kept sorted by slug as the canonical form, so equal layers
+   serialise identically and merge results do not depend on input order. *)
+type 'r entry = { date : Date_spec.t; cel : 'r Celebration.t } [@@deriving sexp]
+type 'r t = { id : string; name : string; entries : 'r entry list } [@@deriving sexp]
+
+let by_slug a b = Slug.compare a.cel.Celebration.slug b.cel.Celebration.slug
+let canonical entries = List.sort by_slug entries
+let empty ~id ~name = { id; name; entries = [] }
+let of_entries ~id ~name entries = { id; name; entries = canonical entries }
+let find t slug = List.find_opt (fun e -> Slug.equal e.cel.Celebration.slug slug) t.entries
+let mem t slug = find t slug <> None
+
+let remove t slug =
+  { t with entries = List.filter (fun e -> not (Slug.equal e.cel.Celebration.slug slug)) t.entries }
+
+let set t entry =
+  let t = remove t entry.cel.Celebration.slug in
+  { t with entries = canonical (entry :: t.entries) }
+
+(* Dates are year-independent, so the index is built once per layer rather than
+   once per year -- a full 1583..9999 sweep would otherwise rescan the entry
+   list for every day. *)
+type 'r by_date = (int * int, 'r entry list) Hashtbl.t
+
+let key = function Date_spec.Fixed { month; day } -> (month, day)
+
+let index_by_date t =
+  let tbl : 'r by_date = Hashtbl.create 512 in
+  List.iter
+    (fun e ->
+      let k = key e.date in
+      Hashtbl.replace tbl k (e :: (try Hashtbl.find tbl k with Not_found -> [])))
+    t.entries;
+  (* restore canonical order within each date bucket *)
+  Hashtbl.iter (fun k v -> Hashtbl.replace tbl k (canonical v)) tbl;
+  tbl
+
+let on_date tbl ~month ~day =
+  try Hashtbl.find tbl (month, day) with Not_found -> []
+
+let load rank_of_sexp path =
+  match Sexplib.Sexp.load_sexp path with
+  | exception Sys_error msg -> Error msg
+  (* This sexplib version raises [Failure] for some malformed inputs (e.g. an
+     unterminated list or string) rather than [Sexplib.Sexp.Parse_error], so a
+     catch-all here -- placed last among the exception branches -- is what
+     actually keeps every parse failure inside [Error] instead of escaping. *)
+  | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))
+  | 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)))
diff --git a/lib/kernel/layer.mli b/lib/kernel/layer.mli
new file mode 100644
index 0000000..3092353
--- /dev/null
+++ b/lib/kernel/layer.mli
@@ -0,0 +1,25 @@
+(** One calendar layer: a rite's base sanctoral, or a data file of the same
+    shape. Entries are canonically sorted by slug. *)
+type 'r entry = { date : Date_spec.t; cel : 'r Celebration.t } [@@deriving sexp]
+type 'r t = { id : string; name : string; entries : 'r entry list } [@@deriving sexp]
+
+val empty : id:string -> name:string -> 'r t
+val of_entries : id:string -> name:string -> 'r entry list -> 'r t
+val find : 'r t -> Slug.t -> 'r entry option
+val mem : 'r t -> Slug.t -> bool
+
+(** Replaces any entry with the same slug. *)
+val set : 'r t -> 'r entry -> 'r t
+
+val remove : 'r t -> Slug.t -> 'r t
+
+(** Date index. Built once per layer, not per year: [Date_spec] dates are
+    year-independent. *)
+type 'r by_date
+
+val index_by_date : 'r t -> 'r by_date
+val on_date : 'r by_date -> month:int -> day:int -> 'r entry list
+
+(** Loads a layer from a sexp file. Parse and validation failures come back as
+    [Error], never as an exception. *)
+val load : (Sexplib0.Sexp.t -> 'r) -> string -> ('r t, string) result
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index af642d6..2f5e87a 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -1,4 +1,5 @@
 (* 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_names.suite ]
+    [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite;
+      Test_overlay.suite ]
diff --git a/test/test_overlay.ml b/test/test_overlay.ml
new file mode 100644
index 0000000..ece4069
--- /dev/null
+++ b/test/test_overlay.ml
@@ -0,0 +1,45 @@
+module L = Colitur_kernel.Layer
+module Cel = Colitur_kernel.Celebration
+module S = Colitur_kernel.Slug
+module DS = Colitur_kernel.Date_spec
+module Col = Colitur_kernel.Colour
+
+type rank = Class1 | Class3 [@@deriving sexp]
+
+let slug = S.of_string_exn
+
+let cel ?(rank = Class3) ?(colour = Col.White) s =
+  Cel.make ~slug:(slug s) ~rank ~colour ~layer:"base" ()
+
+let entry ?(month = 1) ?(day = 1) ?rank ?colour s =
+  { L.date = (match DS.fixed ~month ~day with Ok d -> d | Error e -> failwith e);
+    cel = cel ?rank ?colour s }
+
+let base () =
+  L.of_entries ~id:"base" ~name:"Test base"
+    [ entry ~month:1 ~day:5 "telesphorus"; entry ~month:1 ~day:14 "hilary" ]
+
+let test_layer_basics () =
+  let l = base () in
+  Alcotest.(check bool) "find present" true (L.find l (slug "hilary") <> None);
+  Alcotest.(check bool) "find absent" true (L.find l (slug "nobody") = None);
+  Alcotest.(check bool) "mem" true (L.mem l (slug "telesphorus"));
+  (* canonical order is by slug, so sexp output is byte-stable *)
+  Alcotest.(check (list string)) "canonical order" [ "hilary"; "telesphorus" ]
+    (List.map (fun e -> S.to_string e.L.cel.Cel.slug) l.L.entries)
+
+let test_layer_index () =
+  let idx = L.index_by_date (base ()) in
+  Alcotest.(check int) "Jan 14 has one" 1 (List.length (L.on_date idx ~month:1 ~day:14));
+  Alcotest.(check int) "Jan 20 has none" 0 (List.length (L.on_date idx ~month:1 ~day:20))
+
+let test_layer_sexp () =
+  let l = base () in
+  let sexp = L.sexp_of_t sexp_of_rank l in
+  Alcotest.(check bool) "roundtrip" true (L.t_of_sexp rank_of_sexp sexp = l)
+
+let suite =
+  ( "Layer/Overlay",
+    [ Alcotest.test_case "layer basics" `Quick test_layer_basics;
+      Alcotest.test_case "layer by-date index" `Quick test_layer_index;
+      Alcotest.test_case "layer sexp" `Quick test_layer_sexp ] )