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
|
module N = Colitur_kernel.Names
module L = Colitur_kernel.Lang
module C = Colitur_kernel.Citation
module DS = Colitur_kernel.Date_spec
module D = Colitur_kernel.Date
let lang s = L.of_string_exn s
let test_names_basics () =
let n = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
Alcotest.(check (option string)) "find la" (Some "Pascha") (N.find n (lang "la"));
Alcotest.(check (option string)) "find en" None (N.find n (lang "en"));
Alcotest.(check (option string)) "fallback la then en"
(Some "Pascha") (N.find_first n [ lang "en"; lang "la" ]);
(* canonical order is by language code, so sexp output is byte-stable *)
Alcotest.(check (list string)) "canonical order" [ "la"; "pl" ]
(List.map (fun (l, _) -> L.to_string l) (N.to_list n))
let test_names_set_remove () =
let n = N.of_list [ (lang "la", "Pascha") ] in
let n = N.set n (lang "en") "Easter" in
Alcotest.(check (option string)) "set en" (Some "Easter") (N.find n (lang "en"));
let n = N.set n (lang "en") "Easter Sunday" in
Alcotest.(check (option string)) "last writer wins" (Some "Easter Sunday") (N.find n (lang "en"));
let n = N.remove n (lang "en") in
Alcotest.(check (option string)) "removed" None (N.find n (lang "en"))
let test_names_of_list_duplicates () =
(* of_list with duplicate language: last entry wins *)
let n = N.of_list [ (lang "en", "Easter"); (lang "en", "Easter Sunday") ] in
Alcotest.(check (option string)) "of_list last wins" (Some "Easter Sunday") (N.find n (lang "en"))
let test_names_sexp_canonical () =
(* Two Names.t with different input order must serialize identically *)
let n1 = N.of_list [ (lang "pl", "Wielkanoc"); (lang "la", "Pascha"); (lang "en", "Easter") ] in
let n2 = N.of_list [ (lang "en", "Easter"); (lang "pl", "Wielkanoc"); (lang "la", "Pascha") ] in
Alcotest.(check bool) "same sexp despite different input order"
true (N.sexp_of_t n1 = N.sexp_of_t n2)
let test_names_sexp_roundtrip () =
let n = N.of_list [ (lang "la", "Pascha"); (lang "en", "Easter") ] in
let sexp = N.sexp_of_t n in
let n' = N.t_of_sexp sexp in
Alcotest.(check bool) "sexp roundtrip" true (n = n')
let test_citation () =
let c = { C.part = C.Gospel; reference = "Jn 3:16" } in
Alcotest.(check bool) "sexp roundtrip" true (C.t_of_sexp (C.sexp_of_t c) = c);
Alcotest.(check string) "part string" "gospel" (C.part_to_string C.Gospel);
Alcotest.(check bool) "part of_string" true (C.part_of_string "first" = Some C.First)
let test_date_spec () =
(match DS.fixed ~month:3 ~day:25 with
| Ok ds -> (
match DS.resolve ds ~year:2026 with
| Some d -> Alcotest.(check string) "resolve" "2026-03-25" (D.to_iso8601 d)
| None -> Alcotest.fail "resolve returned None")
| Error e -> Alcotest.failf "fixed: %s" e);
(* Feb 29 is a legitimate fixed date that simply does not occur every year. *)
(match DS.fixed ~month:2 ~day:29 with
| Ok ds ->
Alcotest.(check bool) "Feb 29 resolves in 2024" true (DS.resolve ds ~year:2024 <> None);
Alcotest.(check bool) "Feb 29 absent in 2026" true (DS.resolve ds ~year:2026 = None)
| Error e -> Alcotest.failf "Feb 29 must be constructible: %s" e);
Alcotest.(check bool) "reject Feb 30" true (Result.is_error (DS.fixed ~month:2 ~day:30));
Alcotest.(check bool) "reject Apr 31" true (Result.is_error (DS.fixed ~month:4 ~day:31));
Alcotest.(check bool) "reject month 13" true (Result.is_error (DS.fixed ~month:13 ~day:1))
let test_date_spec_sexp_roundtrip () =
(match DS.fixed ~month:3 ~day:25 with
| Ok ds ->
let sexp = DS.sexp_of_t ds in
let ds' = DS.t_of_sexp sexp in
Alcotest.(check bool) "sexp roundtrip" true (ds = ds')
| Error e -> Alcotest.failf "fixed: %s" e)
let test_date_spec_sexp_validates () =
(* Register finding 6: [ppx_sexp_conv]'s plain derived [t_of_sexp] would
accept any in-range int pair for [Fixed], so [(Fixed(month 13)(day 1))]
would silently deserialise into a spec that simply never resolves -- a
saint quietly vanishing with no diagnostic. [t_of_sexp] now re-runs the
value through [fixed], matching how [Slug] and [Lang] already validate
on load. *)
let bad = Sexplib.Sexp.of_string "(Fixed(month 13)(day 1))" in
Alcotest.check_raises "month 13 rejected at load"
(Sexplib0.Sexp_conv_error.Of_sexp_error
(Failure "date_spec: month 13 out of range 1..12", bad))
(fun () -> ignore (DS.t_of_sexp bad));
let bad_day = Sexplib.Sexp.of_string "(Fixed(month 4)(day 31))" in
Alcotest.check_raises "31 April rejected at load"
(Sexplib0.Sexp_conv_error.Of_sexp_error
(Failure "date_spec: day 31 out of range for month 4", bad_day))
(fun () -> ignore (DS.t_of_sexp bad_day))
module Cel = Colitur_kernel.Celebration
module S = Colitur_kernel.Slug
module Col = Colitur_kernel.Colour
module Sub = Colitur_kernel.Subject
(* A throwaway rank vocabulary, to exercise the parametric type. *)
type demo_rank = High | Low [@@deriving sexp]
let test_celebration () =
let c =
Cel.make ~slug:(S.of_string_exn "ef-easter-sunday")
~names:(N.of_list [ (lang "la", "Dominica Resurrectionis") ])
~rank:High ~colour:Col.White ~subject:Sub.Lord ~layer:"temporal" ()
in
Alcotest.(check string) "slug" "ef-easter-sunday" (S.to_string c.Cel.slug);
Alcotest.(check bool) "default citations empty" true (c.Cel.citations = []);
let sexp = Cel.sexp_of_t sexp_of_demo_rank c in
Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = c)
let test_celebration_status () =
let c =
Cel.make ~slug:(S.of_string_exn "telesphorus") ~rank:High ~colour:Col.Red
~subject:Sub.Saint ~layer:"tridentine" ()
in
Alcotest.(check bool) "defaults to Feast" true (c.Cel.status = Cel.Feast);
let k =
Cel.make ~slug:(S.of_string_exn "hyginus") ~rank:High ~colour:Col.Red
~status:Cel.Commemoration_only ~subject:Sub.Saint ~layer:"tridentine" ()
in
Alcotest.(check bool) "explicit status" true (k.Cel.status = Cel.Commemoration_only);
let sexp = Cel.sexp_of_t sexp_of_demo_rank k in
Alcotest.(check bool) "sexp roundtrip" true (Cel.t_of_sexp demo_rank_of_sexp sexp = k)
module Rec = Colitur_kernel.Record
module Voc = Colitur_kernel.Vocab
module Tmp = Colitur_kernel.Temporal
type demo_season = Ordinary [@@deriving sexp]
let demo_vocab : (demo_season, demo_rank) Voc.t =
{ seasons = [ Ordinary ];
season_to_string = (fun Ordinary -> "ordinary");
season_of_string = (function "ordinary" -> Some Ordinary | _ -> None);
ranks = [ High; Low ];
rank_to_string = (function High -> "high" | Low -> "low");
rank_of_string = (function "high" -> Some High | "low" -> Some Low | _ -> None) }
let test_record () =
let date = match D.make ~year:2026 ~month:4 ~day:5 with
| Ok d -> d | Error e -> Alcotest.failf "%s" e
in
let office =
Cel.make ~slug:(S.of_string_exn "ef-easter-sunday")
~names:(N.of_list [ (lang "la", "Dominica Resurrectionis") ])
~rank:High ~colour:Col.White ~subject:Sub.Lord ~layer:"temporal" ()
in
let t = { Tmp.season = Ordinary; week = Some 1; weekday = D.Sun; office } in
let r = Rec.of_temporal ~rite:"ef" demo_vocab date t in
Alcotest.(check string) "date" "2026-04-05" r.Rec.date;
Alcotest.(check string) "season" "ordinary" r.Rec.season;
Alcotest.(check string) "week" "1" r.Rec.week;
Alcotest.(check string) "weekday" "sunday" r.Rec.weekday;
Alcotest.(check string) "rank" "high" r.Rec.rank;
Alcotest.(check string) "colour" "white" r.Rec.colour;
Alcotest.(check string) "subject" "lord" r.Rec.subject;
Alcotest.(check (list string)) "names flattened" [ "la" ]
(List.map fst r.Rec.names);
(* A day outside a numbered week renders week as the empty string, not "0". *)
let r' = Rec.of_temporal ~rite:"ef" demo_vocab date { t with Tmp.week = None } in
Alcotest.(check string) "no week" "" r'.Rec.week;
(* Schema is pinned: headers and to_row derive from a single columns list,
so alignment cannot drift. Assert the column names in order. *)
Alcotest.(check (list string)) "headers schema"
[ "date"; "rite"; "season"; "week"; "weekday"; "slug"; "rank"; "colour"; "subject" ]
Rec.headers;
(* Register finding 14: with headers and to_row both derived from the same
[columns] list, equal length holds by construction -- a length-only
check here is vacuous, since it cannot fail without headers and to_row
already being defined from different sources. Assert the row's actual
values, in header order, instead. *)
Alcotest.(check (list string)) "row values in header order"
[ "2026-04-05"; "ef"; "ordinary"; "1"; "sunday"; "ef-easter-sunday"; "high"; "white"; "lord" ]
(Rec.to_row r)
let suite =
( "Names/Citation/DateSpec",
[ Alcotest.test_case "names basics" `Quick test_names_basics;
Alcotest.test_case "names set/remove" `Quick test_names_set_remove;
Alcotest.test_case "names of_list duplicates" `Quick test_names_of_list_duplicates;
Alcotest.test_case "names sexp canonical" `Quick test_names_sexp_canonical;
Alcotest.test_case "names sexp roundtrip" `Quick test_names_sexp_roundtrip;
Alcotest.test_case "citation" `Quick test_citation;
Alcotest.test_case "date_spec" `Quick test_date_spec;
Alcotest.test_case "date_spec sexp roundtrip" `Quick test_date_spec_sexp_roundtrip;
Alcotest.test_case "date_spec sexp validates" `Quick test_date_spec_sexp_validates;
Alcotest.test_case "celebration" `Quick test_celebration;
Alcotest.test_case "celebration status" `Quick test_celebration_status;
Alcotest.test_case "record" `Quick test_record ] )
|
