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
|
module D = Colitur_kernel.Date
module C = Colitur_kernel.Computus
let fmt d = Printf.sprintf "%04d-%02d-%02d" (D.year d) (D.month d) (D.day d)
let easter_report y =
[ ("easter", C.gregorian_easter y);
("ash-wednesday", C.ash_wednesday y);
("palm-sunday", C.palm_sunday y);
("ascension", C.ascension y);
("pentecost", C.pentecost y);
("corpus-christi", C.corpus_christi y) ]
|> List.iter (fun (name, d) -> Printf.printf "%s %s\n" name (fmt d))
let temporal_report y =
let jan1 = match D.make ~year:y ~month:1 ~day:1 with
| Ok t -> t
| Error e -> failwith e
in
let dec31 = match D.make ~year:y ~month:12 ~day:31 with
| Ok t -> t
| Error e -> failwith e
in
(* [week] is "" for roughly 30 days a year (outside any numbered week);
printed as-is, that collapses two of the seven space-separated fields
into a double space, so naive field-position parsing (e.g. awk '{print
$4}') silently reads the wrong column on those days. Emit "-" instead,
so every line always has exactly seven single-space-separated fields. *)
let field s = if s = "" then "-" else s in
let d = ref jan1 in
while D.compare !d dec31 <= 0 do
let t = Rite_ef.Temporal_ef.temporal !d in
let r =
Colitur_kernel.Record.of_temporal ~rite:Rite_ef.Temporal_ef.id
Rite_ef.Vocab_ef.vocab !d t
in
Printf.printf "%s %s %s %s %s %s %s\n" r.Colitur_kernel.Record.date
r.Colitur_kernel.Record.weekday r.Colitur_kernel.Record.season
(field r.Colitur_kernel.Record.week) r.Colitur_kernel.Record.slug
r.Colitur_kernel.Record.rank r.Colitur_kernel.Record.colour;
d := D.add_days !d 1
done
(* Task 11: the fully resolved EF calendar (temporal AND sanctoral,
occurrence and transfers applied), one line per civil-year day --
"YYYY-MM-DD weekday season week slug rank colour [+commemoration-slug]...".
[temporal_report] above only ever showed the temporal cycle in isolation
([Rite_ef.Temporal_ef.temporal] directly, no sanctoral layer, no
[Precedence] contest); this is the first CLI path that runs every piece
Plan 3 built -- [Colitur_kernel.Layer], [Overlay], [Precedence_ef],
[Calendar] -- against real data. *)
(* [data/ef/sanctoral.sexp] and [data/ef/adjustments.sexp] are located
relative to the BUILD TREE, not the process's own cwd: cwd varies with
how the binary is invoked (a user's shell for `dune exec colitur --`, a
dune cram test's own sandboxed temp directory for `test/cli.t`) and
nothing in this project's build pins it to the repository root. A
build-time constant substituted via dune's [%{workspace_root}] was tried
first and rejected: it is resolved RELATIVE TO THE BUILD ACTION'S OWN
directory (empirically "." here, not an absolute path -- dune keeps
build actions relocatable), so it silently reproduces the same
cwd-dependence this is trying to eliminate, just baked in at build time
instead of read at run time; confirmed by the resulting `colitur day`
failing to find its own data outside the exact directory the build
happened to run in.
[Sys.executable_name] does not have that problem -- on Linux it resolves
through /proc/self/exe, which the kernel always reports as the
executable's own canonical absolute path, even when the process was
launched through a symlink (verified against dune's own cram sandbox,
which places exactly such a symlink; see the task report). dune's default
("no [(sandbox ...)] declared") build context mirrors the ENTIRE source
tree under _build/default/, unconditionally, so climbing from
_build/default/bin/main.exe up two directories and back down into data/
always finds both files, regardless of the caller's own cwd.
Known limitation, not yet exercised by this project: a `dune install`-
style deployment (executable copied to a prefix with no adjacent _build/
default/data/) would need a different resolution strategy; there is no
install story yet (README.md: `dune exec` only), so this is not a
regression against anything this project currently supports. *)
let data_dir () = Filename.dirname (Filename.dirname Sys.executable_name) ^ "/data/ef"
(* Loads the universal sanctoral layer and applies the one hand-authored
overlay over it (data/ef/adjustments.sexp -- see that file's own header):
[Overlay.apply]'s diagnostics are never silently dropped (Overlay.mli),
so any that come back -- expected to be none in the committed data; see
the overlay file's own comment on when one WOULD fire -- are printed to
stderr, loudly, without aborting the run. *)
let load_ef_layer () =
let dir = data_dir () in
let sanctoral_path = Filename.concat dir "sanctoral.sexp" in
let adjustments_path = Filename.concat dir "adjustments.sexp" in
match Colitur_kernel.Layer.load Rite_ef.Vocab_ef.rank_of_sexp sanctoral_path with
| Error e -> Error (Printf.sprintf "failed to load %s: %s" sanctoral_path e)
| Ok layer -> (
match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with
| Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e)
| Ok overlay ->
let layer, diagnostics = Colitur_kernel.Overlay.apply layer overlay in
List.iter
(fun d -> Printf.eprintf "colitur: %s\n" (Colitur_kernel.Overlay.diagnostic_to_string d))
diagnostics;
Ok layer)
let day_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t)
=
let t = d.Colitur_kernel.Liturgical_day.temporal in
let cel = d.Colitur_kernel.Liturgical_day.observed in
let week =
match t.Colitur_kernel.Temporal.week with Some n -> string_of_int n | None -> "-"
in
let commemoration_suffix (c, _) =
" +" ^ Colitur_kernel.Slug.to_string c.Colitur_kernel.Celebration.slug
in
let commemorations =
String.concat "" (List.map commemoration_suffix d.Colitur_kernel.Liturgical_day.commemorations)
in
Printf.printf "%s %s %s %s %s %s %s%s\n" (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date)
(D.weekday_to_string t.Colitur_kernel.Temporal.weekday)
(Rite_ef.Vocab_ef.season_to_string t.Colitur_kernel.Temporal.season)
week
(Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug)
(Rite_ef.Vocab_ef.rank_to_string cel.Colitur_kernel.Celebration.rank)
(Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour)
commemorations
(* One civil year, Jan 1 - Dec 31, matching [temporal_report]'s own scan --
NOT one liturgical year: [Colitur_kernel.Calendar.year] resolves a single
Advent-anchored liturgical year, which straddles two civil years, so a
civil year's worth of output needs the tail of the liturgical year that
opened the PREVIOUS civil year (covers roughly 1 Jan - 28 Nov) plus the
liturgical year that opens within this one (roughly 29 Nov - 31 Dec).
Both are computed once each -- not once per day via [Calendar.day], which
would recompute the whole (~365-day) placement pass up to 365 times over
for the days sharing one liturgical year (calendar.mli's own "pays it
once" cost model assumes exactly this usage: call [year], not [day] in a
loop). *)
let day_report y =
match load_ef_layer () with
| Error msg ->
Printf.eprintf "colitur: %s\n" msg;
exit 2
| Ok layer ->
let module Cal = Colitur_kernel.Calendar in
let by_rata : (int, (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) Hashtbl.t =
Hashtbl.create 400
in
let index days =
Array.iter
(fun (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t) ->
Hashtbl.replace by_rata (D.to_rata d.Colitur_kernel.Liturgical_day.date) d)
days
in
index (Cal.year Rite_ef.context layer (y - 1));
index (Cal.year Rite_ef.context layer y);
let jan1 = match D.make ~year:y ~month:1 ~day:1 with Ok t -> t | Error e -> failwith e in
let dec31 = match D.make ~year:y ~month:12 ~day:31 with Ok t -> t | Error e -> failwith e in
let d = ref jan1 in
while D.compare !d dec31 <= 0 do
(match Hashtbl.find_opt by_rata (D.to_rata !d) with
| Some day -> day_line day
| None ->
(* Unreachable for any [y] in 1583..9999: the two indexed
liturgical years jointly cover [year_start (y-1), year_start
(y+1)), which contains all of civil year [y]
(calendar.mli). Not a [failwith] -- an out-of-domain [d]
inside this loop is impossible by construction (jan1/dec31
are themselves validated in range, and [add_days] only ever
advances within the same civil year here) -- but a silent
skip would violate the same "never silently dropped"
standard the kernel holds itself to, so a gap surfaces
loudly on stderr rather than as a quietly short year. *)
Printf.eprintf "colitur: internal error: no resolved day for %s\n" (D.to_iso8601 !d));
d := D.add_days !d 1
done
let usage () =
prerr_endline "colitur: usage: colitur easter <year> | colitur temporal <year> | colitur day <year>";
exit 2
let with_year ys f =
match int_of_string_opt ys with
| Some y when y >= 1583 && y <= 9999 -> f y
| Some y ->
Printf.eprintf "colitur: year %d out of range 1583..9999\n" y;
exit 2
| None -> usage ()
let () =
match Sys.argv with
| [| _; "easter"; ys |] -> with_year ys easter_report
| [| _; "temporal"; ys |] -> with_year ys temporal_report
| [| _; "day"; ys |] -> with_year ys day_report
| _ -> usage ()
|
