kernel(calendar): the year is the primitive, the day is derived

Transfers make per-date resolution impossible to do correctly: resolving 25
March can push a feast onto 26 March, and RG 97-98 has coinciding I-class
feasts transfer in table order, which needs global knowledge. So year computes
a whole liturgical year in one pass and day indexes into it. Pure, no cache, no
mutable state.

This commit resolves each day but does not yet place deferred transfers; they
are recorded with a reason. Task 6 adds the placement pass.

4 files changed, 312 insertions, 1 deletions

diff --git a/lib/kernel/calendar.ml b/lib/kernel/calendar.ml
new file mode 100644
index 0000000..fd23377
--- /dev/null
+++ b/lib/kernel/calendar.ml
@@ -0,0 +1,93 @@
+(* Resolution across a whole liturgical year. See calendar.mli for the
+   architectural rationale (why [year] is the primitive and [day] derived). *)
+
+(* The kernel's domain floor and ceiling (Date.make's documented 1583..9999
+   bound). Both are always constructible -- in-range by definition -- so
+   neither of these can itself raise. *)
+let domain_min_date =
+  match Date.make ~year:1583 ~month:1 ~day:1 with Ok d -> d | Error e -> failwith e
+
+let domain_max_date =
+  match Date.make ~year:9999 ~month:12 ~day:31 with Ok d -> d | Error e -> failwith e
+
+(* [start, stop] for the liturgical year opening in civil year [y], clamped at
+   both ends of the domain rather than calling [rite.year_start] on a civil
+   year outside 1583..9999.
+
+   Top: at [y] = 9999, [rite.year_start (y + 1)] would ask for civil year
+   10000 -- out of Date's domain (Plan 2 shipped exactly this bug in
+   Validate). Clamp [stop] to 31 December 9999 instead: the final liturgical
+   year comes back truncated, not un-computable.
+
+   Bottom: symmetric case, reachable only through [day] below. A date in
+   civil year 1583 before that year's own [rite.year_start] genuinely belongs
+   to the liturgical year that opened in civil year 1582 for an
+   Advent-anchored rite -- but [rite.year_start 1582] is equally out of
+   domain. [day] only ever decrements a valid date's own (in-domain) civil
+   year by at most one, so [y] = 1582 is the sole way this branch is reached.
+   Clamp [start] to 1 January 1583: "year 1582" becomes the truncated
+   stretch from the domain floor up to the day before [rite.year_start 1583],
+   which is exactly the sliver a date there needs. *)
+let year_bounds (rite : ('s, 'r) Rite.t) (y : int) : Date.t * Date.t =
+  let start = if y < 1583 then domain_min_date else rite.Rite.year_start y in
+  let stop =
+    if y >= 9999 then domain_max_date else Date.add_days (rite.Rite.year_start (y + 1)) (-1)
+  in
+  (start, stop)
+
+(* RG 91's contest for one date: the temporal office against every sanctoral
+   entry whose Date_spec resolves to it. [Layer.on_date] is keyed on exactly
+   (month, day), which for a [Fixed] spec -- the only form Plan 2 ships -- is
+   the same test as resolving the spec against [date]'s own year and
+   comparing, so no separate filter is needed here. *)
+let resolve_day (rite : ('s, 'r) Rite.t) (idx : 'r Layer.by_date) (date : Date.t) :
+    ('s, 'r) Liturgical_day.t =
+  let temporal = rite.Rite.temporal date in
+  let temporal_candidate =
+    { Precedence.cel = temporal.Temporal.office; origin = Precedence.Temporal }
+  in
+  let sanctoral =
+    Layer.on_date idx ~month:(Date.month date) ~day:(Date.day date)
+    |> List.map (fun (e : 'r Layer.entry) ->
+           { Precedence.cel = e.Layer.cel; origin = Precedence.Sanctoral })
+  in
+  let ctx = { Precedence.date; season = temporal.Temporal.season; weekday = temporal.Temporal.weekday } in
+  let resolution = Precedence.resolve rite.Rite.rules ctx ~temporal:temporal_candidate ~sanctoral in
+  (* [resolution.deferred] (RG 96-98 transfer candidates) and
+     [resolution.omitted] (yielded/admission-limit losers) have no field to
+     land in on Liturgical_day.t yet, so both are simply absent from today's
+     result -- deliberately incomplete for a deferred candidate, which is
+     thereby neither observed nor commemorated here, and not yet placed on
+     any later day either ("deferred: transfer placement not yet implemented
+     (Task 6)"). Task 6's fixed-point pass closes this gap. *)
+  {
+    Liturgical_day.date;
+    rite = rite.Rite.id;
+    temporal;
+    observed = resolution.Precedence.observed.Precedence.cel;
+    commemorations =
+      List.map (fun (c, p) -> (c.Precedence.cel, p)) resolution.Precedence.commemorations;
+    transferred_in = None;
+    transferred_out = None;
+    citations = [];
+  }
+
+let year (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (y : int) :
+    ('s, 'r) Liturgical_day.t array =
+  let idx = Layer.index_by_date layer in
+  let start, stop = year_bounds rite y in
+  (* [max 0]: defends [Array.init] against a negative length, which would
+     otherwise arise for a rite whose [year_start] lands exactly on the
+     domain floor (start clamps to the same date, giving [stop] a day
+     before it). Not reachable through [day] -- see calendar.mli -- but
+     [year] is public, and a direct out-of-contract call must not raise
+     either. *)
+  let n = max 0 (Date.to_rata stop - Date.to_rata start + 1) in
+  Array.init n (fun i -> resolve_day rite idx (Date.add_days start i))
+
+let day (rite : ('s, 'r) Rite.t) (layer : 'r Layer.t) (date : Date.t) :
+    ('s, 'r) Liturgical_day.t =
+  let cy = Date.year date in
+  let y = if Date.compare date (rite.Rite.year_start cy) >= 0 then cy else cy - 1 in
+  let start, _ = year_bounds rite y in
+  (year rite layer y).(Date.to_rata date - Date.to_rata start)
diff --git a/lib/kernel/calendar.mli b/lib/kernel/calendar.mli
new file mode 100644
index 0000000..50ff8f8
--- /dev/null
+++ b/lib/kernel/calendar.mli
@@ -0,0 +1,45 @@
+(** Resolution across a whole liturgical year (spec §2.4).
+
+    Transfers make per-date resolution impossible to do correctly: resolving
+    25 March can push a feast onto 26 March, and RG 97-98 has coinciding
+    I-class feasts transfer in table order, which needs global knowledge of
+    the whole year. So [year] is the primitive -- it resolves every date in
+    one pass -- and [day] is derived: it finds the liturgical year containing
+    a date and indexes into it. Both are pure; neither caches.
+
+    This module resolves each day's temporal-vs-sanctoral contest but does
+    not yet place deferred transfers (RG 96-98): a losing candidate the
+    rite's rules send to [Precedence.Transfer] is absent from the result
+    entirely on this pass -- not observed, not commemorated, and
+    [transferred_in]/[transferred_out] both stay [None] everywhere. Task 6
+    adds the fixed-point placement pass that closes this gap. *)
+
+(** [year rite layer y] resolves every day of the liturgical year that opens
+    in civil year [y]: from [rite.year_start y] through the day before
+    [rite.year_start (y + 1)], inclusive of both ends.
+
+    Total over 1583..9999, including the boundary years:
+    - At [y] = 9999, [rite.year_start (y + 1)] would ask for civil year
+      10000, out of {!Date}'s domain (this is the bug Plan 2 shipped in
+      [Validate] and later fixed). The end of the walk clamps to 31 December
+      9999 instead of computing that call; the returned year comes back
+      truncated to whatever the rite's own temporal cycle covers between
+      [rite.year_start 9999] and the last day of that civil year, not
+      un-computable.
+    - Symmetrically, [y] < 1583 clamps the start of the walk to 1 January
+      1583 instead of calling [rite.year_start y] on an out-of-domain civil
+      year. [year] is never called this way directly by anything in this
+      module; {!day} is the only caller that can reach [y] = 1582 (one below
+      the floor, never lower), when the date it was asked about sits in civil
+      year 1583 before that year's own [rite.year_start] -- i.e. the sliver
+      whose true liturgical year opened in civil year 1582, which the domain
+      cannot represent. Calling [year] with such a [y] directly is also safe:
+      it returns exactly that truncated sliver. *)
+val year : ('s, 'r) Rite.t -> 'r Layer.t -> int -> ('s, 'r) Liturgical_day.t array
+
+(** [day rite layer date] finds the liturgical year containing [date] -- the
+    year [y] with [rite.year_start y <= date < rite.year_start (y + 1)] --
+    and returns its slot for [date]. Recomputes that whole year on every
+    call: pure, no cache, no mutable state. Acceptable cost for the natural
+    usage (dump a year, sweep years for validation), which pays it once. *)
+val day : ('s, 'r) Rite.t -> 'r Layer.t -> Date.t -> ('s, 'r) Liturgical_day.t
diff --git a/test/test_calendar.ml b/test/test_calendar.ml
new file mode 100644
index 0000000..a3c4125
--- /dev/null
+++ b/test/test_calendar.ml
@@ -0,0 +1,172 @@
+module C = Colitur_kernel.Calendar
+module D = Colitur_kernel.Date
+module LD = Colitur_kernel.Liturgical_day
+module Cel = Colitur_kernel.Celebration
+module Sl = Colitur_kernel.Slug
+module Rite = Colitur_kernel.Rite
+
+let mk y m d = match D.make ~year:y ~month:m ~day:d with Ok t -> t | Error e -> failwith e
+
+(* A synthetic rite -- not EF -- so Calendar's behaviour is proven against the
+   abstraction, not against EF's own real (and much larger) data. Two
+   seasons, two ranks: enough to exercise the type parameters without
+   dragging in real liturgical logic Calendar itself does not compute. *)
+module Fixture = struct
+  module Vocab = Colitur_kernel.Vocab
+  module Colour = Colitur_kernel.Colour
+  module Temporal = Colitur_kernel.Temporal
+  module P = Colitur_kernel.Precedence
+  module Layer = Colitur_kernel.Layer
+  module Date_spec = Colitur_kernel.Date_spec
+
+  type season = A | B
+  type rank = Hi | Lo
+
+  let season_to_string = function A -> "a" | B -> "b"
+  let season_of_string = function "a" -> Some A | "b" -> Some B | _ -> None
+  let rank_to_string = function Hi -> "hi" | Lo -> "lo"
+  let rank_of_string = function "hi" -> Some Hi | "lo" -> Some Lo | _ -> None
+
+  let vocab : (season, rank) Vocab.t =
+    { Vocab.seasons = [ A; B ]; season_to_string; season_of_string;
+      ranks = [ Hi; Lo ]; rank_to_string; rank_of_string }
+
+  let weekday_index d =
+    match D.weekday d with
+    | D.Sun -> 0 | D.Mon -> 1 | D.Tue -> 2 | D.Wed -> 3
+    | D.Thu -> 4 | D.Fri -> 5 | D.Sat -> 6
+
+  let sunday_on_or_before d = D.add_days d (-(weekday_index d))
+
+  (* Advent-anchored, mirroring the real EF rite's own RG-71 "Sunday nearest
+     30 November" rule (rite_ef/temporal_ef.ml's [advent_start]) rather than
+     a Jan-1 year start: that shape is what makes the year-below-the-date's-
+     own-civil-year case in [Calendar.day] genuinely reachable, so the domain
+     -floor test below exercises something real. *)
+  let year_start y = D.add_days (sunday_on_or_before (mk y 12 24)) (-21)
+
+  (* Not liturgically meaningful -- Calendar does not check season
+     contiguity (that is Validate's job); this just proves the season type
+     parameter is actually threaded through. *)
+  let season date = if D.month date < 6 then A else B
+
+  (* One office per day, uniquely named by date so distinct days never
+     collide on slug. *)
+  let office date =
+    let slug = Printf.sprintf "feria-%04d-%02d-%02d" (D.year date) (D.month date) (D.day date) in
+    Cel.make ~slug:(Sl.of_string_exn slug) ~rank:Lo ~colour:Colour.Green ~layer:"synthetic-temporal" ()
+
+  let temporal date : (season, rank) Temporal.t =
+    { Temporal.season = season date; week = None; weekday = D.weekday date; office = office date }
+
+  (* Band: Hi beats Lo; Temporal breaks a tie in its own favour -- the same
+     convention test_precedence.ml uses. *)
+  let band (_ : season P.context) (c : rank P.candidate) =
+    (match c.P.cel.Cel.rank with Hi -> 10 | Lo -> 20)
+    - (match c.P.origin with P.Temporal -> 1 | P.Sanctoral -> 0)
+
+  let disposition ~winner:_ ~(loser : rank P.candidate) =
+    match loser.P.cel.Cel.rank with Lo -> P.Commemorate P.Ordinary | Hi -> P.Transfer
+
+  let rules : (season, rank) P.rules = { P.band; disposition; admit = (fun ~observed:_ cs -> cs) }
+
+  let rite : (season, rank) Rite.t =
+    { Rite.id = "synthetic-calendar"; vocab; year_start; temporal; anchors = (fun _ -> []);
+      rules; season_runs = [ A; B ] }
+
+  let entry ~month ~day ~slug ~rank =
+    { Layer.date = (match Date_spec.fixed ~month ~day with Ok d -> d | Error e -> failwith e);
+      cel = Cel.make ~slug:(Sl.of_string_exn slug) ~rank ~colour:Colour.White
+              ~layer:"synthetic-sanctoral" () }
+
+  let big_feast = entry ~month:12 ~day:8 ~slug:"big-feast" ~rank:Hi
+  let commem_worthy = entry ~month:12 ~day:15 ~slug:"commem-worthy" ~rank:Lo
+
+  let layer = Layer.of_entries ~id:"synthetic" ~name:"Synthetic sanctoral" [ big_feast; commem_worthy ]
+
+  let liturgical_year_of date =
+    let cy = D.year date in
+    if D.compare date (year_start cy) >= 0 then cy else cy - 1
+end
+
+let test_year_covers_every_day () =
+  let days = C.year Fixture.rite Fixture.layer 2026 in
+  let first = days.(0) and last = days.(Array.length days - 1) in
+  Alcotest.(check string) "starts at year_start" "2026-11-29" (D.to_iso8601 first.LD.date);
+  Alcotest.(check bool) "ends the day before next year_start" true
+    (D.compare last.LD.date (D.add_days (Fixture.rite.Rite.year_start 2027) (-1)) = 0);
+  (* every consecutive pair is exactly one day apart: no gaps, no duplicates *)
+  Array.iteri
+    (fun i d ->
+      if i > 0 then
+        Alcotest.(check int) "consecutive" 1
+          (D.to_rata d.LD.date - D.to_rata days.(i - 1).LD.date))
+    days
+
+let test_day_agrees_with_year () =
+  List.iter
+    (fun (y, m, dd) ->
+      let date = mk y m dd in
+      let from_day = C.day Fixture.rite Fixture.layer date in
+      let ys = C.year Fixture.rite Fixture.layer (Fixture.liturgical_year_of date) in
+      let from_year = Array.to_list ys |> List.find (fun d -> D.compare d.LD.date date = 0) in
+      Alcotest.(check string) "same observed"
+        (Sl.to_string from_year.LD.observed.Cel.slug)
+        (Sl.to_string from_day.LD.observed.Cel.slug))
+    [ (2026, 12, 1); (2027, 3, 15); (2027, 7, 4) ]
+
+(* Two entries in the layer, per the brief: one that outranks the feria and
+   one that does not. Both sit on their own date so each assertion below
+   pins one behaviour without the other candidate muddying it. *)
+let test_sanctoral_outranks_feria_becomes_observed () =
+  let days = C.year Fixture.rite Fixture.layer 2026 in
+  let date = mk 2026 12 8 in
+  let d = Array.to_list days |> List.find (fun d -> D.compare d.LD.date date = 0) in
+  Alcotest.(check string) "big-feast observed" "big-feast" (Sl.to_string d.LD.observed.Cel.slug)
+
+let test_lower_ranked_sanctoral_is_commemorated () =
+  let days = C.year Fixture.rite Fixture.layer 2026 in
+  let date = mk 2026 12 15 in
+  let d = Array.to_list days |> List.find (fun d -> D.compare d.LD.date date = 0) in
+  let expected_feria = Sl.to_string (Fixture.office date).Cel.slug in
+  Alcotest.(check string) "feria still observed" expected_feria (Sl.to_string d.LD.observed.Cel.slug);
+  Alcotest.(check (list string)) "commem-worthy commemorated" [ "commem-worthy" ]
+    (List.map (fun (c, _) -> Sl.to_string c.Cel.slug) d.LD.commemorations)
+
+(* Register/design lesson (Plan 2's Validate 9999 bug): [year_start (y + 1)]
+   at the top of the domain must not raise. Calling [C.year ... 9999] here
+   directly (no [try]) is itself part of the pin -- if the clamp regressed,
+   this call would raise and the test would error rather than fail cleanly. *)
+let test_year_9999_does_not_raise () =
+  let days = C.year Fixture.rite Fixture.layer 9999 in
+  Alcotest.(check bool) "non-empty" true (Array.length days > 0);
+  Alcotest.(check string) "starts at year_start 9999"
+    (D.to_iso8601 (Fixture.rite.Rite.year_start 9999))
+    (D.to_iso8601 days.(0).LD.date);
+  Alcotest.(check string) "ends at the domain ceiling" "9999-12-31"
+    (D.to_iso8601 days.(Array.length days - 1).LD.date)
+
+(* The symmetric case at the bottom: 1 January 1583 is the domain's earliest
+   representable date, and Fixture's Advent-anchored [year_start] puts it
+   well before that civil year's own year_start -- so [day] must resolve it
+   via the [y] = 1582 branch without calling [year_start 1582] (out of
+   domain). Checks identity (the date's own feria), not merely that
+   something came back. *)
+let test_day_near_domain_floor_does_not_raise () =
+  let date = mk 1583 1 1 in
+  let d = C.day Fixture.rite Fixture.layer date in
+  Alcotest.(check string) "returns the queried date" "1583-01-01" (D.to_iso8601 d.LD.date);
+  Alcotest.(check string) "observed is the day's own feria"
+    (Sl.to_string (Fixture.office date).Cel.slug) (Sl.to_string d.LD.observed.Cel.slug)
+
+let suite =
+  ( "Calendar",
+    [ Alcotest.test_case "year covers every day" `Quick test_year_covers_every_day;
+      Alcotest.test_case "day agrees with year" `Quick test_day_agrees_with_year;
+      Alcotest.test_case "outranking sanctoral becomes observed" `Quick
+        test_sanctoral_outranks_feria_becomes_observed;
+      Alcotest.test_case "lower-ranked sanctoral is commemorated" `Quick
+        test_lower_ranked_sanctoral_is_commemorated;
+      Alcotest.test_case "year 9999 does not raise" `Quick test_year_9999_does_not_raise;
+      Alcotest.test_case "day near the domain floor does not raise" `Quick
+        test_day_near_domain_floor_does_not_raise ] )
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index 08282e6..a97e35c 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -2,4 +2,5 @@
 let () =
   Alcotest.run "colitur"
     [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite;
-      Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite ]
+      Test_overlay.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite;
+      Test_calendar.suite ]