blob: e595357afa011edf7a42750ffc6e08b0f6c57400 (
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
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
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
let view_of y =
V.of_days ~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))
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 "day fields" `Quick test_day_fields;
Alcotest.test_case "exactly one colour flag" `Quick test_exactly_one_colour_flag ] )
|