feat(render): the view model

Shapes a civil year of resolved days into the value a template renders
against. This layer is why the engine can stay logic-less: a month grid
needs leading blank cells, week bucketing and an in-month test, and a
logic-less template can compute none of it.

Both weeks and days are offered at every level -- the booklet walks
days, the grid walks weeks -- so the two artefacts cannot drift.

Colours are six booleans, not hex: hex bakes a presentation policy into
the engine, and LaTeX, groff and HTML each want a different colour
expression. Asserted: exactly one of the six is true on every day of a
whole year, so a template keying off them can never get none or two.

Padding cells carry every field a real day carries, empty, so a template
never hits a missing key mid-grid.

5 files changed, 355 insertions, 1 deletions

diff --git a/lib/render/view.ml b/lib/render/view.ml
new file mode 100644
index 0000000..9f67705
--- /dev/null
+++ b/lib/render/view.ml
@@ -0,0 +1,145 @@
+module K = Colitur_kernel
+module T = Template
+
+let str s = T.Str s
+let bool b = T.Bool b
+
+let month_names =
+  [| ("Ianuarius", "January"); ("Februarius", "February"); ("Martius", "March");
+     ("Aprilis", "April"); ("Maius", "May"); ("Iunius", "June");
+     ("Iulius", "July"); ("Augustus", "August"); ("September", "September");
+     ("October", "October"); ("November", "November"); ("December", "December") |]
+
+let names_value (n : K.Names.t) =
+  T.Obj (List.map (fun (l, s) -> (K.Lang.to_string l, str s)) (K.Names.to_list n))
+
+let dow_int = function
+  | K.Date.Sun -> 0 | K.Date.Mon -> 1 | K.Date.Tue -> 2 | K.Date.Wed -> 3
+  | K.Date.Thu -> 4 | K.Date.Fri -> 5 | K.Date.Sat -> 6
+
+let citation_ref cits part =
+  match
+    List.find_opt (fun (c : K.Citation.t) -> c.K.Citation.part = part) cits
+  with
+  | Some c -> c.K.Citation.reference
+  | None -> ""
+
+let comm_value (c, priv) =
+  T.Obj
+    [ ("slug", str (K.Slug.to_string c.K.Celebration.slug));
+      ("name", names_value c.K.Celebration.names);
+      ("privileged", bool (priv = K.Precedence.Privileged)) ]
+
+(* A padding cell: present so a grid row always has seven entries, and flagged
+   so a template can render it blank. Every field a real day has is present and
+   empty, so a template never hits a missing key on a padding cell. *)
+let padding_cell dow =
+  T.Obj
+    [ ("iso", str ""); ("dom", str ""); ("dow", str (string_of_int dow));
+      ("in_month", bool false);
+      ("season", str ""); ("week", str ""); ("slug", str "");
+      ("name", T.Obj []); ("rank", str ""); ("rank_label", T.Obj []);
+      ("colour", str "");
+      ("is_white", bool false); ("is_red", bool false); ("is_green", bool false);
+      ("is_violet", bool false); ("is_rose", bool false); ("is_black", bool false);
+      ("subject", str ""); ("comms", T.List []);
+      ("transferred_in", T.List []); ("transferred_out", T.List []);
+      ("first", str ""); ("gospel", str ""); ("last", bool false) ]
+
+let day_value ~vocab (d : ('s, 'r) K.Liturgical_day.t) =
+  let date = d.K.Liturgical_day.date in
+  let tmp = d.K.Liturgical_day.temporal in
+  let cel = d.K.Liturgical_day.observed in
+  let colour = cel.K.Celebration.colour in
+  let is c = bool (colour = c) in
+  T.Obj
+    [ ("iso", str (K.Date.to_iso8601 date));
+      ("dom", str (string_of_int (K.Date.day date)));
+      ("dow", str (string_of_int (dow_int (K.Date.weekday date))));
+      ("in_month", bool true);
+      ("season", str (vocab.K.Vocab.season_to_string tmp.K.Temporal.season));
+      ("week", str (match tmp.K.Temporal.week with Some w -> string_of_int w | None -> ""));
+      ("slug", str (K.Slug.to_string cel.K.Celebration.slug));
+      ("name", names_value cel.K.Celebration.names);
+      ("rank", str (vocab.K.Vocab.rank_to_string cel.K.Celebration.rank));
+      ("rank_label", names_value cel.K.Celebration.names);
+      ("colour", str (K.Colour.to_string colour));
+      ("is_white", is K.Colour.White); ("is_red", is K.Colour.Red);
+      ("is_green", is K.Colour.Green); ("is_violet", is K.Colour.Violet);
+      ("is_rose", is K.Colour.Rose); ("is_black", is K.Colour.Black);
+      ("subject", str (K.Subject.to_string cel.K.Celebration.subject));
+      ("comms", T.List (List.map comm_value d.K.Liturgical_day.commemorations));
+      ( "transferred_in",
+        T.List
+          (match d.K.Liturgical_day.transferred_in with
+           | None -> []
+           | Some c -> [ T.Obj [ ("slug", str (K.Slug.to_string c.K.Celebration.slug)) ] ]) );
+      ( "transferred_out",
+        T.List
+          (List.map
+             (fun (c, dest) ->
+               T.Obj
+                 [ ("slug", str (K.Slug.to_string c.K.Celebration.slug));
+                   ("to", str (K.Date.to_iso8601 dest)) ])
+             d.K.Liturgical_day.transferred_out) );
+      ("first", str (citation_ref d.K.Liturgical_day.citations K.Citation.First));
+      ("gospel", str (citation_ref d.K.Liturgical_day.citations K.Citation.Gospel));
+      (* overwritten per grid row by [set_last]; false in the flat [days] list *)
+      ("last", bool false) ]
+
+(* Bucket a month's day values into Sunday-started weeks of exactly seven cells,
+   padding both ends. This is the computation the template cannot do. *)
+(* [last] is true on the seventh cell of a row. A table row needs its separator
+   BETWEEN cells and the engine has no "unless last" construct, so the flag is
+   data -- the same rule as [in_month]. Without it the LaTeX grid emits eight
+   columns for seven cells and pdflatex rejects the file. *)
+let set_last cells =
+  List.mapi
+    (fun i c -> match c with T.Obj kvs -> T.Obj (("last", bool (i = 6)) :: List.remove_assoc "last" kvs) | v -> v)
+    cells
+
+let weeks_of_month ~first_dow day_values =
+  let lead = List.init first_dow (fun i -> padding_cell i) in
+  let cells = lead @ day_values in
+  let rec chunk acc = function
+    | [] -> List.rev acc
+    | rest ->
+        let take = min 7 (List.length rest) in
+        let week = List.filteri (fun i _ -> i < take) rest in
+        let tl = List.filteri (fun i _ -> i >= take) rest in
+        let week =
+          if take = 7 then week
+          else week @ List.init (7 - take) (fun i -> padding_cell (take + i))
+        in
+        chunk (week :: acc) tl
+  in
+  List.mapi
+    (fun i w -> T.Obj [ ("num", str (string_of_int (i + 1))); ("days", T.List (set_last w)) ])
+    (chunk [] cells)
+
+let of_days ~vocab ~rite ~year days =
+  let dvs = List.map (fun d -> (d, day_value ~vocab d)) days in
+  let months =
+    List.init 12 (fun i ->
+        let m = i + 1 in
+        let own =
+          List.filter (fun (d, _) -> K.Date.month d.K.Liturgical_day.date = m) dvs
+        in
+        let day_values = List.map snd own in
+        let first_dow =
+          match own with
+          | (d, _) :: _ -> dow_int (K.Date.weekday d.K.Liturgical_day.date)
+          | [] -> 0
+        in
+        let la, en = month_names.(i) in
+        T.Obj
+          [ ("num", str (string_of_int m));
+            ("name", T.Obj [ ("la", str la); ("en", str en) ]);
+            ("days", T.List day_values);
+            ("weeks", T.List (weeks_of_month ~first_dow day_values)) ])
+  in
+  T.Obj
+    [ ("rite", str rite);
+      ("year", str (string_of_int year));
+      ("months", T.List months);
+      ("days", T.List (List.map snd dvs)) ]
diff --git a/lib/render/view.mli b/lib/render/view.mli
new file mode 100644
index 0000000..fb48590
--- /dev/null
+++ b/lib/render/view.mli
@@ -0,0 +1,24 @@
+(** Shapes a civil year of resolved days into the value a template renders
+    against (spec section 4).
+
+    This layer exists because a month grid needs leading blank cells, week
+    bucketing and an "is this cell in the current month" test, and a logic-less
+    template can compute none of it. Shaping the data here keeps the engine
+    logic-less AND makes the grid template trivial. The view model IS the design.
+
+    Both [weeks] and [days] are offered at every level: the booklet walks
+    [days], the grid walks [weeks]. One model, two artefacts, no second code
+    path that could drift.
+
+    Colours are exposed as six booleans rather than a hex string: hex would bake
+    a presentation policy into the engine, and LaTeX, groff and HTML each want a
+    different colour expression. Exactly one of the six is true on every day. *)
+
+val of_days :
+  vocab:('s, 'r) Colitur_kernel.Vocab.t ->
+  rite:string ->
+  year:int ->
+  ('s, 'r) Colitur_kernel.Liturgical_day.t list ->
+  Template.value
+(** [of_days ~vocab ~rite ~year days] where [days] is one civil year, 1 January
+    to 31 December, in order. Pure and total. *)
diff --git a/test/test_colitur.ml b/test/test_colitur.ml
index f12dab5..dadc77d 100644
--- a/test/test_colitur.ml
+++ b/test/test_colitur.ml
@@ -9,4 +9,5 @@ let () =
       ("lectionary-ef", Test_lectionary_ef.suite);
       Test_escape.suite;
       Test_template.suite;
-      Test_template.render_suite ]
+      Test_template.render_suite;
+      Test_view.suite ]
diff --git a/test/test_support.ml b/test/test_support.ml
new file mode 100644
index 0000000..7d7662f
--- /dev/null
+++ b/test/test_support.ml
@@ -0,0 +1,65 @@
+(* Loaders for the real EF data (data/ef/*.sexp), extracted from
+   bin/main.ml's [load_ef_layer]/[load_ef_lectionary]/[load_ef_commons]
+   (bin/main.ml:154, :193, :206) and simplified to what the test suite
+   needs: no [~user_overlays], no COLITUR_DATA_DIR/installed-prefix
+   indirection (that machinery exists so the CLI finds its data next to
+   wherever it was installed or built -- tests always run from test/, where
+   test/dune already declares the four data/ef/*.sexp paths as [deps]).
+   Reading them via the same "../data/ef/..." relative paths test_calendar.ml,
+   test_rite_ef.ml and test_lectionary_ef.ml already use, not [bin/]'s own
+   [data_dir ()].
+
+   Deliberately NOT shared as a library with bin/main.ml: [bin/] and [test/]
+   are separate dune stanzas, and three small loaders duplicated here is
+   cheaper than a new library built just to serve them. bin/main.ml is not
+   changed to use this module -- the CLI keeps its own copy, already pinned
+   by test/cli.t. *)
+
+let sanctoral_path = "../data/ef/sanctoral.sexp"
+let adjustments_path = "../data/ef/adjustments.sexp"
+let lectionary_path = "../data/ef/lectionary.sexp"
+let commons_path = "../data/ef/commons.sexp"
+
+(* Mirrors bin/main.ml's [load_ef_layer]: the shipped sanctoral layer with
+   the shipped adjustments overlay merged on top (RG 110's 30 June
+   companion, the Major Litanies, Barbara, Rogation Wednesday -- see
+   adjustments.sexp's own header). No user overlays: the test suite always
+   wants the plain shipped calendar. Diagnostics are discarded rather than
+   surfaced -- the shipped overlay is asserted elsewhere (test_overlay.ml,
+   the "check" path) to merge clean; a test that wants to see them can
+   still call {!Colitur_kernel.Overlay.merge} directly. *)
+let load_ef_layer () =
+  match Colitur_kernel.Layer.load Rite_ef.Vocab_ef.rank_of_sexp sanctoral_path with
+  | Error e -> Error (Printf.sprintf "failed to load %s: %s" sanctoral_path e)
+  | Ok layer -> (
+      match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with
+      | Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e)
+      | Ok overlay ->
+          let layer, _diagnostics = Colitur_kernel.Overlay.merge layer [ overlay ] in
+          Ok layer)
+
+(* Mirrors bin/main.ml's [load_ef_lectionary]. *)
+let load_ef_lectionary () =
+  match Colitur_kernel.Lectionary.load lectionary_path with
+  | Error e -> Error (Printf.sprintf "failed to load %s: %s" lectionary_path e)
+  | Ok l -> Ok l
+
+(* Mirrors bin/main.ml's [load_ef_commons]. *)
+let load_ef_commons () =
+  match Rite_ef.Lectionary_ef.Commons.load commons_path with
+  | Error e -> Error (Printf.sprintf "failed to load %s: %s" commons_path e)
+  | Ok c -> Ok c
+
+(* Assembles [Rite_ef.context] the way bin/main.ml:328 does, over the real
+   shipped lectionary and Commons. Raises on a load failure rather than
+   returning a [result]: the four data files are declared [deps] in
+   test/dune, so a failure here means the test tree itself is broken, the
+   same condition test_calendar.ml's and test_rite_ef.ml's own
+   module-level loaders already treat as fatal. *)
+let ef_context () =
+  match load_ef_lectionary () with
+  | Error e -> failwith e
+  | Ok lectionary -> (
+      match load_ef_commons () with
+      | Error e -> failwith e
+      | Ok commons -> Rite_ef.context ~lectionary ~commons)
diff --git a/test/test_view.ml b/test/test_view.ml
new file mode 100644
index 0000000..e595357
--- /dev/null
+++ b/test/test_view.ml
@@ -0,0 +1,119 @@
+module V = Colitur_render.View
+module T = Colitur_render.Template
+
+(* Build one civil year of resolved days exactly as the CLI does. *)
+let days_of_year y =
+  let layer =
+    match Test_support.load_ef_layer () with Ok l -> l | Error e -> Alcotest.failf "layer: %s" e
+  in
+  let context = Test_support.ef_context () in
+  let module Cal = Colitur_kernel.Calendar in
+  let module D = Colitur_kernel.Date in
+  let tbl = Hashtbl.create 400 in
+  let index days =
+    Array.iter (fun d -> Hashtbl.replace tbl (D.to_rata d.Colitur_kernel.Liturgical_day.date) d) days
+  in
+  index (Cal.year context layer (y - 1));
+  index (Cal.year context layer y);
+  let jan1 = Result.get_ok (D.make ~year:y ~month:1 ~day:1) in
+  let dec31 = Result.get_ok (D.make ~year:y ~month:12 ~day:31) in
+  let out = ref [] and d = ref jan1 in
+  while D.compare !d dec31 <= 0 do
+    (match Hashtbl.find_opt tbl (D.to_rata !d) with Some x -> out := x :: !out | None -> ());
+    d := D.add_days !d 1
+  done;
+  List.rev !out
+
+let view_of y =
+  V.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y)
+
+let get path v =
+  let rec go v = function
+    | [] -> v
+    | k :: tl -> (
+        match v with
+        | T.Obj kvs -> (
+            match List.assoc_opt k kvs with Some v' -> go v' tl | None -> Alcotest.failf "no key %s" k)
+        | _ -> Alcotest.failf "not an object at %s" k)
+  in
+  go v path
+
+let as_list = function T.List l -> l | _ -> Alcotest.fail "expected a list"
+let as_str = function T.Str s -> s | _ -> Alcotest.fail "expected a string"
+let as_bool = function T.Bool b -> b | _ -> Alcotest.fail "expected a bool"
+
+let test_year_shape () =
+  let v = view_of 2027 in
+  Alcotest.(check string) "rite" "ef" (as_str (get [ "rite" ] v));
+  Alcotest.(check string) "year" "2027" (as_str (get [ "year" ] v));
+  Alcotest.(check int) "twelve months" 12 (List.length (as_list (get [ "months" ] v)));
+  Alcotest.(check int) "365 days" 365 (List.length (as_list (get [ "days" ] v)))
+
+(* THE property the grid depends on: weeks flatten to the month's days plus
+   padding, and every real day appears exactly once (spec section 9.3). *)
+let test_weeks_flatten_to_days () =
+  let v = view_of 2027 in
+  List.iter
+    (fun m ->
+      let weeks = as_list (get [ "weeks" ] m) in
+      let cells = List.concat_map (fun w -> as_list (get [ "days" ] w)) weeks in
+      List.iter
+        (fun w -> Alcotest.(check int) "seven cells per week" 7 (List.length (as_list (get [ "days" ] w))))
+        weeks;
+      let real = List.filter (fun c -> as_bool (get [ "in_month" ] c)) cells in
+      let own = as_list (get [ "days" ] m) in
+      Alcotest.(check int) "real cells = month days" (List.length own) (List.length real);
+      List.iter2
+        (fun a b -> Alcotest.(check string) "same day, same order" (as_str (get [ "iso" ] a)) (as_str (get [ "iso" ] b)))
+        own real)
+    (as_list (get [ "months" ] v))
+
+let test_padding_cells_are_flagged () =
+  let v = view_of 2027 in
+  let jan = List.hd (as_list (get [ "months" ] v)) in
+  let first_week = List.hd (as_list (get [ "weeks" ] jan)) in
+  let cells = as_list (get [ "days" ] first_week) in
+  (* 1 January 2027 is a Friday, so the first week has five padding cells. *)
+  Alcotest.(check int) "five padding cells" 5
+    (List.length (List.filter (fun c -> not (as_bool (get [ "in_month" ] c))) cells));
+  List.iter
+    (fun c ->
+      if not (as_bool (get [ "in_month" ] c)) then
+        Alcotest.(check string) "padding has empty iso" "" (as_str (get [ "iso" ] c)))
+    cells
+
+let test_day_fields () =
+  let v = view_of 2027 in
+  let d =
+    List.find (fun d -> as_str (get [ "iso" ] d) = "2027-01-13") (as_list (get [ "days" ] v))
+  in
+  Alcotest.(check string) "slug" "commemoration-of-the-baptism-of-the-lord" (as_str (get [ "slug" ] d));
+  Alcotest.(check string) "colour" "white" (as_str (get [ "colour" ] d));
+  Alcotest.(check bool) "is_white" true (as_bool (get [ "is_white" ] d));
+  Alcotest.(check bool) "is_violet" false (as_bool (get [ "is_violet" ] d));
+  Alcotest.(check int) "dow friday" 3 (int_of_string (as_str (get [ "dow" ] d)));
+  Alcotest.(check bool) "first citation present" true (as_str (get [ "first" ] d) <> "");
+  Alcotest.(check bool) "gospel citation present" true (as_str (get [ "gospel" ] d) <> "")
+
+(* Exactly one of the six colour booleans is true on every day of a whole year:
+   a template that keys a cell colour off them can never get no colour or two. *)
+let test_exactly_one_colour_flag () =
+  let v = view_of 2027 in
+  List.iter
+    (fun d ->
+      let n =
+        List.length
+          (List.filter
+             (fun k -> as_bool (get [ k ] d))
+             [ "is_white"; "is_red"; "is_green"; "is_violet"; "is_rose"; "is_black" ])
+      in
+      if n <> 1 then Alcotest.failf "%s has %d colour flags set" (as_str (get [ "iso" ] d)) n)
+    (as_list (get [ "days" ] v))
+
+let suite =
+  ( "View",
+    [ Alcotest.test_case "year shape" `Quick test_year_shape;
+      Alcotest.test_case "weeks flatten to days" `Quick test_weeks_flatten_to_days;
+      Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged;
+      Alcotest.test_case "day fields" `Quick test_day_fields;
+      Alcotest.test_case "exactly one colour flag" `Quick test_exactly_one_colour_flag ] )