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
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
|
module V = Colitur_render.View
module T = Colitur_render.Template
(* Build one civil year of resolved days exactly as the CLI does. *)
let days_of_year y =
let layer =
match Test_support.load_ef_layer () with Ok l -> l | Error e -> Alcotest.failf "layer: %s" e
in
let context = Test_support.ef_context () in
let module Cal = Colitur_kernel.Calendar in
let module D = Colitur_kernel.Date in
let tbl = Hashtbl.create 400 in
let index days =
Array.iter (fun d -> Hashtbl.replace tbl (D.to_rata d.Colitur_kernel.Liturgical_day.date) d) days
in
index (Cal.year context layer (y - 1));
index (Cal.year context layer y);
let jan1 = Result.get_ok (D.make ~year:y ~month:1 ~day:1) in
let dec31 = Result.get_ok (D.make ~year:y ~month:12 ~day:31) in
let out = ref [] and d = ref jan1 in
while D.compare !d dec31 <= 0 do
(match Hashtbl.find_opt tbl (D.to_rata !d) with Some x -> out := x :: !out | None -> ());
d := D.add_days !d 1
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 ~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
| [] -> v
| k :: tl -> (
match v with
| T.Obj kvs -> (
match List.assoc_opt k kvs with Some v' -> go v' tl | None -> Alcotest.failf "no key %s" k)
| _ -> Alcotest.failf "not an object at %s" k)
in
go v path
let as_list = function T.List l -> l | _ -> Alcotest.fail "expected a list"
let as_str = function T.Str s -> s | _ -> Alcotest.fail "expected a string"
let as_bool = function T.Bool b -> b | _ -> Alcotest.fail "expected a bool"
let test_year_shape () =
let v = view_of 2027 in
Alcotest.(check string) "rite" "ef" (as_str (get [ "rite" ] v));
Alcotest.(check string) "year" "2027" (as_str (get [ "year" ] v));
Alcotest.(check int) "twelve months" 12 (List.length (as_list (get [ "months" ] v)));
Alcotest.(check int) "365 days" 365 (List.length (as_list (get [ "days" ] v)))
(* THE property the grid depends on: weeks flatten to the month's days plus
padding, and every real day appears exactly once (spec section 9.3). *)
let test_weeks_flatten_to_days () =
let v = view_of 2027 in
List.iter
(fun m ->
let weeks = as_list (get [ "weeks" ] m) in
let cells = List.concat_map (fun w -> as_list (get [ "days" ] w)) weeks in
List.iter
(fun w -> Alcotest.(check int) "seven cells per week" 7 (List.length (as_list (get [ "days" ] w))))
weeks;
let real = List.filter (fun c -> as_bool (get [ "in_month" ] c)) cells in
let own = as_list (get [ "days" ] m) in
Alcotest.(check int) "real cells = month days" (List.length own) (List.length real);
List.iter2
(fun a b -> Alcotest.(check string) "same day, same order" (as_str (get [ "iso" ] a)) (as_str (get [ "iso" ] b)))
own real)
(as_list (get [ "months" ] v))
let test_padding_cells_are_flagged () =
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
(* 1 January 2027 is a Friday, so the first week has five padding cells. *)
Alcotest.(check int) "five padding cells" 5
(List.length (List.filter (fun c -> not (as_bool (get [ "in_month" ] c))) cells));
List.iter
(fun c ->
if not (as_bool (get [ "in_month" ] c)) then
Alcotest.(check string) "padding has empty iso" "" (as_str (get [ "iso" ] c)))
cells
let test_day_fields () =
let v = view_of 2027 in
let d =
List.find (fun d -> as_str (get [ "iso" ] d) = "2027-01-13") (as_list (get [ "days" ] v))
in
Alcotest.(check string) "slug" "commemoration-of-the-baptism-of-the-lord" (as_str (get [ "slug" ] d));
Alcotest.(check string) "colour" "white" (as_str (get [ "colour" ] d));
Alcotest.(check bool) "is_white" true (as_bool (get [ "is_white" ] d));
Alcotest.(check bool) "is_violet" false (as_bool (get [ "is_violet" ] d));
Alcotest.(check int) "dow friday" 3 (int_of_string (as_str (get [ "dow" ] d)));
Alcotest.(check bool) "first citation present" true (as_str (get [ "first" ] d) <> "");
Alcotest.(check bool) "gospel citation present" true (as_str (get [ "gospel" ] d) <> "")
(* Exactly one of the six colour booleans is true on every day of a whole year:
a template that keys a cell colour off them can never get no colour or two. *)
let test_exactly_one_colour_flag () =
let v = view_of 2027 in
List.iter
(fun d ->
let n =
List.length
(List.filter
(fun k -> as_bool (get [ k ] d))
[ "is_white"; "is_red"; "is_green"; "is_violet"; "is_rose"; "is_black" ])
in
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 ] )
|
