From 45bcbde502e07ad73b96039fcbb62471a3c94781 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 13:34:53 +0200 Subject: feat(naming): the language table Maps strings to strings and nothing else -- no calendars, no dates, no filesystem. That is what lets every command use it without the kernel learning about presentation. Every lookup is total, and a miss returns THE KEY rather than the empty string. A partial translation is therefore usable from its first line, and the fully-degraded case is exactly today's output (bare slugs) rather than a blank page. --raw is a real identity table, not a special case threaded through every call site: one value the whole program passes around. Reuses Overlay_ini's INI reader rather than growing a second one that would drift in its comment, quoting and trimming rules; parse_sections is exposed in the .mli for that, with no behaviour change. Fixes one defect found while running the brief's own tests rather than transcribing them blind: weekday's internal lookup key is an English day-name word (month's is already the numeral string), so on a miss it echoed that word instead of the documented numeral, breaking both the 0=Sunday convention and Lang.raw's own identity contract for weekday. weekday/month now fall back to string_of_int n directly on a miss instead of through get's generic echo-the-search-key path; month is byte-identical since its key already equals string_of_int n. --- lib/kernel/overlay_ini.mli | 9 +++++ lib/naming/dune | 3 ++ lib/naming/lang.ml | 96 ++++++++++++++++++++++++++++++++++++++++++++++ lib/naming/lang.mli | 44 +++++++++++++++++++++ 4 files changed, 152 insertions(+) create mode 100644 lib/naming/dune create mode 100644 lib/naming/lang.ml create mode 100644 lib/naming/lang.mli (limited to 'lib') diff --git a/lib/kernel/overlay_ini.mli b/lib/kernel/overlay_ini.mli index bace93b..321cac1 100644 --- a/lib/kernel/overlay_ini.mli +++ b/lib/kernel/overlay_ini.mli @@ -32,6 +32,15 @@ Dates take three forms, matching {!Date_spec}: [MM-DD], [easter+N] or [easter-N], and [mon/day/nth] such as [oct/sun/1] or [oct/sun/-1]. *) +(** One [section] of a flat INI file. Exposed so other libraries (the language + and config files) reuse this reader rather than growing a second one that + would drift in its comment, quoting and trimming rules. *) +type section = { name : string; fields : (string * string) list } + +(** Split INI text into sections. [\[section\]] headers, [key = value] lines, + ';' and '#' comments, blank lines ignored. Never raises. *) +val parse_sections : string -> (section list, string) result + (** [parse ~rank_of_string text] is the overlay [text] denotes. [rank_of_string] is supplied by the rite, exactly as [Overlay.load] takes diff --git a/lib/naming/dune b/lib/naming/dune new file mode 100644 index 0000000..8af06c5 --- /dev/null +++ b/lib/naming/dune @@ -0,0 +1,3 @@ +(library + (name colitur_naming) + (libraries colitur_kernel)) diff --git a/lib/naming/lang.ml b/lib/naming/lang.ml new file mode 100644 index 0000000..0d902d5 --- /dev/null +++ b/lib/naming/lang.ml @@ -0,0 +1,96 @@ +module OI = Colitur_kernel.Overlay_ini + +module SM = Map.Make (String) + +type table = string SM.t + +type t = { + code : string; + fallback_code : string option; + celebration : table; + weekday : table; + month : table; + season : table; + rank : table; + colour : table; + term : table; + chain : t option; (** consulted when this table misses *) +} + +let empty_table = SM.empty + +let rec lookup t sel key = + match SM.find_opt key (sel t) with + | Some v -> Some v + | None -> ( match t.chain with Some b -> lookup b sel key | None -> None) + +(* A miss returns the KEY, never "". See lang.mli for why. *) +let get t sel key = match lookup t sel key with Some v -> v | None -> key + +let celebration t k = get t (fun x -> x.celebration) k +let season t k = get t (fun x -> x.season) k +let rank t k = get t (fun x -> x.rank) k +let colour t k = get t (fun x -> x.colour) k +let term t k = get t (fun x -> x.term) k + +let weekday_key = [| "sunday"; "monday"; "tuesday"; "wednesday"; "thursday"; "friday"; "saturday" |] + +(* weekday/month deliberately do NOT go through [get]: their SM key is a + presentation detail (an English day-name word for weekday, a numeral for + month), not the value a miss should degrade to. [get]'s generic + echo-the-search-key fallback would leak that word ("sunday") out of an + empty/raw table instead of the documented numeral -- [month] never showed + the bug because its key already equals [string_of_int n], but [weekday] + did, and it broke [Lang.raw]'s own identity contract (0 = Sunday, not + "sunday"). Falling back to [string_of_int n] directly keeps [month] + byte-identical and fixes [weekday]. *) +let weekday t n = + if n < 0 || n > 6 then string_of_int n + else match lookup t (fun x -> x.weekday) weekday_key.(n) with Some v -> v | None -> string_of_int n + +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 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; chain = None } + +let with_fallback t base = { t with chain = Some base } + +let of_string text = + match OI.parse_sections text with + | Error e -> Error e + | Ok sections -> + let find name = + match List.find_opt (fun (s : OI.section) -> s.OI.name = name) sections with + | Some s -> List.fold_left (fun m (k, v) -> SM.add k v m) empty_table s.OI.fields + | None -> empty_table + in + let meta = find "meta" in + (match SM.find_opt "lang" meta with + | None -> Error "language file has no [meta] lang = " + | Some code -> + Ok + { code; + fallback_code = SM.find_opt "fallback" meta; + celebration = find "celebration"; + weekday = find "weekday"; + month = find "month"; + season = find "season"; + rank = find "rank"; + colour = find "colour"; + term = find "term"; + chain = None }) + +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 ] + |> List.sort compare diff --git a/lib/naming/lang.mli b/lib/naming/lang.mli new file mode 100644 index 0000000..c4432f6 --- /dev/null +++ b/lib/naming/lang.mli @@ -0,0 +1,44 @@ +(** A language table: strings to strings, nothing more. + + Knows nothing about calendars, dates or rites, and never touches the + filesystem -- callers hand it text. That is what lets every command use it + without the kernel learning about presentation. + + Every lookup is TOTAL. A key with no entry returns THE KEY ITSELF, never the + empty string: a partial translation must be usable from its first line, and + an untranslated day must still print something a reader can act on. This is + also why the pre-naming output (bare slugs) is exactly what an empty table + produces -- the degraded case is the old behaviour, not a blank page. *) + +type t + +(** Parse INI text. Never raises. [Error] on a malformed file or a missing + [\[meta\] lang]. *) +val of_string : string -> (t, string) result + +val code : t -> string +val fallback_code : t -> string option + +(** [with_fallback t base] resolves through [t] first, then [base], then the key. *) +val with_fallback : t -> t -> t + +(** The identity table: every lookup returns its key. This is what [--raw] uses, + so raw output is one table passed around rather than a special case threaded + through every call site. *) +val raw : t + +val celebration : t -> string -> string +val season : t -> string -> string +val rank : t -> string -> string +val colour : t -> string -> string +val term : t -> string -> string + +(** [weekday t n], 0 = Sunday. Out-of-range [n] returns [string_of_int n]. *) +val weekday : t -> int -> string + +(** [month t n], 1 = January. Out-of-range [n] returns [string_of_int n]. *) +val month : 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 -- cgit v1.3 From b26089630a61a54060c86ec26be6dc4fe5418b12 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 13:38:54 +0200 Subject: feat(naming): the config file Owns precedence and provenance and nothing else, and never reads the filesystem, so it is as testable as the language table. resolve returns the value AND its source, because a setting that silently comes from a file the user forgot about is worse than no setting at all -- config --show can then say where each effective value came from. overlay accumulates rather than last-wins: a user has more than one. An unknown key is reported, never fatal. A config written for a newer colitur must still work on an older one, but silently dropping a line the user wrote is how a typo becomes invisible. --- lib/naming/config.ml | 43 +++++++++++++++++++++++++++++++++++ lib/naming/config.mli | 28 +++++++++++++++++++++++ test/test_colitur.ml | 1 + test/test_config.ml | 62 +++++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 134 insertions(+) create mode 100644 lib/naming/config.ml create mode 100644 lib/naming/config.mli create mode 100644 test/test_config.ml (limited to 'lib') diff --git a/lib/naming/config.ml b/lib/naming/config.ml new file mode 100644 index 0000000..ce1b433 --- /dev/null +++ b/lib/naming/config.ml @@ -0,0 +1,43 @@ +module OI = Colitur_kernel.Overlay_ini + +type t = { + lang : string option; + overlays : string list; + template : string option; + format : string option; + unknown_keys : string list; +} + +let empty = { lang = None; overlays = []; template = None; format = None; unknown_keys = [] } + +let lang t = t.lang +let overlays t = t.overlays +let template t = t.template +let format t = t.format +let unknown_keys t = t.unknown_keys + +let of_string text = + match OI.parse_sections text with + | Error e -> Error e + | Ok sections -> ( + match List.find_opt (fun (s : OI.section) -> s.OI.name = "defaults") sections with + | None -> Ok empty + | Some s -> + let acc = + List.fold_left + (fun acc (k, v) -> + match k with + | "lang" -> { acc with lang = Some v } + | "template" -> { acc with template = Some v } + | "format" -> { acc with format = Some v } + (* accumulates: a user has more than one overlay *) + | "overlay" -> { acc with overlays = acc.overlays @ [ v ] } + | other -> { acc with unknown_keys = acc.unknown_keys @ [ other ] }) + empty s.OI.fields + in + Ok acc) + +let resolve ~flag ~config ~default = + match flag with + | Some v -> (v, "flag") + | None -> ( match config with Some v -> (v, "config") | None -> (default, "default")) diff --git a/lib/naming/config.mli b/lib/naming/config.mli new file mode 100644 index 0000000..41ff429 --- /dev/null +++ b/lib/naming/config.mli @@ -0,0 +1,28 @@ +(** The config file: what the user wants by default, and where each value came + from. + + Owns precedence and provenance and nothing else. Never reads the filesystem + -- callers hand it text -- so it is as testable as the language table. + + A config file is OPTIONAL. With none, colitur behaves exactly as it does + without this feature, except that names resolve through the default + language. *) + +type t + +val empty : t +val of_string : string -> (t, string) result + +val lang : t -> string option +val overlays : t -> string list +val template : t -> string option +val format : t -> string option + +(** Keys present in the file that this build does not understand. Reported, never + fatal: a config written for a newer colitur must still work on an older one, + but silently ignoring a line the user wrote is how a typo becomes invisible. *) +val unknown_keys : t -> string list + +(** [resolve ~flag ~config ~default] returns [(value, source)] with source one of + ["flag"], ["config"], ["default"]. Precedence is flag > config > default. *) +val resolve : flag:string option -> config:string option -> default:string -> string * string diff --git a/test/test_colitur.ml b/test/test_colitur.ml index dd1274a..1c445a6 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -3,6 +3,7 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; Test_lang.suite; + Test_config.suite; Test_overlay.suite; Test_overlay_ini.suite; Test_temporal_ef.suite; Test_validate.suite; Test_precedence.suite; Test_calendar.suite; Test_precedence_ef.suite; Test_sanctoral_ef.suite; Test_rite_ef.suite; Test_differential.suite; Test_oracle.suite; Test_oracle.suite_2038; Test_oracle.suite_2035; Test_golden.suite; diff --git a/test/test_config.ml b/test/test_config.ml new file mode 100644 index 0000000..9100380 --- /dev/null +++ b/test/test_config.ml @@ -0,0 +1,62 @@ +module C = Colitur_naming.Config + +let ok = function Ok x -> x | Error e -> Alcotest.failf "parse: %s" e + +let sample = + "[defaults]\n\ + lang = pl\n\ + overlay = ~/a.ini\n\ + overlay = ~/b.ini\n\ + template = ~/my-ordo.tex\n\ + format = json\n" + +let test_reads_defaults () = + let c = ok (C.of_string sample) in + Alcotest.(check (option string)) "lang" (Some "pl") (C.lang c); + Alcotest.(check (option string)) "template" (Some "~/my-ordo.tex") (C.template c); + Alcotest.(check (option string)) "format" (Some "json") (C.format c) + +(* Repeated keys accumulate for overlay -- a user has more than one. The INI + reader keeps every line, so this asserts we do not silently take the last. *) +let test_overlays_accumulate () = + let c = ok (C.of_string sample) in + Alcotest.(check (list string)) "both overlays" [ "~/a.ini"; "~/b.ini" ] (C.overlays c) + +let test_empty_config_is_all_none () = + Alcotest.(check (option string)) "lang" None (C.lang C.empty); + Alcotest.(check (list string)) "overlays" [] (C.overlays C.empty) + +(* THE precedence rule: flag > config > default, and the SOURCE is reported, + because a setting that silently comes from a file the user forgot about is + worse than no setting at all. *) +let test_precedence_and_provenance () = + let check ~flag ~config ~default (ev, es) = + let v, s = C.resolve ~flag ~config ~default in + Alcotest.(check string) "value" ev v; + Alcotest.(check string) "source" es s + in + check ~flag:(Some "en") ~config:(Some "pl") ~default:"la" ("en", "flag"); + check ~flag:None ~config:(Some "pl") ~default:"la" ("pl", "config"); + check ~flag:None ~config:None ~default:"la" ("la", "default") + +let test_malformed_is_error_not_crash () = + match C.of_string "[defaults\nbroken" with + | Error _ -> () + | Ok _ -> Alcotest.fail "a malformed config must be an Error, never accepted" + +(* An unknown key is a WARNING case, not a hard error: a config written for a + newer colitur must still work on an older one. But it must be reportable, so + it is not silently dropped either. *) +let test_unknown_key_is_reported_not_fatal () = + match C.of_string "[defaults]\nlang = la\nnonsense = 1\n" with + | Error _ -> Alcotest.fail "an unknown key must not be fatal" + | Ok c -> Alcotest.(check (option string)) "known key still read" (Some "la") (C.lang c) + +let suite = + ( "Config", + [ Alcotest.test_case "reads defaults" `Quick test_reads_defaults; + Alcotest.test_case "overlays accumulate" `Quick test_overlays_accumulate; + Alcotest.test_case "empty is all none" `Quick test_empty_config_is_all_none; + Alcotest.test_case "precedence and provenance" `Quick test_precedence_and_provenance; + Alcotest.test_case "malformed is error" `Quick test_malformed_is_error_not_crash; + Alcotest.test_case "unknown key not fatal" `Quick test_unknown_key_is_reported_not_fatal ] ) -- cgit v1.3 From 6bdd5afc5e185b639f9cf5e7c3d662ddc3ecf0e1 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 13:43:28 +0200 Subject: fix(naming): merge duplicate [section] blocks in the language table F1 (review round 1): of_string's find took only the FIRST section of a given name (List.find_opt), so a second [celebration] block anywhere in the file was silently dropped in its entirety -- reproduced with two blocks (a in the first, b in the second): b resolved to the slug fallback "b", not its real value. This is a data-loss footgun aimed squarely at what happens next: Tasks 3/4 write a 595-entry, hand-edited la.ini, and appending a second [celebration] block is the natural way to paste in a new batch of names. Worse, the failure surfaces nowhere near its cause -- a coverage check reports the dropped slugs as missing a Latin name, with nothing pointing at the parser. find now folds over every section sharing the name, in file order, so all blocks merge. This also settles which value wins when the same key appears in two different blocks: later in the file wins, consistent with the existing within-one-block behaviour (unchanged, still last SM.add wins) and with what a reader expects when appending to an INI file. lang.mli now documents both duplicate policies explicitly, and notes they run OPPOSITE to Overlay_ini.get's first-match (List.assoc_opt) over the same section.fields shape -- undocumented before, and a latent trap since the two modules read the same section type but resolve a duplicate key in opposite directions. Three tests added: two [celebration] blocks both resolve (the F1 regression), a key repeated across two blocks resolves to the later block, and a key repeated within one block still resolves to the later line (confirms unchanged behaviour). Confirmed the regression test fails against the pre-fix code (b resolves to "b", the slug fallback) and passes after. --- lib/naming/lang.ml | 19 ++++++++++++++++--- lib/naming/lang.mli | 18 +++++++++++++++++- test/test_lang.ml | 34 +++++++++++++++++++++++++++++++++- 3 files changed, 66 insertions(+), 5 deletions(-) (limited to 'lib') diff --git a/lib/naming/lang.ml b/lib/naming/lang.ml index 0d902d5..147a49b 100644 --- a/lib/naming/lang.ml +++ b/lib/naming/lang.ml @@ -66,10 +66,23 @@ let of_string text = match OI.parse_sections text with | Error e -> Error e | Ok sections -> + (* Merge EVERY section sharing [name], not just the first: a hand-edited + 595-entry language file (Tasks 3/4's la.ini) WILL grow duplicate + [section] headers as contributors append entries over time -- a + second [celebration] block is the natural way to paste in a new + batch of names. Taking only the first match (the original + [List.find_opt] here) silently dropped every later block; the + failure then surfaces as a coverage report claiming those slugs have + "no Latin name", with nothing pointing back at the parser. Folding + over all matching sections, in file order, keeps this consistent + with the existing within-section behaviour below (last [SM.add] + wins): a key repeated across two blocks resolves to the later one, + exactly what a reader expects when appending to an INI file. *) let find name = - match List.find_opt (fun (s : OI.section) -> s.OI.name = name) sections with - | Some s -> List.fold_left (fun m (k, v) -> SM.add k v m) empty_table s.OI.fields - | None -> empty_table + List.fold_left + (fun m (s : OI.section) -> + if s.OI.name = name then List.fold_left (fun m (k, v) -> SM.add k v m) m s.OI.fields else m) + empty_table sections in let meta = find "meta" in (match SM.find_opt "lang" meta with diff --git a/lib/naming/lang.mli b/lib/naming/lang.mli index c4432f6..36931d4 100644 --- a/lib/naming/lang.mli +++ b/lib/naming/lang.mli @@ -13,7 +13,23 @@ type t (** Parse INI text. Never raises. [Error] on a malformed file or a missing - [\[meta\] lang]. *) + [\[meta\] lang]. + + Two duplicate policies, both LAST-WINS: + - A section name repeated in the file (e.g. two [\[celebration\]] + blocks) has ALL of its blocks merged, not only the first -- a + 595-entry hand-edited language file WILL grow duplicate section + headers as contributors append entries over time, and dropping a + later block would silently lose real translations. + - Where the same key appears more than once -- within one block or + across two of them -- the value from further down the file wins. + + Both read the same order a reader would: later in the file overrides + earlier. This is the OPPOSITE direction from + {!Colitur_kernel.Overlay_ini.get} ([List.assoc_opt], first match) over + the very same [section.fields] shape -- the two modules resolve a + duplicate key in opposite directions, so do not assume one's behaviour + from the other's. *) val of_string : string -> (t, string) result val code : t -> string diff --git a/test/test_lang.ml b/test/test_lang.ml index 0b16b30..b54e85b 100644 --- a/test/test_lang.ml +++ b/test/test_lang.ml @@ -74,6 +74,33 @@ let test_missing_meta_lang_is_error () = | Error _ -> () | Ok _ -> Alcotest.fail "a language file with no [meta] lang must be an Error" +(* F1 regression: a hand-edited language file WILL grow duplicate [section] + headers as contributors append entries over time (Tasks 3/4's 595-entry + la.ini). Both blocks' keys must resolve -- silently dropping the second + block is a data-loss footgun that surfaces as a false "missing name" + report far from its real cause. *) +let test_duplicate_sections_all_merge () = + let t = + ok + (L.of_string + "[meta]\nlang = la\n[celebration]\na = ALPHA\n[weekday]\nsunday = Dominica\n\ + [celebration]\nb = BETA\n") + in + Alcotest.(check string) "first block's key" "ALPHA" (L.celebration t "a"); + Alcotest.(check string) "second block's key" "BETA" (L.celebration t "b") + +let test_duplicate_key_across_sections_last_wins () = + let t = + ok + (L.of_string + "[meta]\nlang = la\n[celebration]\na = FIRST\n[celebration]\na = SECOND\n") + in + Alcotest.(check string) "later block's value wins" "SECOND" (L.celebration t "a") + +let test_duplicate_key_within_section_last_wins () = + let t = ok (L.of_string "[meta]\nlang = la\n[celebration]\na = FIRST\na = SECOND\n") in + Alcotest.(check string) "later line's value wins" "SECOND" (L.celebration t "a") + let suite = ( "Lang", [ Alcotest.test_case "meta" `Quick test_meta; @@ -82,4 +109,9 @@ let suite = Alcotest.test_case "fallback chain" `Quick test_fallback_chain; Alcotest.test_case "raw is identity" `Quick test_raw_is_identity; Alcotest.test_case "malformed is error" `Quick test_malformed_is_error_not_crash; - Alcotest.test_case "missing meta lang is error" `Quick test_missing_meta_lang_is_error ] ) + Alcotest.test_case "missing meta lang is error" `Quick test_missing_meta_lang_is_error; + Alcotest.test_case "duplicate sections all merge" `Quick test_duplicate_sections_all_merge; + Alcotest.test_case "duplicate key across sections: last wins" `Quick + test_duplicate_key_across_sections_last_wins; + Alcotest.test_case "duplicate key within section: last wins" `Quick + test_duplicate_key_within_section_last_wins ] ) -- cgit v1.3 From 59fbd3718dbf2721557b97d7b4e87dce38fb745c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 13:48:39 +0200 Subject: fix(naming): config fix round 1 -- unknown sections, O(n) accumulate F1: test_unknown_key_is_reported_not_fatal never asserted unknown_keys itself, only that parsing survives -- a no-op accumulator passed it. Now asserts the key is actually collected. F2: a misspelled section name, e.g. [deafults], was silently discarded -- Ok empty, lang and everything else gone, nothing reported. That is the highest-value typo this feature exists to catch. Any section other than [defaults] is now collected into a new Config.unknown_sections, kept separate from unknown_keys so the CLI can word the two warnings differently. Still non-fatal: a newer colitur's added section must not break an older binary. F3: overlays and unknown_keys accumulated with '@ [v]' per line, O(n^2) over the field count. Cons during the fold, List.rev once at the end. F4: documented that lang/template/format are last-wins on a repeated key, the opposite direction from Overlay_ini.get's first-wins over the same section type. --- lib/naming/config.ml | 55 ++++++++++++++++++++++++++++++++++----------------- lib/naming/config.mli | 22 ++++++++++++++++++--- test/test_config.ml | 22 ++++++++++++++++++--- 3 files changed, 75 insertions(+), 24 deletions(-) (limited to 'lib') diff --git a/lib/naming/config.ml b/lib/naming/config.ml index ce1b433..0fafd1f 100644 --- a/lib/naming/config.ml +++ b/lib/naming/config.ml @@ -6,36 +6,55 @@ type t = { template : string option; format : string option; unknown_keys : string list; + unknown_sections : string list; } -let empty = { lang = None; overlays = []; template = None; format = None; unknown_keys = [] } +let empty = + { lang = None; overlays = []; template = None; format = None; unknown_keys = []; + unknown_sections = [] } let lang t = t.lang let overlays t = t.overlays let template t = t.template let format t = t.format let unknown_keys t = t.unknown_keys +let unknown_sections t = t.unknown_sections let of_string text = match OI.parse_sections text with | Error e -> Error e - | Ok sections -> ( - match List.find_opt (fun (s : OI.section) -> s.OI.name = "defaults") sections with - | None -> Ok empty - | Some s -> - let acc = - List.fold_left - (fun acc (k, v) -> - match k with - | "lang" -> { acc with lang = Some v } - | "template" -> { acc with template = Some v } - | "format" -> { acc with format = Some v } - (* accumulates: a user has more than one overlay *) - | "overlay" -> { acc with overlays = acc.overlays @ [ v ] } - | other -> { acc with unknown_keys = acc.unknown_keys @ [ other ] }) - empty s.OI.fields - in - Ok acc) + | Ok sections -> + (* Any section that is not [defaults] is unrecognised -- including a + plain typo such as [deafults] -- and must be REPORTED, never + silently dropped: that is precisely the failure this feature exists + to surface. *) + let unknown_sections = + List.filter_map + (fun (s : OI.section) -> if s.OI.name = "defaults" then None else Some s.OI.name) + sections + in + let acc = + match List.find_opt (fun (s : OI.section) -> s.OI.name = "defaults") sections with + | None -> empty + | Some s -> + (* Cons then reverse once at the end, not `@ [v]` per line: the + latter is O(n^2) over the field count, a real hang on a + machine-generated file with many overlay lines. *) + let acc = + List.fold_left + (fun acc (k, v) -> + match k with + | "lang" -> { acc with lang = Some v } + | "template" -> { acc with template = Some v } + | "format" -> { acc with format = Some v } + (* accumulates: a user has more than one overlay *) + | "overlay" -> { acc with overlays = v :: acc.overlays } + | other -> { acc with unknown_keys = other :: acc.unknown_keys }) + empty s.OI.fields + in + { acc with overlays = List.rev acc.overlays; unknown_keys = List.rev acc.unknown_keys } + in + Ok { acc with unknown_sections } let resolve ~flag ~config ~default = match flag with diff --git a/lib/naming/config.mli b/lib/naming/config.mli index 41ff429..27f0c44 100644 --- a/lib/naming/config.mli +++ b/lib/naming/config.mli @@ -13,16 +13,32 @@ type t val empty : t val of_string : string -> (t, string) result +(** [lang], [template] and [format] are each set from a single field. A + repeated key is LAST-WINS -- the opposite direction from + {!Colitur_kernel.Overlay_ini.get}'s first-wins over the same [section] + type -- because the natural reading of a config file a user edited by + hand and appended to is "the bottom line is the one that took effect". *) val lang : t -> string option + val overlays : t -> string list val template : t -> string option val format : t -> string option -(** Keys present in the file that this build does not understand. Reported, never - fatal: a config written for a newer colitur must still work on an older one, - but silently ignoring a line the user wrote is how a typo becomes invisible. *) +(** Keys present in the [\[defaults\]] section that this build does not + understand. Reported, never fatal: a config written for a newer colitur + must still work on an older one, but silently ignoring a line the user + wrote is how a typo becomes invisible. *) val unknown_keys : t -> string list +(** Section names other than [\[defaults\]], reported separately from + {!unknown_keys} so the CLI can word the two warnings differently (a + misspelled section, e.g. [\[deafults\]], versus a misspelled key inside a + recognised one). Also never fatal, and never silent: a section this build + does not recognise is exactly the highest-value typo this feature exists + to catch, because it silently discards the whole section -- [lang] and + everything else in it -- with no other way for the user to notice. *) +val unknown_sections : t -> string list + (** [resolve ~flag ~config ~default] returns [(value, source)] with source one of ["flag"], ["config"], ["default"]. Precedence is flag > config > default. *) val resolve : flag:string option -> config:string option -> default:string -> string * string diff --git a/test/test_config.ml b/test/test_config.ml index 9100380..067b255 100644 --- a/test/test_config.ml +++ b/test/test_config.ml @@ -46,11 +46,25 @@ let test_malformed_is_error_not_crash () = (* An unknown key is a WARNING case, not a hard error: a config written for a newer colitur must still work on an older one. But it must be reportable, so - it is not silently dropped either. *) + it is not silently dropped either -- assert it is actually COLLECTED, not + only that parsing survives it: a no-op accumulator would also pass a test + that checked survival alone. *) let test_unknown_key_is_reported_not_fatal () = match C.of_string "[defaults]\nlang = la\nnonsense = 1\n" with | Error _ -> Alcotest.fail "an unknown key must not be fatal" - | Ok c -> Alcotest.(check (option string)) "known key still read" (Some "la") (C.lang c) + | Ok c -> + Alcotest.(check (option string)) "known key still read" (Some "la") (C.lang c); + Alcotest.(check (list string)) "unknown key reported" [ "nonsense" ] (C.unknown_keys c) + +(* The highest-value case: a misspelled SECTION name (not merely a misspelled + key inside a recognised one). Before this fix the whole section, lang + included, vanished with nothing reported -- exactly the typo this feature + exists to surface, in its worst form: a user whose config silently does + nothing has no way to discover why. *) +let test_misspelled_section_is_reported_not_silently_dropped () = + let c = ok (C.of_string "[deafults]\nlang = pl\n") in + Alcotest.(check (option string)) "lang not read from the wrong section" None (C.lang c); + Alcotest.(check (list string)) "section reported" [ "deafults" ] (C.unknown_sections c) let suite = ( "Config", @@ -59,4 +73,6 @@ let suite = Alcotest.test_case "empty is all none" `Quick test_empty_config_is_all_none; Alcotest.test_case "precedence and provenance" `Quick test_precedence_and_provenance; Alcotest.test_case "malformed is error" `Quick test_malformed_is_error_not_crash; - Alcotest.test_case "unknown key not fatal" `Quick test_unknown_key_is_reported_not_fatal ] ) + Alcotest.test_case "unknown key not fatal" `Quick test_unknown_key_is_reported_not_fatal; + Alcotest.test_case "misspelled section reported" + `Quick test_misspelled_section_is_reported_not_silently_dropped ] ) -- cgit v1.3 From d869a4410a88333d328358c723609577d32f3380 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 14:09:09 +0200 Subject: fix(naming): config.ml merges every [defaults] block, like lang.ml config.ml and lang.ml both parse the INI format through the same reader, Colitur_kernel.Overlay_ini.parse_sections, but resolved a repeated [section] header oppositely: lang.ml folds over every section sharing a name, while config.ml used List.find_opt and silently discarded every [defaults] block after the first. Two modules parsing one file format must not disagree about what a duplicate section header means. of_string now folds a single accumulator across every section named [defaults], in file order, matching lang.ml's of_string shape. A scalar key (lang/template/format) repeated across two blocks resolves to the later value, consistent with the existing within-section last-wins rule; overlay keeps accumulating across every block, not only the first; and unknown_sections still excludes every [defaults] block, merged or not, since merging it is the point. config.mli's lang doc comment is extended to say the last-wins rule holds across block boundaries too, cross-referencing lang.ml's own duplicate-section policy so the two do not drift again unnoticed. --- lib/naming/config.ml | 56 ++++++++++++++++++++++++++++++++++----------------- lib/naming/config.mli | 7 ++++++- test/test_config.ml | 46 +++++++++++++++++++++++++++++++++++++++++- 3 files changed, 88 insertions(+), 21 deletions(-) (limited to 'lib') diff --git a/lib/naming/config.ml b/lib/naming/config.ml index 0fafd1f..7d87d62 100644 --- a/lib/naming/config.ml +++ b/lib/naming/config.ml @@ -33,27 +33,45 @@ let of_string text = (fun (s : OI.section) -> if s.OI.name = "defaults" then None else Some s.OI.name) sections in + (* Merge EVERY section named [defaults], not just the first: [lang.ml]'s + [of_string] was fixed this morning to fold over all matching + sections rather than take [List.find_opt]'s first match, because a + hand-edited file WILL grow duplicate headers as a user appends to it + over time. Both modules parse the same reader + ([Overlay_ini.parse_sections]) over the same file format, so they + must not disagree about what a duplicate [section] header means -- + taking only the first [defaults] block here silently discarded every + later one, with nothing pointing back at the parser. Folding a + single accumulator across every matching section, in file order, + keeps this consistent with the within-section behaviour below (last + [k]-match wins): a scalar key repeated across two blocks resolves to + the LATER value, and [overlay] keeps accumulating across every + block, not only its first. *) + let defaults_sections = + List.filter (fun (s : OI.section) -> s.OI.name = "defaults") sections + in let acc = - match List.find_opt (fun (s : OI.section) -> s.OI.name = "defaults") sections with - | None -> empty - | Some s -> - (* Cons then reverse once at the end, not `@ [v]` per line: the - latter is O(n^2) over the field count, a real hang on a - machine-generated file with many overlay lines. *) - let acc = - List.fold_left - (fun acc (k, v) -> - match k with - | "lang" -> { acc with lang = Some v } - | "template" -> { acc with template = Some v } - | "format" -> { acc with format = Some v } - (* accumulates: a user has more than one overlay *) - | "overlay" -> { acc with overlays = v :: acc.overlays } - | other -> { acc with unknown_keys = other :: acc.unknown_keys }) - empty s.OI.fields - in - { acc with overlays = List.rev acc.overlays; unknown_keys = List.rev acc.unknown_keys } + (* Cons then reverse once at the very end, not `@ [v]` per line: the + latter is O(n^2) over the field count, a real hang on a + machine-generated file with many overlay lines. Reversing only + after every section has been folded (not once per section) is + what keeps [overlay] and [unknown_keys] in file order across + block boundaries, not merely within one block. *) + List.fold_left + (fun acc (s : OI.section) -> + List.fold_left + (fun acc (k, v) -> + match k with + | "lang" -> { acc with lang = Some v } + | "template" -> { acc with template = Some v } + | "format" -> { acc with format = Some v } + (* accumulates: a user has more than one overlay *) + | "overlay" -> { acc with overlays = v :: acc.overlays } + | other -> { acc with unknown_keys = other :: acc.unknown_keys }) + acc s.OI.fields) + empty defaults_sections in + let acc = { acc with overlays = List.rev acc.overlays; unknown_keys = List.rev acc.unknown_keys } in Ok { acc with unknown_sections } let resolve ~flag ~config ~default = diff --git a/lib/naming/config.mli b/lib/naming/config.mli index 27f0c44..a84f95b 100644 --- a/lib/naming/config.mli +++ b/lib/naming/config.mli @@ -17,7 +17,12 @@ val of_string : string -> (t, string) result repeated key is LAST-WINS -- the opposite direction from {!Colitur_kernel.Overlay_ini.get}'s first-wins over the same [section] type -- because the natural reading of a config file a user edited by - hand and appended to is "the bottom line is the one that took effect". *) + hand and appended to is "the bottom line is the one that took effect". + This holds whether the repeat is within one [\[defaults\]] block or + across two of them: every section named [defaults] is merged, not only + the first, the same duplicate-section policy {!Lang.of_string} documents + for its own sections -- the two modules read the same underlying format + and must not disagree about what a repeated header means. *) val lang : t -> string option val overlays : t -> string list diff --git a/test/test_config.ml b/test/test_config.ml index 067b255..83da015 100644 --- a/test/test_config.ml +++ b/test/test_config.ml @@ -66,6 +66,42 @@ let test_misspelled_section_is_reported_not_silently_dropped () = Alcotest.(check (option string)) "lang not read from the wrong section" None (C.lang c); Alcotest.(check (list string)) "section reported" [ "deafults" ] (C.unknown_sections c) +(* THE regression test for the cross-module inconsistency: [config.ml] used + to locate [\[defaults\]] with [List.find_opt], taking only the FIRST + matching section and silently discarding every later one, while + [lang.ml]'s [of_string] folds over ALL matching sections. A scalar set in + the first block and a DIFFERENT scalar set only in the second block must + both resolve -- before the fix, [template] (second-block-only) came back + [None]. *) +let test_two_defaults_blocks_both_contribute () = + let text = "[defaults]\nlang = pl\n\n[defaults]\ntemplate = ~/my-ordo.tex\n" in + let c = ok (C.of_string text) in + Alcotest.(check (option string)) "lang from first block" (Some "pl") (C.lang c); + Alcotest.(check (option string)) "template from second block" (Some "~/my-ordo.tex") (C.template c) + +(* Consistent with the existing within-section last-wins rule (see + [config.mli]'s [lang] comment): a key repeated ACROSS two [\[defaults\]] + blocks resolves to the value from the LATER block, exactly as it would if + both lines sat in one block. *) +let test_key_repeated_across_blocks_last_wins () = + let text = "[defaults]\nlang = pl\n\n[defaults]\nlang = en\n" in + let c = ok (C.of_string text) in + Alcotest.(check (option string)) "later block's lang wins" (Some "en") (C.lang c) + +(* [overlay] must keep accumulating across block boundaries, in file order, + not merely within one block. *) +let test_overlays_accumulate_across_blocks () = + let text = "[defaults]\noverlay = ~/a.ini\n\n[defaults]\noverlay = ~/b.ini\n" in + let c = ok (C.of_string text) in + Alcotest.(check (list string)) "both overlays, in file order" [ "~/a.ini"; "~/b.ini" ] (C.overlays c) + +(* Merging a second [\[defaults\]] block is the whole point -- it must not + start being reported as an unknown section. *) +let test_two_defaults_blocks_report_no_unknown_sections () = + let text = "[defaults]\nlang = pl\n\n[defaults]\ntemplate = ~/my-ordo.tex\n" in + let c = ok (C.of_string text) in + Alcotest.(check (list string)) "no unknown sections" [] (C.unknown_sections c) + let suite = ( "Config", [ Alcotest.test_case "reads defaults" `Quick test_reads_defaults; @@ -75,4 +111,12 @@ let suite = Alcotest.test_case "malformed is error" `Quick test_malformed_is_error_not_crash; Alcotest.test_case "unknown key not fatal" `Quick test_unknown_key_is_reported_not_fatal; Alcotest.test_case "misspelled section reported" - `Quick test_misspelled_section_is_reported_not_silently_dropped ] ) + `Quick test_misspelled_section_is_reported_not_silently_dropped; + Alcotest.test_case "two defaults blocks both contribute" + `Quick test_two_defaults_blocks_both_contribute; + Alcotest.test_case "key repeated across blocks last wins" + `Quick test_key_repeated_across_blocks_last_wins; + Alcotest.test_case "overlays accumulate across blocks" + `Quick test_overlays_accumulate_across_blocks; + Alcotest.test_case "two defaults blocks report no unknown sections" + `Quick test_two_defaults_blocks_report_no_unknown_sections ] ) -- cgit v1.3 From 6d367ab8e90f6e713d262a7f19fb908b28d4796a Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Wed, 19 Aug 2026 15:29:33 +0200 Subject: feat(render): names reach the view and every emitter The view's name is now the RESOLVED display string and slug is untouched, so machine formats carry both -- a script keeps the stable key, a human reads the name. name is a plain string, not a lang-keyed object. That removes the shadowing hazard outright: a dotted {{name.la}} used to fall back WHOLESALE to the enclosing month's name.la and print Ianuarius on every unnamed day, which is how a printed booklet came to show the month where the feast belonged. weekday, season, rank and colour all gain localised companions, because a calendar in a language needs more than feast names, and templates gain a term vocabulary so fixed strings need no template edit to translate. Asserted over a whole year: no day renders its slug as its name. Beyond the brief's own code sample: - comm_value's own name is now resolved through the same lang.celebration table too (not only the observed day's), because Task 8's own ordo template interpolates a plain {{name}} inside {{#comms}} -- an Obj there would render silently blank. A commemoration slug without Latin coverage still degrades to the slug, same as everywhere else in this system; that is a lang/la.ini DATA gap (113 of 327 sanctoral slugs, measured), not a regression this task introduced. - bin/main.ml's emit/table/publish call sites needed ~lang to compile at all, which is collateral from the of_days signature change, not this task's own file list. Rather than pass Lang.raw and ship the very slug-as-name defect this branch exists to fix, they load the shipped Latin table by the same probe order data_dir() already uses -- a deliberate, commented BRIDGE that Task 6 replaces wholesale with real --lang/--raw/config resolution. bin/dune gained colitur_naming accordingly. - test/cli.t needed two related fixes to stay green: the CSV header/row example, and a table/LaTeX escaping demonstration that relied on the kernel's own English name for Sts Peter & Paul -- gone from the view now that name resolves through lang tables only, and the Missal's own Latin spells the feast with et, never an ampersand. Escaping itself is still proved live on 2035 data in test_emit.ml. - Both schemas gained the new day/week/top-level keys (season_name, weekday, rank_name, colour_name, term, weekday_headings, month_num, month_name), not only the name shape change; schema/colitur-v1.xsd verified against real emitted XML via xmllint (make check-schema). Render/golden's 9 cases (the shipped ordo/grid templates, all six flavours) now fail as expected: their old {{name.la}} / {{#name}}... idiom finds nothing on a plain string. That is Tasks 8/9's own scope to rewrite, per the plan's own pre-flight conflict scan -- not fixed here, and not silently pinned by regenerating goldens off broken output. 495 tests run (490 + 5 new), 486 pass; the 9 failures are exactly Render/golden's ordo/grid cases. --- bin/dune | 2 +- bin/main.ml | 43 ++++++++++++++++-- lib/render/dune | 2 +- lib/render/emit_csv.ml | 16 ++++--- lib/render/emit_ics.ml | 12 ++--- lib/render/emit_xml.ml | 17 ++++--- lib/render/view.ml | 121 ++++++++++++++++++++++++++++++++++--------------- lib/render/view.mli | 18 +++++++- schema/colitur-v1.xsd | 17 ++++--- schema/day-v1.json | 58 ++++++++++++++++-------- test/cli.t | 25 ++++++---- test/test_emit.ml | 6 +-- test/test_view.ml | 92 ++++++++++++++++++++++++++++++++++++- 13 files changed, 321 insertions(+), 108 deletions(-) (limited to 'lib') diff --git a/bin/dune b/bin/dune index 856dafe..28c04d7 100644 --- a/bin/dune +++ b/bin/dune @@ -6,4 +6,4 @@ ; colitur.opam's frozen depends, only a new library this executable links ; against. Used by Task 12's [mkdir_p] (colitur publish, recursive ; directory creation) and nowhere else. - (libraries colitur_kernel rite_ef colitur_render unix)) + (libraries colitur_kernel rite_ef colitur_render colitur_naming unix)) diff --git a/bin/main.ml b/bin/main.ml index 6f64582..b2eef28 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -131,6 +131,41 @@ let data_dir () = end | _ -> if has_data installed then installed else build_tree +(* TEMPORARY BRIDGE (naming-and-config Task 5): [View.of_days] now takes + [~lang], but real CLI flag/config resolution (--lang, --raw, + Colitur_naming.Config) is Task 6's own scope, not this one's. Rather than + leave `emit`/`table`/`publish` showing bare slugs as their "resolved + name" -- which is precisely the defect this whole branch exists to fix -- + this loads the shipped Latin table by default, using EXACTLY the probe + order [data_dir] above already uses (installed prefix, then the build + tree), so an installed binary finds its language file the same way it + finds its calendar data. Task 6 replaces this wholesale with + `--lang`/`--raw`/config resolution and per-command defaults; nothing + here is meant to survive that task unchanged. A missing or malformed + language file degrades to [Lang.raw] (name = slug) rather than crashing + the CLI -- Task 6 is what makes that case a proper, reported error. *) +let lang_dir () = + let prefix = Filename.dirname (Filename.dirname Sys.executable_name) in + let installed = List.fold_left Filename.concat prefix [ "share"; "colitur"; "lang" ] in + if Sys.file_exists (Filename.concat installed "la.ini") then installed + else Filename.concat prefix "lang" + +let default_lang = + lazy + (let path = Filename.concat (lang_dir ()) "la.ini" in + match open_in_bin path with + | exception Sys_error _ -> Colitur_naming.Lang.raw + | ic -> ( + match + Fun.protect ~finally:(fun () -> close_in_noerr ic) (fun () -> + really_input_string ic (in_channel_length ic)) + with + | exception Sys_error _ -> Colitur_naming.Lang.raw + | text -> ( + match Colitur_naming.Lang.of_string text with + | Ok t -> t + | Error _ -> Colitur_naming.Lang.raw))) + (* Loads the universal sanctoral layer and applies the one hand-authored overlay over it (data/ef/adjustments.sexp -- see that file's own header): [Overlay.apply]'s diagnostics are never silently dropped (Overlay.mli), @@ -428,7 +463,7 @@ let emit_report ~format ~overlays ~dtstamp ~from_y ~to_y = for y = from_y to to_y do let days = resolved_year_days ~overlays y in let v = - Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days + Colitur_render.View.of_days ~lang:(Lazy.force default_lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in match format with | "csv" -> @@ -538,7 +573,7 @@ let table_report ~template ~flavour_opt ~overlays y = exit 2 | Ok src -> ( let days = resolved_year_days ~overlays y in - let v = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in + let v = Colitur_render.View.of_days ~lang:(Lazy.force default_lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in match Colitur_render.Template.render_string ~flavour src v with | Error e -> (* The template is user input; a parse failure is reported with the @@ -757,7 +792,7 @@ let publish_report ~from_y ~to_y ~out ~overlays ~dtstamp ~prune = in for y = from_y to to_y do let days = resolved_year_days ~overlays y in - let v = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in + let v = Colitur_render.View.of_days ~lang:(Lazy.force default_lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in let ys = string_of_int y in emit ("ef/" ^ ys ^ ".json") (Colitur_render.Emit_json.year v); emit ("ef/" ^ ys ^ ".csv") (Colitur_render.Emit_csv.year v); @@ -770,7 +805,7 @@ let publish_report ~from_y ~to_y ~out ~overlays ~dtstamp ~prune = (fun d -> let iso = D.to_iso8601 d.Colitur_kernel.Liturgical_day.date in let mm = String.sub iso 5 2 and dd = String.sub iso 8 2 in - let one = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y [ d ] in + let one = Colitur_render.View.of_days ~lang:(Lazy.force default_lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y [ d ] in emit (Printf.sprintf "ef/%s/%s/%s.json" ys mm dd) (Colitur_render.Emit_json.year one)) days done; diff --git a/lib/render/dune b/lib/render/dune index 7880188..548cf43 100644 --- a/lib/render/dune +++ b/lib/render/dune @@ -1,5 +1,5 @@ (library (name colitur_render) - (libraries colitur_kernel sexplib) + (libraries colitur_kernel colitur_naming sexplib) (preprocess (pps ppx_sexp_conv))) diff --git a/lib/render/emit_csv.ml b/lib/render/emit_csv.ml index b478265..415a684 100644 --- a/lib/render/emit_csv.ml +++ b/lib/render/emit_csv.ml @@ -16,11 +16,15 @@ let escape_field s = let get v k = match v with T.Obj kvs -> List.assoc_opt k kvs | _ -> None let s v k = match get v k with Some (T.Str x) -> x | _ -> "" -let nested v a b = match get v a with Some inner -> s inner b | None -> "" +(* [name] is now the single RESOLVED display string (view.ml), not a + lang-keyed object -- the [name_la]/[name_en] pair this replaces carried + the kernel's own [Celebration.names], a different, unlocalised source. + Machine formats still carry [slug] alongside it, so a script keeps the + stable key and a human reads the name. *) let columns = - [ "date"; "rite"; "season"; "week"; "slug"; "rank"; "colour"; "subject"; - "name_la"; "name_en"; "first"; "gospel"; "comms" ] + [ "date"; "rite"; "season"; "season_name"; "week"; "slug"; "name"; "weekday"; + "rank"; "rank_name"; "colour"; "colour_name"; "subject"; "first"; "gospel"; "comms" ] let row ~rite d = let comms = @@ -30,9 +34,9 @@ let row ~rite d = in String.concat "," (List.map escape_field - [ s d "iso"; rite; s d "season"; s d "week"; s d "slug"; s d "rank"; - s d "colour"; s d "subject"; nested d "name" "la"; nested d "name" "en"; - s d "first"; s d "gospel"; comms ]) + [ s d "iso"; rite; s d "season"; s d "season_name"; s d "week"; s d "slug"; + s d "name"; s d "weekday"; s d "rank"; s d "rank_name"; s d "colour"; + s d "colour_name"; s d "subject"; s d "first"; s d "gospel"; comms ]) let year v = let rite = s v "rite" in diff --git a/lib/render/emit_ics.ml b/lib/render/emit_ics.ml index 41efb95..4e06eae 100644 --- a/lib/render/emit_ics.ml +++ b/lib/render/emit_ics.ml @@ -55,14 +55,10 @@ let line b l = Buffer.add_string b (Escape.fold_ics l) let event b ~rite ~dtstamp d = let iso = s d "iso" in if iso <> "" then begin - let name = - match get d "name" with - | Some (T.Obj kvs) -> ( - match List.assoc_opt "en" kvs with - | Some (T.Str x) when x <> "" -> x - | _ -> ( match List.assoc_opt "la" kvs with Some (T.Str x) -> x | _ -> s d "slug")) - | _ -> s d "slug" - in + (* [name] is the view's own resolved display string (view.ml) -- no + further fallback needed here: under [Lang.raw] it already equals + [slug], which is what a miss used to require picking by hand. *) + let name = s d "name" in let summary = Printf.sprintf "%s (%s, %s)" name (s d "rank") (s d "colour") in let desc = String.concat "\n" diff --git a/lib/render/emit_xml.ml b/lib/render/emit_xml.ml index 4e4b51a..3f1ca32 100644 --- a/lib/render/emit_xml.ml +++ b/lib/render/emit_xml.ml @@ -11,20 +11,19 @@ let el b name value = let day b d = Buffer.add_string b (" \n"); el b "season" (s d "season"); + el b "season_name" (s d "season_name"); el b "week" (s d "week"); el b "slug" (s d "slug"); + (* The resolved display name. A single element, no [lang] attribute: the + view's own [name] is now one resolved string, not a lang-keyed object + (view.ml), so there is exactly one to emit rather than one per language. *) + el b "name" (s d "name"); + el b "weekday" (s d "weekday"); el b "rank" (s d "rank"); + el b "rank_name" (s d "rank_name"); el b "colour" (s d "colour"); + el b "colour_name" (s d "colour_name"); el b "subject" (s d "subject"); - (match get d "name" with - | Some (T.Obj kvs) -> - List.iter - (fun (lang, v) -> - match v with - | T.Str x -> Buffer.add_string b (" " ^ escape x ^ "\n") - | _ -> ()) - kvs - | _ -> ()); (match get d "comms" with | Some (T.List l) -> List.iter (fun c -> Buffer.add_string b (" " ^ escape (s c "slug") ^ "\n")) l 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)) ] diff --git a/lib/render/view.mli b/lib/render/view.mli index fb48590..81bfc26 100644 --- a/lib/render/view.mli +++ b/lib/render/view.mli @@ -15,10 +15,24 @@ different colour expression. Exactly one of the six is true on every day. *) val of_days : + lang:Colitur_naming.Lang.t -> 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. *) +(** [of_days ~lang ~vocab ~rite ~year days] where [days] is one civil year, + 1 January to 31 December, in order. Pure and total. + + [lang] resolves every display string -- a day's [name], its localised + [weekday]/[rank_name]/[colour_name]/[season_name], each month's [name], + and the top-level [term] vocabulary and [weekday_headings]. [name] is a + PLAIN STRING, not the old lang-keyed object: a dotted [{{name.la}}] + reference that misses falls back WHOLESALE to the enclosing scope (a + month's own [name.la]), which is how a printed booklet came to show + "Ianuarius" in place of a feast with no Latin name. A plain string has no + dotted path to fall back through, so that hazard is unrepresentable. + [slug] is untouched by [lang] -- it stays the stable machine key, + identical between any two calls that differ only in [lang]. Pass + {!Colitur_naming.Lang.raw} for the pre-naming behaviour, under which + [name] equals [slug] exactly (this is what CLI [--raw] uses). *) diff --git a/schema/colitur-v1.xsd b/schema/colitur-v1.xsd index 46af9a9..df11c3d 100644 --- a/schema/colitur-v1.xsd +++ b/schema/colitur-v1.xsd @@ -10,20 +10,19 @@ + + + + + + - - - - - - - - - diff --git a/schema/day-v1.json b/schema/day-v1.json index b48133a..5a7537c 100644 --- a/schema/day-v1.json +++ b/schema/day-v1.json @@ -3,10 +3,21 @@ "$id": "https://colitur/schema/day-v1.json", "title": "colitur liturgical year, v1", "type": "object", - "required": ["rite", "year", "months", "days"], + "required": ["rite", "year", "term", "weekday_headings", "months", "days"], "properties": { "rite": { "type": "string" }, "year": { "type": "string", "pattern": "^[0-9]{4}$" }, + "term": { "type": "object", "additionalProperties": { "type": "string" }, "description": "fixed vocabulary (ordo, contents, epistle, lesson, gospel, commemoration, week) in the active language" }, + "weekday_headings": { + "type": "array", + "minItems": 7, + "maxItems": 7, + "items": { + "type": "object", + "required": ["name", "last"], + "properties": { "name": { "type": "string" }, "last": { "type": "boolean" } } + } + }, "months": { "type": "array", "items": { "$ref": "#/$defs/month" } }, "days": { "type": "array", "items": { "$ref": "#/$defs/day" } } }, @@ -16,36 +27,43 @@ "required": ["num", "name", "days", "weeks"], "properties": { "num": { "type": "string" }, - "name": { "type": "object", "additionalProperties": { "type": "string" } }, + "name": { "type": "string", "description": "the resolved display name, e.g. \"Ianuarius\"" }, "days": { "type": "array", "items": { "$ref": "#/$defs/day" } }, "weeks": { "type": "array", "items": { "$ref": "#/$defs/week" } } } }, "week": { "type": "object", - "required": ["num", "days"], + "required": ["num", "month_num", "month_name", "days"], "properties": { - "num": { "type": "string" }, - "days": { "type": "array", "minItems": 7, "maxItems": 7, "items": { "$ref": "#/$defs/day" } } + "num": { "type": "string" }, + "month_num": { "type": "string", "description": "the enclosing month's num, carried here because the engine has no parent-path syntax" }, + "month_name": { "type": "string", "description": "the enclosing month's resolved name, same reason" }, + "days": { "type": "array", "minItems": 7, "maxItems": 7, "items": { "$ref": "#/$defs/day" } } } }, "day": { "type": "object", - "required": ["iso", "dom", "dow", "in_month", "season", "week", "slug", - "name", "rank", "colour", "is_white", "is_red", "is_green", - "is_violet", "is_rose", "is_black", "subject", "comms", - "transferred_in", "transferred_out", "first", "gospel", "last"], + "required": ["iso", "dom", "dow", "in_month", "season", "season_name", "week", + "slug", "name", "weekday", "rank", "rank_name", "colour", "colour_name", + "is_white", "is_red", "is_green", "is_violet", "is_rose", "is_black", + "subject", "comms", "transferred_in", "transferred_out", "first", + "gospel", "last"], "properties": { - "iso": { "type": "string", "description": "empty on a grid padding cell" }, - "dom": { "type": "string" }, - "dow": { "type": "string", "description": "0 = Sunday" }, - "in_month": { "type": "boolean", "description": "false = grid padding cell" }, - "season": { "type": "string" }, - "week": { "type": "string", "description": "empty when the rite numbers no week here" }, - "slug": { "type": "string" }, - "name": { "type": "object", "additionalProperties": { "type": "string" } }, - "rank": { "type": "string" }, - "colour": { "type": "string", "enum": ["white","red","green","violet","rose","black",""] }, + "iso": { "type": "string", "description": "empty on a grid padding cell" }, + "dom": { "type": "string" }, + "dow": { "type": "string", "description": "0 = Sunday" }, + "in_month": { "type": "boolean", "description": "false = grid padding cell" }, + "season": { "type": "string" }, + "season_name": { "type": "string", "description": "the resolved season name in the active language" }, + "week": { "type": "string", "description": "empty when the rite numbers no week here" }, + "slug": { "type": "string", "description": "the stable machine key -- unaffected by the active language" }, + "name": { "type": "string", "description": "the resolved display name; under --raw this equals slug" }, + "weekday": { "type": "string", "description": "the resolved weekday name in the active language" }, + "rank": { "type": "string" }, + "rank_name": { "type": "string", "description": "the resolved rank name in the active language" }, + "colour": { "type": "string", "enum": ["white","red","green","violet","rose","black",""] }, + "colour_name": { "type": "string", "description": "the resolved colour name in the active language" }, "is_white": { "type": "boolean" }, "is_red": { "type": "boolean" }, "is_green": { "type": "boolean" }, "is_violet":{ "type": "boolean" }, "is_rose": { "type": "boolean" }, "is_black": { "type": "boolean" }, @@ -57,7 +75,7 @@ "required": ["slug", "name", "privileged"], "properties": { "slug": { "type": "string" }, - "name": { "type": "object", "additionalProperties": { "type": "string" } }, + "name": { "type": "string", "description": "the resolved display name, same table as the day's own name" }, "privileged": { "type": "boolean" } } } diff --git a/test/cli.t b/test/cli.t index 80c8078..dfe5caa 100644 --- a/test/cli.t +++ b/test/cli.t @@ -419,8 +419,8 @@ displaced silently. CSV emits a header and one row per day: $ colitur emit --format csv --from 2027 --to 2027 | head -2 - date,rite,season,week,slug,rank,colour,subject,name_la,name_en,first,gospel,comms - 2027-01-01,ef,christmastide,,ef-circumcision,class-1,white,temporal,,,Titus 2:11-15,Luke 2:21, + date,rite,season,season_name,week,slug,name,weekday,rank,rank_name,colour,colour_name,subject,first,gospel,comms + 2027-01-01,ef,christmastide,Tempus Nativitatis,,ef-circumcision,In Octava Nativitatis Domini,Feria VI,class-1,I classis,white,albus,temporal,Titus 2:11-15,Luke 2:21, $ colitur emit --format csv --from 2027 --to 2027 | wc -l 366 @@ -522,12 +522,21 @@ render is the same operation under the name the design used: 2027-01-01 ef-circumcision 2027-01-02 ef-christmas-1-saturday -Flavour is inferred from the extension and escapes data -- Sts. Peter & -Paul (29 June) and its vigil are the only two 2035 entries whose English -name needs LaTeX escaping: - - $ printf '{{#days}}{{name.en}}\n{{/days}}' > /tmp/t.tex - $ colitur table --year 2035 --template /tmp/t.tex | grep -c 'Peter \\& Paul' +Flavour is inferred from the extension. `name` is the RESOLVED display +string now (view.ml), not the old lang-keyed object -- there is no more +`.en`/`.la` to reach, so a plain `{{name}}` is the only correct form; the +old `{{name.en}}` dotted lookup on today's plain string simply finds +nothing, on purpose (this is the change that also removes the shadowing +hazard: a miss on a plain string has no dotted path left to fall back +through). Names are Latin here (no --lang until the CLI wiring task), and +the Missal's own Latin spells Peter and Paul's feast with "et", never an +ampersand, so this no longer doubles as an escaping demonstration -- +that property is proved live on 2035 data in test_emit.ml instead +(test_xml_escapes_live_data), where the English table both name sources +still share does carry one: + + $ printf '{{#days}}{{name}}\n{{/days}}' > /tmp/t.tex + $ colitur table --year 2035 --template /tmp/t.tex | grep -c 'Ss\. Petri et Pauli' 2 An unknown extension with no --flavour is an error, not a silent fallback: diff --git a/test/test_emit.ml b/test/test_emit.ml index a22eaaf..0a40054 100644 --- a/test/test_emit.ml +++ b/test/test_emit.ml @@ -61,7 +61,7 @@ let test_csv_header_and_rows () = let lines = String.split_on_char '\n' out |> List.filter (fun l -> l <> "") in Alcotest.(check int) "366 lines: header + 365 days" 366 (List.length lines); Alcotest.(check string) "header" - "date,rite,season,week,slug,rank,colour,subject,name_la,name_en,first,gospel,comms" + "date,rite,season,season_name,week,slug,name,weekday,rank,rank_name,colour,colour_name,subject,first,gospel,comms" (List.hd lines); Alcotest.(check bool) "first row is 1 January" true (String.length (List.nth lines 1) > 10 && String.sub (List.nth lines 1) 0 10 = "2027-01-01") @@ -86,8 +86,8 @@ let test_csv_quotes_commas () = that escapes its quoting produces 14 fields, not 13. Also assert the quoted substring appears literally, byte for byte -- belt and braces, and closer to what a human reviewing the CSV would actually look for. *) - Alcotest.(check int) "the row has exactly 13 fields, same as the header" - 13 (List.length (parse_csv_row joseph)); + Alcotest.(check int) "the row has exactly 16 fields, same as the header" + 16 (List.length (parse_csv_row joseph)); Alcotest.(check bool) "Joseph's comma-bearing name is quoted whole, not split" true (contains ~needle:"\"St. Joseph, Spouse of the Bl. Virgin Mary\"" joseph) diff --git a/test/test_view.ml b/test/test_view.ml index e595357..b49b090 100644 --- a/test/test_view.ml +++ b/test/test_view.ml @@ -24,8 +24,29 @@ let days_of_year y = done; List.rev !out +(* Shared across this file and test_emit.ml: the ENGLISH table, chained to + Latin (en.ini's own [meta] fallback = la), so a slug en.ini does not name + directly still resolves through the chain rather than degrading to its + slug. English (not Latin, and not Lang.raw) is deliberate: it keeps the + emitter tests' own literal expectations -- "St. Joseph, Spouse of the Bl. + Virgin Mary" (a comma, for CSV quoting), "Sts. Fabian & Sebastian" (an + ampersand, for XML escaping) -- byte-identical to lang/en.ini's own + [celebration] entries, verified by grep against the shipped file rather + than assumed. *) +let read_lang path = + let ic = open_in_bin path in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + match Colitur_naming.Lang.of_string s with + | Ok t -> t + | Error e -> Alcotest.failf "%s: %s" path e + +let default_lang = + lazy (Colitur_naming.Lang.with_fallback (read_lang "../lang/en.ini") (read_lang "../lang/la.ini")) + let view_of y = - V.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y) + V.of_days ~lang:(Lazy.force default_lang) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y + (days_of_year y) let get path v = let rec go v = function @@ -110,10 +131,79 @@ let test_exactly_one_colour_flag () = if n <> 1 then Alcotest.failf "%s has %d colour flags set" (as_str (get [ "iso" ] d)) n) (as_list (get [ "days" ] v)) +(* Padding cells and real days must carry the SAME key set: a template that + walks a grid row must never hit a missing key on a padding cell. Compares + the sorted key lists of a real day and a padding cell (the first cell of + January 2027's first week -- 1 Jan 2027 is a Friday, so that cell IS a + padding cell, see test_padding_cells_are_flagged above). *) +let keys_of = function + | T.Obj kvs -> List.sort compare (List.map fst kvs) + | _ -> Alcotest.fail "expected an object" + +let test_padding_and_real_share_key_set () = + let v = view_of 2027 in + let jan = List.hd (as_list (get [ "months" ] v)) in + let first_week = List.hd (as_list (get [ "weeks" ] jan)) in + let cells = as_list (get [ "days" ] first_week) in + let padding = List.find (fun c -> not (as_bool (get [ "in_month" ] c))) cells in + let real = List.find (fun c -> as_bool (get [ "in_month" ] c)) cells in + Alcotest.(check (list string)) "padding and real days have the same key set" (keys_of real) + (keys_of padding) + +let latin () = + let ic = open_in_bin "../lang/la.ini" in + let s = really_input_string ic (in_channel_length ic) in + close_in ic; + match Colitur_naming.Lang.of_string s with + | Ok t -> t | Error e -> Alcotest.failf "la.ini: %s" e + +let view_named y = V.of_days ~lang:(latin ()) ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y (days_of_year y) + +(* 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 () = + let v = view_named 2027 in + List.iter + (fun d -> + let name = as_str (get [ "name" ] d) and slug = as_str (get [ "slug" ] d) in + if name = slug then Alcotest.failf "%s renders its slug as its name" (as_str (get [ "iso" ] d)); + if name = "" then Alcotest.failf "%s has an empty name" (as_str (get [ "iso" ] d))) + (as_list (get [ "days" ] v)) + +let test_slug_is_unchanged_by_naming () = + let raw = V.of_days ~lang:Colitur_naming.Lang.raw ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027 (days_of_year 2027) in + let named = view_named 2027 in + List.iter2 + (fun a b -> Alcotest.(check string) "slug identical" (as_str (get [ "slug" ] a)) (as_str (get [ "slug" ] b))) + (as_list (get [ "days" ] raw)) (as_list (get [ "days" ] named)) + +(* Under --raw the name IS the slug: that is what makes raw output byte-stable. *) +let test_raw_name_equals_slug () = + let raw = V.of_days ~lang:Colitur_naming.Lang.raw ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:2027 (days_of_year 2027) in + List.iter + (fun d -> Alcotest.(check string) "raw" (as_str (get [ "slug" ] d)) (as_str (get [ "name" ] d))) + (as_list (get [ "days" ] raw)) + +(* Weekday, month, season, rank and colour must localise too -- a calendar in a + language needs more than feast names. *) +let test_vocabularies_localise () = + let v = view_named 2027 in + let jan = List.hd (as_list (get [ "months" ] v)) in + Alcotest.(check string) "month name" "Ianuarius" (as_str (get [ "name" ] jan)); + let d1 = List.hd (as_list (get [ "days" ] v)) in + Alcotest.(check string) "weekday" "Feria VI" (as_str (get [ "weekday" ] d1)); + Alcotest.(check string) "rank" "I classis" (as_str (get [ "rank_name" ] d1)); + Alcotest.(check string) "colour" "albus" (as_str (get [ "colour_name" ] d1)) + let suite = ( "View", [ Alcotest.test_case "year shape" `Quick test_year_shape; Alcotest.test_case "weeks flatten to days" `Quick test_weeks_flatten_to_days; Alcotest.test_case "padding cells flagged" `Quick test_padding_cells_are_flagged; + Alcotest.test_case "padding and real days share key set" `Quick test_padding_and_real_share_key_set; + 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; + Alcotest.test_case "vocabularies localise" `Quick test_vocabularies_localise; Alcotest.test_case "day fields" `Quick test_day_fields; Alcotest.test_case "exactly one colour flag" `Quick test_exactly_one_colour_flag ] ) -- cgit v1.3