aboutsummaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-20 11:32:24 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-20 11:32:24 +0200
commite2e56ac5af290b60ea01037e58e8bc00545c021c (patch)
tree6346f4ee62809323e8fb0f9041b28e35787d9828 /lib
parentc30a35e1da315f2a44e5b53c714bdcf4d8992d2c (diff)
downloadcolitur-e2e56ac5af290b60ea01037e58e8bc00545c021c.tar.gz
colitur-e2e56ac5af290b60ea01037e58e8bc00545c021c.zip
feat(render): Roman week numbers and date spans, as data
The ordo booklet's week header repeated the month name on every week even though the heading above already established it -- pure noise. Replace it with a Roman week number plus the span of dates the week covers, e.g. "Hebdomada I (Ian 1-2)", following the project's own rule that a presentation choice is data, not code. lang/{la,en}.ini gain a [month_abbr] section (three-letter month abbreviations); Lang.month_abbr follows Lang.month's exact shape, including the out-of-range and miss-returns-the-key contracts. The coverage test now fails loudly if an abbreviation goes missing, the same as [month] already does. Every week object in the view gains num_roman (Roman numeral, num stays as the arabic original -- Roman is a presentation choice, not an engine change), first_dom/last_dom (the day-of-month of the week's first and last IN-MONTH days, padding excluded), month_abbr (resolved through Lang.month_abbr), and single_day (true when the week holds exactly one in-month day). single_day is a flag, not a preformatted span string: the engine is logic-less and cannot itself decide between "Ian 1" and "Ian 1-2", so a template makes that call from the flag instead -- the same "shape the data, not the template" discipline in_month and last already follow. Weeks are built per month with padding only at the two ends, so a week's in-month days never cross a month boundary -- verified, not assumed: every week always has at least one real day since no month is shorter than a single week. Covered by three new View tests, including a real single-day-week witness (January 2027's own trailing week is a lone Sunday, the 31st).
Diffstat (limited to 'lib')
-rw-r--r--lib/naming/lang.ml14
-rw-r--r--lib/naming/lang.mli7
-rw-r--r--lib/render/view.ml84
3 files changed, 94 insertions, 11 deletions
diff --git a/lib/naming/lang.ml b/lib/naming/lang.ml
index 92c8a9a..2301513 100644
--- a/lib/naming/lang.ml
+++ b/lib/naming/lang.ml
@@ -10,6 +10,7 @@ type t = {
celebration : table;
weekday : table;
month : table;
+ month_abbr : table;
season : table;
rank : table;
colour : table;
@@ -54,13 +55,17 @@ let month t n =
if n < 1 || n > 12 then string_of_int n
else match lookup t (fun x -> x.month) (string_of_int n) with Some v -> v | None -> string_of_int n
+let month_abbr t n =
+ if n < 1 || n > 12 then string_of_int n
+ else match lookup t (fun x -> x.month_abbr) (string_of_int n) with Some v -> v | None -> string_of_int n
+
let code t = t.code
let fallback_code t = t.fallback_code
let raw =
{ code = "raw"; fallback_code = None; celebration = empty_table; weekday = empty_table;
- month = empty_table; season = empty_table; rank = empty_table; colour = empty_table;
- term = empty_table; rite = empty_table; chain = None }
+ month = empty_table; month_abbr = empty_table; season = empty_table; rank = empty_table;
+ colour = empty_table; term = empty_table; rite = empty_table; chain = None }
let with_fallback t base = { t with chain = Some base }
@@ -96,6 +101,7 @@ let of_string text =
celebration = find "celebration";
weekday = find "weekday";
month = find "month";
+ month_abbr = find "month_abbr";
season = find "season";
rank = find "rank";
colour = find "colour";
@@ -107,6 +113,6 @@ let keys t =
let qualify prefix m = SM.bindings m |> List.map (fun (k, v) -> (prefix ^ "." ^ k, v)) in
List.concat
[ qualify "celebration" t.celebration; qualify "weekday" t.weekday;
- qualify "month" t.month; qualify "season" t.season; qualify "rank" t.rank;
- qualify "colour" t.colour; qualify "term" t.term; qualify "rite" t.rite ]
+ qualify "month" t.month; qualify "month_abbr" t.month_abbr; qualify "season" t.season;
+ qualify "rank" t.rank; qualify "colour" t.colour; qualify "term" t.term; qualify "rite" t.rite ]
|> List.sort compare
diff --git a/lib/naming/lang.mli b/lib/naming/lang.mli
index 4d7f82f..34a6d5d 100644
--- a/lib/naming/lang.mli
+++ b/lib/naming/lang.mli
@@ -61,6 +61,13 @@ val weekday : t -> int -> string
(** [month t n], 1 = January. Out-of-range [n] returns [string_of_int n]. *)
val month : t -> int -> string
+(** [month_abbr t n], 1 = January, e.g. ["Ian"]/["Jan"]. Same shape as
+ {!month}: out-of-range [n] returns [string_of_int n], and a miss falls
+ back through the chain to [string_of_int n] as well, never to [month]'s
+ own full name -- an abbreviation is its own vocabulary, not a truncation
+ of another lookup. *)
+val month_abbr : t -> int -> string
+
(** Every (section-qualified key, value) pair, sorted. Used by [lang --dump] and
[lang --check]. Keys are qualified as e.g. ["celebration.ef-epiphany"]. *)
val keys : t -> (string * string) list
diff --git a/lib/render/view.ml b/lib/render/view.ml
index bedf998..9f489aa 100644
--- a/lib/render/view.ml
+++ b/lib/render/view.ml
@@ -5,6 +5,40 @@ module Lang = Colitur_naming.Lang
let str s = T.Str s
let bool b = T.Bool b
+(* Roman numerals for the ordo booklet's own week header ("Hebdomada I" in
+ place of the arabic "Hebdomada 1"): a subtractive-form table, most
+ significant symbol first, greedily consumed -- the standard algorithm,
+ correct for any n >= 1 even though a month's own week count never
+ exceeds six (RG carries no numeral convention of its own to cite here;
+ this is general vocabulary, the same call [month]/[weekday] already
+ made). [num] (arabic) stays alongside it in the view -- see
+ [weeks_of_month] below -- so a tradition wanting arabic numbering keeps
+ that option without an engine change. *)
+let roman_numeral n =
+ let table =
+ [ (1000, "M"); (900, "CM"); (500, "D"); (400, "CD"); (100, "C"); (90, "XC");
+ (50, "L"); (40, "XL"); (10, "X"); (9, "IX"); (5, "V"); (4, "IV"); (1, "I") ]
+ in
+ let buf = Buffer.create 8 in
+ let rec go n = function
+ | [] -> ()
+ | (v, s) :: rest -> if n >= v then begin Buffer.add_string buf s; go (n - v) ((v, s) :: rest) end else go n rest
+ in
+ go n table;
+ Buffer.contents buf
+
+(* Read a field back off a cell this same module just built ([day_value] or
+ [padding_cell]), for [weeks_of_month]'s own first/last-in-month-day
+ computation below. Not a general accessor -- it only needs to survive the
+ two shapes this file emits. *)
+let field_str key = function
+ | T.Obj kvs -> ( match List.assoc_opt key kvs with Some (T.Str s) -> s | _ -> "")
+ | _ -> ""
+
+let field_bool key = function
+ | T.Obj kvs -> ( match List.assoc_opt key kvs with Some (T.Bool b) -> b | _ -> false)
+ | _ -> false
+
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
@@ -117,14 +151,20 @@ 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
-(* [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
+(* [month_num]/[month_name]/[month_abbr] 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, 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 =
+ [last] flag above already made.
+
+ Weeks are built per-month, one call to this function per month, with
+ [day_values] already filtered to that month alone by the caller
+ ([of_days] below) -- so a week's in-month days can never cross a month
+ boundary; the padding this function adds at both ends is the only thing
+ that ever fills a cell with no [dom] of its own. *)
+let weeks_of_month ~first_dow ~month_num ~month_name ~month_abbr 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
@@ -141,10 +181,39 @@ let weeks_of_month ~first_dow ~month_num ~month_name day_values =
in
List.mapi
(fun i w ->
+ (* The week's own in-month days only, in date order (padding cells
+ carry [in_month = false] and are excluded) -- always non-empty:
+ padding only ever occupies the LEAD of a month's first week or the
+ TAIL of its last, never a whole week, since every month has more
+ real days than a single week can hold. *)
+ let in_month_doms =
+ List.filter_map
+ (fun c -> if field_bool "in_month" c then Some (int_of_string (field_str "dom" c)) else None)
+ w
+ in
+ let first_dom = match in_month_doms with d :: _ -> d | [] -> 0 in
+ let last_dom = match List.rev in_month_doms with d :: _ -> d | [] -> 0 in
T.Obj
[ ("num", str (string_of_int (i + 1)));
+ (* The week number as a Roman numeral -- a presentation choice a
+ template opts into; [num] (arabic) stays alongside it so a
+ tradition wanting arabic keeps that without an engine change. *)
+ ("num_roman", str (roman_numeral (i + 1)));
("month_num", str month_num);
("month_name", str month_name);
+ ("month_abbr", str month_abbr);
+ ("first_dom", str (string_of_int first_dom));
+ ("last_dom", str (string_of_int last_dom));
+ (* True when the week holds exactly one in-month day -- the flag a
+ template needs to choose "Ian 1" over "Ian 1-2" (an en dash plus
+ [last_dom] only inside {{^single_day}}). The engine is
+ logic-less and cannot compare [first_dom] to [last_dom] itself,
+ so the decision is shaped here as data, the same "cheap flag
+ beats invented template logic" call [last]/[first] above
+ already made -- and deliberately NOT a preformatted span
+ string, which would bake a punctuation choice into the engine a
+ template or language could no longer change. *)
+ ("single_day", bool (List.length in_month_doms = 1));
(* True on the month's own first week -- Defect 2 (the continuous
ordo booklet): with the per-week page break gone, a template
needs SOME signal to print a stronger, standalone month banner
@@ -192,11 +261,12 @@ let of_days ~lang ~vocab ~rite ~year days =
in
let month_num = string_of_int m in
let month_name = Lang.month lang m in
+ let month_abbr = Lang.month_abbr lang m in
T.Obj
[ ("num", str month_num);
("name", str month_name);
("days", T.List day_values);
- ("weeks", T.List (weeks_of_month ~first_dow ~month_num ~month_name day_values)) ])
+ ("weeks", T.List (weeks_of_month ~first_dow ~month_num ~month_name ~month_abbr day_values)) ])
in
T.Obj
[ ("rite", str rite);