1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
|
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 ->
(* 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 =
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
| 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
|
