blob: 0d902d56266d7b7027ba35a599f2c23035d6efda (
plain) (
blame)
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
|
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
|
