From 5828571fa31a0480838d1ede210002ab50768c64 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 08:27:22 +0200 Subject: 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. --- lib/render/view.ml | 145 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 lib/render/view.ml (limited to 'lib/render/view.ml') 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)) ] -- cgit v1.3