aboutsummaryrefslogtreecommitdiff
path: root/bin/main.ml
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-18 13:16:53 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-18 13:16:53 +0200
commit49494c3aedf3f1b40c6ee36cb4de5615f097274c (patch)
tree95d0a76818140d833577a46bf778b1e92822abcb /bin/main.ml
parent8d0ab547895460956e36b66b47a299b02a3474f0 (diff)
downloadcolitur-49494c3aedf3f1b40c6ee36cb4de5615f097274c.tar.gz
colitur-49494c3aedf3f1b40c6ee36cb4de5615f097274c.zip
feat(cli): colitur check and colitur new-overlay
Writing a local calendar had no feedback loop. An overlay is applied, not validated -- that stays true, and the five test layers still cannot vouch for a user's file -- but before this the only way to learn whether yours did what you meant was to generate a year of output and grep for your own slug, and the only way to see that a directive matched nothing was to notice a warning scroll past among 365 lines. `check` loads each overlay, applies it to the real shipped calendar, and reports the directive counts, the slug each one targets, and any directive that found no target. It exits 2 when a file fails to load or a directive matched nothing, so it composes into a Makefile or a pre-commit hook rather than merely being readable. It is applied to the SHIPPED calendar and not to an empty layer on purpose: against an empty one every Suppress would fail trivially and the check would be worthless. It answers three narrow questions -- does the file parse, does every directive find its target, what does the merged result contain. It does not validate a calendar against the rubrics and cannot, and both the help text and the man page say so rather than letting the name imply more than it does. `new-overlay` prints a starter to stdout for redirection, rather than writing a file where it likes. Every value in it is a placeholder that will appear in `day` output if left unedited, so a half-finished overlay is visible rather than silently inert, and it documents the three date shapes and the legal values for each closed field inline. load_ef_layer now returns its diagnostics instead of printing them: day and readings still 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. The cram test round-trips new-overlay through check rather than pinning the template line by line -- editing its prose should not fail a test, but a syntax error in it still must.
Diffstat (limited to 'bin/main.ml')
-rw-r--r--bin/main.ml161
1 files changed, 154 insertions, 7 deletions
diff --git a/bin/main.ml b/bin/main.ml
index fa0df12..a6af8df 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -170,11 +170,12 @@ let load_ef_layer ?(user_overlays = []) () =
match load_all [] (adjustments_path :: user_overlays) with
| Error e -> Error e
| Ok overlays ->
- let layer, diagnostics = Colitur_kernel.Overlay.merge layer overlays in
- List.iter
- (fun d -> Printf.eprintf "colitur: %s\n" (Colitur_kernel.Overlay.diagnostic_to_string d))
- diagnostics;
- Ok layer)
+ (* 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
@@ -295,7 +296,15 @@ let readings_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_
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 load_ef_layer ~user_overlays () with
+ 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
@@ -379,6 +388,8 @@ usage:
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
@@ -430,7 +441,7 @@ let print_help () =
let usage () =
prerr_endline
"colitur: usage: colitur easter <year> | colitur temporal <year> | colitur day <year> | colitur \
- readings <year> (try: colitur --help)";
+ readings <year> | colitur check FILE | colitur new-overlay (try: colitur --help)";
exit 2
let with_year ys f =
@@ -478,6 +489,135 @@ let reject_overlays_for cmd overlays =
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 ->
@@ -498,6 +638,13 @@ let () =
| [ "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 ())