aboutsummaryrefslogtreecommitdiff
path: root/lib/render
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:27:22 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-19 08:27:22 +0200
commit5828571fa31a0480838d1ede210002ab50768c64 (patch)
treebe4bbb946c2e75cdc268f858b0575edbbbbcf401 /lib/render
parentda9cf402ceed8102aec1a9d008f8e918a23d39f3 (diff)
downloadcolitur-5828571fa31a0480838d1ede210002ab50768c64.tar.gz
colitur-5828571fa31a0480838d1ede210002ab50768c64.zip
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.
Diffstat (limited to 'lib/render')
-rw-r--r--lib/render/view.ml145
-rw-r--r--lib/render/view.mli24
2 files changed, 169 insertions, 0 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. *)