diff options
| -rw-r--r-- | lib/kernel/overlay_ini.mli | 9 | ||||
| -rw-r--r-- | lib/naming/dune | 3 | ||||
| -rw-r--r-- | lib/naming/lang.ml | 96 | ||||
| -rw-r--r-- | lib/naming/lang.mli | 44 | ||||
| -rw-r--r-- | test/dune | 2 | ||||
| -rw-r--r-- | test/test_colitur.ml | 1 | ||||
| -rw-r--r-- | test/test_lang.ml | 85 |
7 files changed, 239 insertions, 1 deletions
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 = <code>" + | 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 @@ -1,6 +1,6 @@ (test (name test_colitur) - (libraries colitur_kernel colitur_render rite_ef alcotest qcheck qcheck-alcotest sexplib) + (libraries colitur_kernel colitur_naming colitur_render rite_ef alcotest qcheck qcheck-alcotest sexplib) (deps ../data/ef/sanctoral.sexp ../data/ef/adjustments.sexp diff --git a/test/test_colitur.ml b/test/test_colitur.ml index 04bbdee..dd1274a 100644 --- a/test/test_colitur.ml +++ b/test/test_colitur.ml @@ -2,6 +2,7 @@ let () = Alcotest.run "colitur" [ Test_date.suite; Test_computus.suite; Test_colour.suite; Test_slug.suite; Test_names.suite; + Test_lang.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_lang.ml b/test/test_lang.ml new file mode 100644 index 0000000..0b16b30 --- /dev/null +++ b/test/test_lang.ml @@ -0,0 +1,85 @@ +module L = Colitur_naming.Lang + +let ok = function Ok x -> x | Error e -> Alcotest.failf "parse: %s" e + +let sample = + "[meta]\n\ + lang = xx\n\ + fallback = la\n\ + [celebration]\n\ + ef-lent-3-monday = Feria II hebdomadae III Quadragesimae\n\ + francis-de-sales = S. Francisci Salesii\n\ + [weekday]\n\ + sunday = Dominica\n\ + monday = Feria II\n\ + [month]\n\ + 1 = Ianuarius\n\ + [season]\n\ + lent = Quadragesima\n\ + [rank]\n\ + class-1 = I classis\n\ + [colour]\n\ + white = albus\n\ + [term]\n\ + epistle = Epistola\n" + +let test_meta () = + let t = ok (L.of_string sample) in + Alcotest.(check string) "code" "xx" (L.code t); + Alcotest.(check (option string)) "fallback" (Some "la") (L.fallback_code t) + +let test_lookups () = + let t = ok (L.of_string sample) in + Alcotest.(check string) "celebration" "Feria II hebdomadae III Quadragesimae" + (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) "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"); + Alcotest.(check string) "term" "Epistola" (L.term t "epistle") + +(* THE load-bearing property: a missing key degrades to the key itself, never to + empty. A partial translation must be usable from its first line, and an + untranslated day must still say something a reader can act on. *) +let test_missing_degrades_to_key () = + let t = ok (L.of_string sample) in + Alcotest.(check string) "unknown celebration" "ef-advent-1-monday" + (L.celebration t "ef-advent-1-monday"); + Alcotest.(check string) "unknown colour" "rose" (L.colour t "rose"); + Alcotest.(check string) "unknown term" "gospel" (L.term t "gospel") + +let test_fallback_chain () = + let base = ok (L.of_string "[meta]\nlang = la\n[celebration]\na = ALPHA\nb = BETA\n") in + let over = ok (L.of_string "[meta]\nlang = xx\nfallback = la\n[celebration]\nb = BETA-XX\n") in + let t = L.with_fallback over base in + Alcotest.(check string) "own key wins" "BETA-XX" (L.celebration t "b"); + Alcotest.(check string) "falls back" "ALPHA" (L.celebration t "a"); + Alcotest.(check string) "neither: the key" "c" (L.celebration t "c") + +(* --raw must be a real identity table, not a special case threaded through every + call site: one table the whole program can pass around. *) +let test_raw_is_identity () = + Alcotest.(check string) "celebration" "ef-epiphany" (L.celebration L.raw "ef-epiphany"); + Alcotest.(check string) "colour" "white" (L.colour L.raw "white"); + Alcotest.(check string) "weekday" "0" (L.weekday L.raw 0) + +let test_malformed_is_error_not_crash () = + match L.of_string "[celebration\nbroken" with + | Error _ -> () + | Ok _ -> Alcotest.fail "a malformed language file must be an Error, never accepted" + +let test_missing_meta_lang_is_error () = + match L.of_string "[celebration]\na = B\n" with + | Error _ -> () + | Ok _ -> Alcotest.fail "a language file with no [meta] lang must be an Error" + +let suite = + ( "Lang", + [ Alcotest.test_case "meta" `Quick test_meta; + Alcotest.test_case "lookups" `Quick test_lookups; + Alcotest.test_case "missing degrades to key" `Quick test_missing_degrades_to_key; + 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 ] ) |