merge: overlay authoring ergonomics

Two mandatory fields made optional, parse errors that stop naming kernel
source files, and a feedback loop -- colitur check and colitur new-overlay --
for a file the test layers deliberately cannot vouch for.

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 ())