diff options
| -rw-r--r-- | lang/en.ini | 17 | ||||
| -rw-r--r-- | lang/la.ini | 19 | ||||
| -rw-r--r-- | lib/naming/lang.ml | 14 | ||||
| -rw-r--r-- | lib/naming/lang.mli | 7 | ||||
| -rw-r--r-- | lib/render/view.ml | 84 | ||||
| -rw-r--r-- | test/test_lang.ml | 3 | ||||
| -rw-r--r-- | test/test_lang_coverage.ml | 3 | ||||
| -rw-r--r-- | test/test_view.ml | 65 |
8 files changed, 201 insertions, 11 deletions
diff --git a/lang/en.ini b/lang/en.ini index bfd7689..98b3120 100644 --- a/lang/en.ini +++ b/lang/en.ini @@ -47,6 +47,23 @@ saturday = Saturday 11 = November 12 = December +[month_abbr] +; Three-letter abbreviations for the printed booklet's week header -- see +; lang/la.ini's own [month_abbr] note for why. Each is the first three +; letters of [month]'s own name above, except May, already three letters. +1 = Jan +2 = Feb +3 = Mar +4 = Apr +5 = May +6 = Jun +7 = Jul +8 = Aug +9 = Sep +10 = Oct +11 = Nov +12 = Dec + [season] advent = Advent christmastide = Christmastide diff --git a/lang/la.ini b/lang/la.ini index 9cbb8fe..536f717 100644 --- a/lang/la.ini +++ b/lang/la.ini @@ -66,6 +66,25 @@ saturday = Sabbatum 11 = November 12 = December +[month_abbr] +; Three-letter abbreviations for the printed booklet's week header (a +; span like "Ian 1-2" beside a Roman week number, so the header need not +; repeat the month name spelled out in full). Each is simply the first +; three letters of [month]'s own name above -- no separate sourcing, since +; this is general vocabulary rather than a Missal heading either. +1 = Ian +2 = Feb +3 = Mar +4 = Apr +5 = Mai +6 = Iun +7 = Iul +8 = Aug +9 = Sep +10 = Oct +11 = Nov +12 = Dec + [season] ; RG 71-77's own season names. Five of eight are direct Proprium de Tempore ; section headings in docs/research/LT.txt (line numbers below); the other 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); diff --git a/test/test_lang.ml b/test/test_lang.ml index b54e85b..c9b7f1a 100644 --- a/test/test_lang.ml +++ b/test/test_lang.ml @@ -14,6 +14,8 @@ let sample = monday = Feria II\n\ [month]\n\ 1 = Ianuarius\n\ + [month_abbr]\n\ + 1 = Ian\n\ [season]\n\ lent = Quadragesima\n\ [rank]\n\ @@ -34,6 +36,7 @@ let test_lookups () = (L.celebration t "ef-lent-3-monday"); Alcotest.(check string) "weekday 0 is Sunday" "Dominica" (L.weekday t 0); Alcotest.(check string) "month 1" "Ianuarius" (L.month t 1); + Alcotest.(check string) "month_abbr 1" "Ian" (L.month_abbr t 1); Alcotest.(check string) "season" "Quadragesima" (L.season t "lent"); Alcotest.(check string) "rank" "I classis" (L.rank t "class-1"); Alcotest.(check string) "colour" "albus" (L.colour t "white"); diff --git a/test/test_lang_coverage.ml b/test/test_lang_coverage.ml index 9ed633c..b4de5be 100644 --- a/test/test_lang_coverage.ml +++ b/test/test_lang_coverage.ml @@ -78,6 +78,9 @@ let test_vocabularies_are_complete () = done; for n = 1 to 12 do if L.month t n = string_of_int n then Alcotest.failf "no Latin month for %d" n + done; + for n = 1 to 12 do + if L.month_abbr t n = string_of_int n then Alcotest.failf "no Latin month abbreviation for %d" n done (* Defect 1: the booklet used to print the bare rite id ("ef") because no diff --git a/test/test_view.ml b/test/test_view.ml index 24e1d85..37fb284 100644 --- a/test/test_view.ml +++ b/test/test_view.ml @@ -182,6 +182,68 @@ let latin () = let view_named y = V.of_days ~lang:(latin ()) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y) +(* The ordo booklet's week header (Hebdomada I (Ian 1-2)): a Roman numeral + beside the existing arabic one, and month_num/month_name/month_abbr + carried onto every week the same way (there is no {{../}} parent-path + syntax to reach the enclosing month otherwise). January 2027 has six + weeks (1 Jan 2027 is a Friday, 31 Jan a lone trailing Sunday), so I-VI + is a real witness, not a guess capped at a small sample. *) +let test_week_num_roman_and_month_fields () = + let v = view_named 2027 in + let jan = List.hd (as_list (get [ "months" ] v)) in + let weeks = as_list (get [ "weeks" ] jan) in + Alcotest.(check int) "January 2027 has six weeks" 6 (List.length weeks); + Alcotest.(check (list string)) "I..VI" [ "I"; "II"; "III"; "IV"; "V"; "VI" ] + (List.map (fun w -> as_str (get [ "num_roman" ] w)) weeks); + List.iter + (fun w -> + Alcotest.(check string) "month_num" "1" (as_str (get [ "month_num" ] w)); + Alcotest.(check string) "month_name" "Ianuarius" (as_str (get [ "month_name" ] w)); + Alcotest.(check string) "month_abbr" "Ian" (as_str (get [ "month_abbr" ] w))) + weeks + +(* The date-span fields a template needs to print "(Ian 1-2)" without ever + being handed a preformatted string (spec: the engine is logic-less, so a + punctuation choice between "Ian 1" and "Ian 1-2" must stay data the + template or a language file can still change). Verified against real + 1 January 2027 = Friday / 31 January 2027 = Sunday arithmetic: the + month's first week holds only its own leading two in-month days (1-2), + and its own LAST week -- a lone trailing Sunday, 31 -- is this whole + suite's single-day-week witness. *) +let test_week_date_span () = + let v = view_named 2027 in + let jan = List.hd (as_list (get [ "months" ] v)) in + let weeks = as_list (get [ "weeks" ] jan) in + let first_week = List.hd weeks in + Alcotest.(check string) "week 1 first_dom" "1" (as_str (get [ "first_dom" ] first_week)); + Alcotest.(check string) "week 1 last_dom" "2" (as_str (get [ "last_dom" ] first_week)); + Alcotest.(check bool) "week 1 is not a single day" false (as_bool (get [ "single_day" ] first_week)); + let last_week = List.nth weeks (List.length weeks - 1) in + Alcotest.(check string) "week 6 first_dom" "31" (as_str (get [ "first_dom" ] last_week)); + Alcotest.(check string) "week 6 last_dom" "31" (as_str (get [ "last_dom" ] last_week)); + Alcotest.(check bool) "week 6 IS a single day" true (as_bool (get [ "single_day" ] last_week)) + +(* Property, not a one-off sample: over every week of every month of a whole + year, [single_day] must agree exactly with [first_dom] = [last_dom], and + the count of in-month cells in [days] must match what [single_day] claims + -- proves the flag is computed FROM the same in-month cells a template + walks, not from a separately-derived (and possibly drifting) count. *) +let test_single_day_agrees_with_span_and_cells () = + let v = view_of 2027 in + List.iter + (fun m -> + List.iter + (fun w -> + let first_dom = as_str (get [ "first_dom" ] w) and last_dom = as_str (get [ "last_dom" ] w) in + let single = as_bool (get [ "single_day" ] w) in + Alcotest.(check bool) "single_day iff first_dom = last_dom" (first_dom = last_dom) single; + let real_cells = + List.filter (fun c -> as_bool (get [ "in_month" ] c)) (as_list (get [ "days" ] w)) + in + if single then Alcotest.(check int) "single day: exactly one real cell" 1 (List.length real_cells)) + (as_list (get [ "weeks" ] m))) + (as_list (get [ "months" ] v)) + (* The defect this whole branch exists to fix: no rendered day may show a slug where a name exists. Asserted over a whole year, not a sample. *) let test_no_day_shows_a_slug () = @@ -227,6 +289,9 @@ let suite = Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged; Alcotest.test_case "first week flagged" `Quick test_first_week_flag; Alcotest.test_case "padding and real days share key set" `Quick test_padding_and_real_share_key_set; + Alcotest.test_case "week num_roman and month fields" `Quick test_week_num_roman_and_month_fields; + Alcotest.test_case "week date span" `Quick test_week_date_span; + Alcotest.test_case "single_day agrees with span and cells" `Quick test_single_day_agrees_with_span_and_cells; Alcotest.test_case "no day shows a slug" `Quick test_no_day_shows_a_slug; Alcotest.test_case "slug unchanged by naming" `Quick test_slug_is_unchanged_by_naming; Alcotest.test_case "raw name equals slug" `Quick test_raw_name_equals_slug; |