summaryrefslogtreecommitdiff
path: root/bin/main.ml
blob: e7486292138b220e6914080d56afbd087e2455d5 (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
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
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
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.

   RESOLVED: the "known limitation" this comment used to end on -- that a
   `dune install`-style deployment (executable copied to a prefix with no
   adjacent _build/default/data/) had no resolution strategy, and would exit 2
   unable to find sanctoral.sexp -- is now handled by probing candidates in
   order rather than computing one path and hoping. data/dune installs the
   four runtime files into <prefix>/share/colitur/ef/.

   Two layouts are probed, and one override short-circuits both:

     [COLITUR_DATA_DIR], when set and non-blank -- an explicit override. It
     NEVER falls through: if it is set and does not contain the data, that is
     an error naming the directory, not a reason to quietly use different
     data. A packager or operator who names a directory has stated an
     intent, and silently calendaring off some other copy because theirs was
     wrong is precisely the silent substitution this project refuses
     everywhere else (CLAUDE.md's first binding decision: divergence is
     flagged LOUDLY, never silently swallowed). Getting this wrong is not
     hypothetical -- the first version of this function did fall through, and
     a deliberately bogus COLITUR_DATA_DIR produced a full, plausible,
     entirely un-flagged year off the build tree's data.

     Otherwise, in order:
     1. <exedir>/../share/colitur/ef -- the INSTALLED layout, from an opam or
        `dune install` prefix where the binary sits at <prefix>/bin/colitur.
        data/dune puts the four runtime files there.
     2. <exedir>/../data/ef -- the BUILD TREE, which is what `dune exec` and
        the cram tests use.

   A candidate is accepted only if sanctoral.sexp is actually readable inside
   it, not merely because the directory exists: an empty or half-populated
   share/colitur/ef (a failed install, a partially removed package) falls
   through to a working build tree rather than shadowing it and then failing
   at load time with a confusing per-file error. Verified by simulation, not
   assumed.

   Environment reads are fine HERE and only here: this is bin/, not the
   kernel, whose contract forbids them (CLAUDE.md, "Kernel is total &
   deterministic: no wall-clock, randomness, or environment reads"). Nothing
   below the CLI ever learns where the data came from -- the loaders take a
   path. *)
let data_dir () =
  let has_data d = Sys.file_exists (Filename.concat d "sanctoral.sexp") in
  let prefix = Filename.dirname (Filename.dirname Sys.executable_name) in
  let installed = List.fold_left Filename.concat prefix [ "share"; "colitur"; "ef" ] in
  let build_tree = Filename.concat prefix (Filename.concat "data" "ef") in
  match Sys.getenv_opt "COLITUR_DATA_DIR" with
  | Some d when String.trim d <> "" ->
      if has_data d then d
      else begin
        Printf.eprintf
          "colitur: COLITUR_DATA_DIR is set to %s, which contains no sanctoral.sexp\n\
           colitur: refusing to fall back to another data directory -- unset it, or point it at one\n"
          d;
        exit 2
      end
  | _ -> if has_data installed then installed else build_tree

(* 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. *)
(* [user_overlays] are applied AFTER the shipped adjustments, in the order
   given, never instead of them. That ordering is the whole point: the shipped
   overlay carries RG 110's own 30 June companion, the Major Litanies, St
   Barbara and Rogation Wednesday, and a user file that REPLACED it would
   silently drop all four while looking like it had merely added a local
   feast. {!Overlay.merge}'s last-writer-wins is what lets a local calendar
   still override a universal entry deliberately, by naming its slug.

   Diagnostics stay loud but non-fatal, and that matters more for a user file
   than for the shipped one: a directive naming a slug that does not exist (a
   typo in a diocesan calendar) prints to stderr and the run continues, rather
   than the entry silently doing nothing. A file that fails to LOAD is fatal,
   exactly as the shipped overlay is -- a malformed calendar is not something
   to carry on past. *)
let load_ef_layer ?(user_overlays = []) () =
  let dir = data_dir () in
  let sanctoral_path = Filename.concat dir "sanctoral.sexp" in
  let adjustments_path = Filename.concat dir "adjustments.sexp" in
  let load_overlay path =
    match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp path with
    | Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
    | Ok o -> Ok o
  in
  let rec load_all acc = function
    | [] -> Ok (List.rev acc)
    | p :: rest -> ( match load_overlay p with Error e -> Error e | Ok o -> load_all (o :: acc) rest)
  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 load_all [] (adjustments_path :: user_overlays) with
      | Error e -> Error e
      | Ok overlays ->
          (* Diagnostics come back to the caller rather than being printed
             here: `day`/`readings` want them on stderr beside a year of
             output, while `check` wants them on stdout, attributed to the
             overlay that produced them, and counted. Printing at the source
             made the second impossible. *)
          Ok (Colitur_kernel.Overlay.merge layer overlays))

(* Sibling to [load_ef_layer] above, same reasoning: [Rite_ef.context] now
   takes [~lectionary] rather than loading data/ef/lectionary.sexp itself
   (fix round 1, coordinator review -- a prior version had [Rite_ef]'s own
   [context] load the file as a side effect of being linked, which killed
   `colitur easter <year>` -- no lectionary data touched at all -- the
   moment that file was missing from a bare `dune build`'s own default
   target). Routed through the same [result] failure path as
   [load_ef_layer], so a missing/malformed file is reported via
   `colitur: %s` and `exit 2`, never an uncaught exception -- restoring the
   promise [Lectionary.load]'s own .mli makes ("failures come back as
   [Error], never as an exception"), which the reverted version broke by
   re-wrapping it in [failwith] at module init where no caller could catch
   it. *)
let load_ef_lectionary () =
  let path = Filename.concat (data_dir ()) "lectionary.sexp" in
  match Colitur_kernel.Lectionary.load path with
  | Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
  | Ok lectionary -> Ok lectionary

(* Sibling to [load_ef_lectionary] above, same reasoning and the same
   [result] failure path: data/ef/commons.sexp holds the Commons of the
   1962 Missal plus the per-saint assignments that route a readingless
   class-3 feast to one, and [Rite_ef.context] takes it as [~commons]
   rather than reading it itself. Its own loader validates the file
   (duplicate ids, empty formularies, assignments naming a common that does
   not exist) and reports every failure as [Error]. *)
let load_ef_commons () =
  let path = Filename.concat (data_dir ()) "commons.sexp" in
  match Rite_ef.Lectionary_ef.Commons.load path with
  | Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
  | Ok commons -> Ok commons

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

(* The reading citations for a day, as its own row shape rather than extra
   columns on [day_line]'s.

   A SEPARATE COMMAND, not a widening of `colitur day`, and the reason is
   mechanical rather than aesthetic: a citation contains spaces and commas
   ("Ezech 34:11-16", "Ecclus 51:1-8, 12"), while [day_line]'s row is
   space-separated with a variable-length "+slug" commemoration tail.
   Appending citations there would leave the row unsplittable -- no [awk]/
   [cut] field number could recover where the Epistle ends -- which is the
   opposite of the composability the row is shaped for. So `day` keeps its
   format byte-identical (nothing downstream of it changes at all) and the
   citations get a row whose own fields are " | "-delimited, safe for values
   containing spaces.

   This is deliberately a stopgap, and should not be mistaken for the
   project's answer to output formatting: the design calls for one schema
   rendered through a logic-less template engine (CSV/JSON/S-expression),
   which is where this belongs eventually. Two ad-hoc column formats are
   easier to retire later than one overloaded format with parsing rules
   nobody wrote down.

   "-" for an absent part, matching [temporal_report]'s own [field]
   convention for an empty column. On the EF data as it stands no day can
   actually print "-" -- {!Colitur_kernel.Validate}'s "citations"/
   "citations-unresolved" checks assert exactly one First and one Gospel on
   every day of every year 1583..9999 -- but the CLI must not assume a
   guarantee the kernel makes about DATA rather than about types. *)
let readings_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_kernel.Liturgical_day.t)
    =
  let cel = d.Colitur_kernel.Liturgical_day.observed in
  let part_ref p =
    match
      List.find_opt
        (fun (c : Colitur_kernel.Citation.t) -> c.Colitur_kernel.Citation.part = p)
        d.Colitur_kernel.Liturgical_day.citations
    with
    | Some c -> c.Colitur_kernel.Citation.reference
    | None -> "-"
  in
  Printf.printf "%s %s | %s | %s\n"
    (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date)
    (Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug)
    (part_ref Colitur_kernel.Citation.First)
    (part_ref Colitur_kernel.Citation.Gospel)

(* 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). *)
(* The three data files this subcommand needs, loaded once and reported
   through ONE failure path. Flattened out of the nested [match] this used
   to be when a third loader (the Commons, Task 6) joined the first two:
   each additional caller-supplied table would otherwise add a level of
   indentation and a third verbatim copy of the same two-line error-and-exit
   block. Every loader already returns [(_, string) result] (never raises,
   never reads at module-initialisation time -- see [load_ef_lectionary]),
   so chaining them costs nothing and keeps that promise intact. *)
let load_ef_data ?(user_overlays = []) () =
  match
    Result.map
      (fun (layer, diagnostics) ->
        List.iter
          (fun d -> Printf.eprintf "colitur: %s\n" (Colitur_kernel.Overlay.diagnostic_to_string d))
          diagnostics;
        layer)
      (load_ef_layer ~user_overlays ())
  with
  | Error msg -> Error msg
  | Ok layer -> (
      match load_ef_lectionary () with
      | Error msg -> Error msg
      | Ok lectionary -> (
          match load_ef_commons () with
          | Error msg -> Error msg
          | Ok commons -> Ok (layer, lectionary, commons)))

(* The resolved-year walk, shared by [day_report] and [readings_report]: they
   differ only in how each day is printed, and the two-liturgical-year
   indexing below (with its own reasoning about civil-vs-liturgical spans) is
   exactly the part that must not be duplicated and drift. [line] is the only
   difference between the two commands. *)
let resolved_year_report ~line ~overlays y =
  match load_ef_data ~user_overlays:overlays () with
  | Error msg ->
      Printf.eprintf "colitur: %s\n" msg;
      exit 2
  | Ok (layer, lectionary, commons) ->
      let context = Rite_ef.context ~lectionary ~commons in
      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 context layer (y - 1));
      index (Cal.year 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 -> 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 day_report ~overlays y = resolved_year_report ~line:day_line ~overlays y
let readings_report ~overlays y = resolved_year_report ~line:readings_line ~overlays y

(* Help and usage are deliberately DIFFERENT things, and the difference is the
   Unix convention rather than a preference: asking for help is a request that
   SUCCEEDED, so [--help] prints to stdout and exits 0 (it can be piped into a
   pager or grepped); being invoked wrongly is an error, so [usage] prints a
   one-liner to stderr and exits 2, keeping stdout clean for whatever the
   caller was really trying to capture. *)
(* Kept in lockstep with dune-project's own [(version ...)] by `make release`,
   which bumps BOTH and refuses to proceed if either edit did not take. Two
   places rather than one because dune's watermarking (`dune subst`) only
   substitutes in a release tarball, not in a plain `dune build` from a
   checkout, so a binary built the ordinary way would report a placeholder.
   A constant edited by the release target is what lectio does too, for the
   same reason. Deliberately NOT embedded in [help_text]: the cram test pins
   help's first line, and a version in it would make every release edit a
   test expectation for no gain. *)
let version = "0.6.0"

let help_text =
  {|colitur -- deterministic liturgical calendar engine (Roman rite, 1962)

usage:
  colitur easter <year>      Easter, and the movable feasts anchored to it
  colitur temporal <year>    the temporal cycle, one line per day
  colitur day <year>         the resolved day identity, one line per day
  colitur readings <year>    the Mass reading citations, one line per day
  colitur day|readings <year> --overlay FILE [--overlay FILE ...]
  colitur new-overlay        print a starter overlay file to stdout
  colitur check FILE ...     load an overlay, say what it does, exit 2 if not
  colitur -h, --help         this help
  colitur -V, --version      print the version and exit

<year> is a civil year, 1583..9999 inclusive. Each report covers 1 January to
31 December of that year, not a liturgical year.

output formats:
  day       date weekday season week slug rank colour [+commemoration ...]
            2026-04-05 sunday paschaltide 1 ef-easter-sunday class-1 white
  readings  date slug | Epistle | Gospel
            2026-12-25 ef-nativity | Heb 1:1-12 | John 1:1-14

  A citation contains spaces, so readings uses " | " between its fields while
  day stays space-separated; that is why they are separate commands rather
  than extra columns.

overlays:
  --overlay FILE (repeatable, ordered; -o) applies a user calendar ON TOP of
            the shipped universal one, never instead of it, so local feasts
            add to it rather than replacing it. Later files win over earlier
            ones, and over the universal calendar, when they name the same
            slug. Accepted on `day` and `readings` only -- the other commands
            read no sanctoral data, so the flag is refused there rather than
            silently ignored.

            An overlay is applied, NOT validated: colitur's test layers assert
            things about the shipped calendar and cannot vouch for a file you
            supply. A directive naming a slug that does not exist warns on
            stderr and the run continues; a file that fails to load is fatal.

            To write one:

              colitur new-overlay > my-parish.sexp   # a commented starter
              $EDITOR my-parish.sexp
              colitur check my-parish.sexp           # parses? every directive hit?
              colitur day 2026 --overlay my-parish.sexp

            `check` reports what each directive targets and exits 2 if a file
            will not load or a directive matched nothing, so it fits a
            Makefile or a pre-commit hook. It does not check a calendar
            against the rubrics -- nothing here can.

            In an added celebration, `citations` and `layer` may be omitted:
            they default to empty and to the overlay's own id. Dates may be
            (Fixed (month M) (day D)), (Easter_offset N) signed, or
            (Nth_weekday (month M) (nth N) (weekday W)) with N negative to
            count from the end of the month.

environment:
  COLITUR_DATA_DIR
            Read the calendar data from this directory instead of the
            installed (<prefix>/share/colitur/ef) or build-tree location.
            If it is set and holds no sanctoral.sexp, colitur exits 2 rather
            than silently falling back to a different copy of the data.

exit status:
  0  success
  2  bad usage, year out of range, or the calendar data could not be read

Reading references only (e.g. "Jn 3:16"); never scripture text.
See colitur(1) for the full description and the sources it computes against.|}

let print_help () =
  print_endline help_text;
  exit 0

let usage () =
  prerr_endline
    "colitur: usage: colitur easter <year> | colitur temporal <year> | colitur day <year> | colitur \
     readings <year> | colitur check FILE | colitur new-overlay  (try: colitur --help)";
  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 ()

(* Flags are stripped first, then the remaining words are matched as
   command + year. The alternative -- extending the exact-array patterns
   below -- does not survive a REPEATABLE flag: [--overlay a --overlay b] is a
   different array shape from [--overlay a], and every additional flag would
   multiply the patterns again. Hand-rolled because the dependency list is
   frozen and this is fifteen lines.

   [--overlay] accumulates in the order given, and that order is load-bearing
   ({!Overlay.merge} is last-writer-wins), so the list is reversed exactly
   once at the end rather than callers guessing. *)
let parse_args argv =
  let rec go overlays positional = function
    | [] -> Ok (List.rev overlays, List.rev positional)
    | ("--overlay" | "-o") :: path :: rest -> go (path :: overlays) positional rest
    | [ ("--overlay" | "-o") ] -> Error "--overlay needs a file path"
    (* The recognised bare flags pass through as positional words for the
       dispatch below to match; anything else beginning with '-' is rejected
       rather than silently treated as a command or a year. *)
    | arg :: _
      when String.length arg > 1
           && arg.[0] = '-'
           && not (List.mem arg [ "-h"; "--help"; "-V"; "--version" ]) ->
        Error (Printf.sprintf "unknown option %s" arg)
    | arg :: rest -> go overlays (arg :: positional) rest
  in
  go [] [] argv

(* [easter] reads no calendar data at all, and [temporal] deliberately runs the
   temporal cycle BEFORE any sanctoral layer exists, so an overlay could not
   affect either. Accepting the flag there and silently ignoring it is the
   failure mode this project refuses everywhere else -- it is an error. *)
let reject_overlays_for cmd overlays =
  if overlays <> [] then begin
    Printf.eprintf "colitur: --overlay has no effect on `%s` (it reads no sanctoral data); refusing rather than ignoring it\n" cmd;
    exit 2
  end

(* `colitur check FILE...` -- load a user overlay, apply it to the real
   shipped calendar, and say what it did, without printing a year of output.

   The gap this closes: an overlay is APPLIED, NOT VALIDATED (the man page says
   so, and it remains true -- the five test layers assert things about the
   SHIPPED calendar and cannot vouch for a user's file). Before this, the only
   way to find out whether your file did what you meant was to generate a whole
   year and grep for your own slug, and the only way to learn that a directive
   matched nothing was to notice a warning scroll past among 365 lines.

   This does not validate a calendar against the rubrics -- it cannot, and
   claiming otherwise would be the overclaim this project avoids elsewhere. It
   answers three narrower questions: does the file parse, does every directive
   find its target, and what does the merged result contain. *)
let check_report paths =
  let ok = ref true in
  List.iter
    (fun path ->
      match Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp path with
      | Error e ->
          Printf.printf "%s: FAILED TO LOAD\n  %s\n" path e;
          ok := false
      | Ok o ->
          let n_add, n_sup, n_rep, n_edit =
            List.fold_left
              (fun (a, s, r, e) -> function
                | Colitur_kernel.Overlay.Add _ -> (a + 1, s, r, e)
                | Colitur_kernel.Overlay.Suppress _ -> (a, s + 1, r, e)
                | Colitur_kernel.Overlay.Replace _ -> (a, s, r + 1, e)
                | Colitur_kernel.Overlay.Edit _ -> (a, s, r, e + 1))
              (0, 0, 0, 0) o.Colitur_kernel.Overlay.directives
          in
          Printf.printf "%s: ok -- overlay %s, %d directive(s): %d add, %d suppress, %d replace, %d edit\n"
            path o.Colitur_kernel.Overlay.id
            (List.length o.Colitur_kernel.Overlay.directives) n_add n_sup n_rep n_edit;
          (* Apply it to the REAL shipped calendar, so "matched nothing" is
             judged against the data the user will actually run against, not
             against an empty layer where every Suppress would trivially fail. *)
          (match load_ef_layer ~user_overlays:[ path ] () with
           | Error e ->
               Printf.printf "  applying to the shipped calendar failed: %s\n" e;
               ok := false
           | Ok (_, diagnostics) ->
               let mine =
                 List.filter
                   (fun (d : Colitur_kernel.Overlay.diagnostic) ->
                     String.equal d.Colitur_kernel.Overlay.overlay o.Colitur_kernel.Overlay.id)
                   diagnostics
               in
               if mine = [] then print_endline "  every directive found its target"
               else begin
                 ok := false;
                 List.iter
                   (fun d ->
                     Printf.printf "  MATCHED NOTHING: %s\n"
                       (Colitur_kernel.Overlay.diagnostic_to_string d))
                   mine
               end);
          List.iter
            (function
              | Colitur_kernel.Overlay.Add e ->
                  Printf.printf "  add      %s\n"
                    (Colitur_kernel.Slug.to_string
                       e.Colitur_kernel.Layer.cel.Colitur_kernel.Celebration.slug)
              | Colitur_kernel.Overlay.Suppress s ->
                  Printf.printf "  suppress %s\n" (Colitur_kernel.Slug.to_string s)
              | Colitur_kernel.Overlay.Replace (s, _) ->
                  Printf.printf "  replace  %s\n" (Colitur_kernel.Slug.to_string s)
              | Colitur_kernel.Overlay.Edit (s, _) ->
                  Printf.printf "  edit     %s\n" (Colitur_kernel.Slug.to_string s))
            o.Colitur_kernel.Overlay.directives)
    paths;
  exit (if !ok then 0 else 2)

(* `colitur new-overlay` -- a starter file on stdout, for redirection.
   Deliberately printed rather than written: the user picks the path, and a
   command that creates files where it likes is a worse citizen. Every value is
   a placeholder that WILL show up in output if left unedited, so a
   half-finished overlay is visible rather than silently inert. *)
let new_overlay_template =
  {template|; A colitur overlay: a local calendar applied ON TOP of the universal 1962
; one, never instead of it. Save this, edit it, then:
;
;   colitur check   my-parish.sexp        -- does it parse, does it apply
;   colitur day 2026 --overlay my-parish.sexp
;
; Directives are Add, Suppress, Replace and Edit, applied in the order written.
; Last writer wins, so a later file may override an earlier one -- or a
; universal entry -- by naming its slug.
((id my-parish)
  (directives
    ; A fixed-date local feast. `citations` and `layer` may be omitted: they
    ; default to empty and to this overlay's own id.
    ((Add
       ((date (Fixed (month 5) (day 20)))
         (cel
           ((slug my-local-patron)
             (names ((la "Sancti Patroni Nostri") (en "Our Local Patron")))
             ; rank:   Class1 | Class2 | Class3 | Class4
             ; status: Feast | Commemoration_only
             ; colour: White | Red | Violet | Green | Black | Rose
             ; subject: Lord | Bvm | Saint | Temporal
             (rank Class3) (status Feast) (colour White) (subject Saint)))))
     ; A MOVABLE feast: the first Sunday of October. `nth` may be negative to
     ; count from the end of the month (-1 is the last).
     (Add
       ((date (Nth_weekday (month 10) (nth 1) (weekday Sun)))
         (cel
           ((slug my-dedication)
             (names ((en "Dedication of Our Church")))
             ; A church's own dedication anniversary is I class IN THAT CHURCH
             ; (RG 91 entry 4). At III class it would lose to the Sunday it
             ; lands on every year.
             (rank Class1) (status Feast) (colour White) (subject Saint)))))
     ; A feast reckoned from Easter: Easter_offset counts days, signed.
     ; (Easter itself is 0; Ash Wednesday is -46; Corpus Christi is +60.)
     ; (Add
     ;   ((date (Easter_offset 60))
     ;     (cel ((slug my-easter-relative) (names ((en "Example")))
     ;           (rank Class3) (status Feast) (colour White) (subject Saint)))))
     ;
     ; Remove a universal entry your calendar does not keep:
     ; (Suppress some-universal-slug)
     ;
     ; Keep the entry but change one field:
     ; (Edit some-universal-slug ((Set_colour Red)))
     )))
|template}

let () =
  match parse_args (List.tl (Array.to_list Sys.argv)) with
  | Error msg ->
      Printf.eprintf "colitur: %s\n" msg;
      usage ()
  | Ok (overlays, positional) -> (
      match positional with
      | [ ("-h" | "--help" | "help") ] ->
          reject_overlays_for "--help" overlays;
          print_help ()
      | [ ("-V" | "--version" | "version") ] ->
          reject_overlays_for "--version" overlays;
          print_endline version;
          exit 0
      | [ "easter"; ys ] ->
          reject_overlays_for "easter" overlays;
          with_year ys easter_report
      | [ "temporal"; ys ] ->
          reject_overlays_for "temporal" overlays;
          with_year ys temporal_report
      | "check" :: (_ :: _ as files) ->
          reject_overlays_for "check" overlays;
          check_report files
      | [ "new-overlay" ] ->
          reject_overlays_for "new-overlay" overlays;
          print_string new_overlay_template;
          exit 0
      | [ "day"; ys ] -> with_year ys (day_report ~overlays)
      | [ "readings"; ys ] -> with_year ys (readings_report ~overlays)
      | _ -> usage ())