diff options
Diffstat (limited to 'lib/render/view.ml')
| -rw-r--r-- | lib/render/view.ml | 121 |
1 files changed, 85 insertions, 36 deletions
diff --git a/lib/render/view.ml b/lib/render/view.ml index 733aa45..bbb8c7d 100644 --- a/lib/render/view.ml +++ b/lib/render/view.ml @@ -1,18 +1,10 @@ module K = Colitur_kernel module T = Template +module Lang = Colitur_naming.Lang 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 @@ -24,55 +16,78 @@ let citation_ref cits part = | Some c -> c.K.Citation.reference | None -> "" -let comm_value (c, priv) = +(* A commemoration's own name resolves through the SAME [lang.celebration] + table as the observed day's -- a commemoration's slug is drawn from the + identical sanctoral/temporal pool, not a second vocabulary. Templates + (the ordo booklet, Task 8) interpolate this as a plain [{{name}}] inside + [{{#comms}}], so it must be a string here too, not the kernel's own + lang-keyed [Celebration.names] object -- the same reasoning [day_value]'s + own [name] follows below, applied consistently rather than left as a + second, differently-shaped name field a template author would have to + remember. *) +let comm_value ~lang (c, priv) = + let slug_s = K.Slug.to_string c.K.Celebration.slug in T.Obj - [ ("slug", str (K.Slug.to_string c.K.Celebration.slug)); - ("name", names_value c.K.Celebration.names); + [ ("slug", str slug_s); + ("name", str (Lang.celebration lang slug_s)); ("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. *) + empty, so a template never hits a missing key on a padding cell -- the same + key SET as [day_value], not merely the same shape by coincidence. *) 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 ""); - ("colour", str ""); + ("season", str ""); ("season_name", str ""); + ("week", str ""); ("slug", str ""); + ("name", str ""); ("weekday", str ""); + ("rank", str ""); ("rank_name", str ""); + ("colour", str ""); ("colour_name", 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 day_value ~lang ~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 + let slug_s = K.Slug.to_string cel.K.Celebration.slug in + let rank_s = vocab.K.Vocab.rank_to_string cel.K.Celebration.rank in + let colour_s = K.Colour.to_string colour in + let season_s = vocab.K.Vocab.season_to_string tmp.K.Temporal.season 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)); + ("season", str season_s); + ("season_name", str (Lang.season lang season_s)); ("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] is the kernel's own class string ("class-1"); there is - deliberately no separate localized rank label here -- the kernel - has no per-language rank names to draw one from, and a field - whose contents cannot honestly differ from [name] should not - exist just to exist. Do not re-add one until the kernel can. *) - ("rank", str (vocab.K.Vocab.rank_to_string cel.K.Celebration.rank)); - ("colour", str (K.Colour.to_string colour)); + ("slug", str slug_s); + (* The resolved display name. A plain string, not a lang-keyed object: + a dotted {{name.la}} used to fall back WHOLESALE to the enclosing + month's own name.la and print "Ianuarius" on unnamed days. One + string removes that hazard entirely -- there is no dotted path left + for a partial match to climb out of. Under [Lang.raw] this equals + [slug] exactly (every lookup in the identity table echoes its key), + which is what makes [--raw] output byte-stable. *) + ("name", str (Lang.celebration lang slug_s)); + ("weekday", str (Lang.weekday lang (dow_int (K.Date.weekday date)))); + ("rank", str rank_s); + ("rank_name", str (Lang.rank lang rank_s)); + ("colour", str colour_s); + ("colour_name", str (Lang.colour lang colour_s)); ("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)); + ("comms", T.List (List.map (comm_value ~lang) d.K.Liturgical_day.commemorations)); ( "transferred_in", T.List (match d.K.Liturgical_day.transferred_in with @@ -102,7 +117,14 @@ let set_last cells = (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 = +(* [month_num]/[month_name] are carried onto every WEEK object because the + engine has no {{../}} parent-path syntax: a nested {{num}} inside a week + silently finds the WEEK's own number, never the month's, so a template + that needs the month (the ordo booklet, Task 8, whose weeks span a + {{#months}}{{#weeks}} nesting) has no other way to reach it. Shaping the + data here, rather than inventing template syntax, is the same call the + [last] flag above already made. *) +let weeks_of_month ~first_dow ~month_num ~month_name 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 @@ -118,11 +140,35 @@ let weeks_of_month ~first_dow day_values = 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)) ]) + (fun i w -> + T.Obj + [ ("num", str (string_of_int (i + 1))); + ("month_num", str month_num); + ("month_name", str month_name); + ("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 +(* The [term] vocabulary a template routes every fixed string through + ({{term.epistle}}, {{term.week}}, ...) so a translated booklet needs no + template edit. The key list is the vocabulary's own fixed, closed set + (lang/*.ini's own [term] section, Task 1/3) -- not open like [celebration], + so it is named here rather than invented a second time from a wildcard + enumeration. *) +let term_keys = [ "ordo"; "contents"; "epistle"; "lesson"; "gospel"; "commemoration"; "week" ] + +let term_value lang = T.Obj (List.map (fun k -> (k, str (Lang.term lang k))) term_keys) + +(* A localised grid header row: {name; last} objects, not bare strings -- + the engine rejects an empty tag path ({{.}}) as a parse error, so a + template walking this list needs a named field to interpolate. Always + Sunday-first (index 0), matching [padding_cell]'s own [dow] numbering and + every week this view builds. *) +let weekday_headings lang = + T.List + (List.init 7 (fun i -> T.Obj [ ("name", str (Lang.weekday lang i)); ("last", bool (i = 6)) ])) + +let of_days ~lang ~vocab ~rite ~year days = + let dvs = List.map (fun d -> (d, day_value ~lang ~vocab d)) days in let months = List.init 12 (fun i -> let m = i + 1 in @@ -135,15 +181,18 @@ let of_days ~vocab ~rite ~year days = | (d, _) :: _ -> dow_int (K.Date.weekday d.K.Liturgical_day.date) | [] -> 0 in - let la, en = month_names.(i) in + let month_num = string_of_int m in + let month_name = Lang.month lang m in T.Obj - [ ("num", str (string_of_int m)); - ("name", T.Obj [ ("la", str la); ("en", str en) ]); + [ ("num", str month_num); + ("name", str month_name); ("days", T.List day_values); - ("weeks", T.List (weeks_of_month ~first_dow day_values)) ]) + ("weeks", T.List (weeks_of_month ~first_dow ~month_num ~month_name day_values)) ]) in T.Obj [ ("rite", str rite); ("year", str (string_of_int year)); + ("term", term_value lang); + ("weekday_headings", weekday_headings lang); ("months", T.List months); ("days", T.List (List.map snd dvs)) ] |