diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-20 11:32:24 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-20 11:32:24 +0200 |
| commit | e2e56ac5af290b60ea01037e58e8bc00545c021c (patch) | |
| tree | 6346f4ee62809323e8fb0f9041b28e35787d9828 /lib/render/view.ml | |
| parent | c30a35e1da315f2a44e5b53c714bdcf4d8992d2c (diff) | |
| download | colitur-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/render/view.ml')
| -rw-r--r-- | lib/render/view.ml | 84 |
1 files changed, 77 insertions, 7 deletions
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); |
