From 8d0ab547895460956e36b66b47a299b02a3474f0 Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 18 Aug 2026 13:13:40 +0200 Subject: feat(overlay): default citations and layer, humanise parse errors A user-supplied overlay is the only sexp this engine reads that a human writes by hand, and two of Celebration.t's eight fields carry nothing such an author can meaningfully supply: citations is always empty for a local feast, since citations come from the rite's lectionary and never from calendar data, and layer merely repeats the overlay file's own id. Requiring both made the commonest first mistake -- omitting them -- fail with 'lib/kernel/celebration.ml.t_of_sexp: the following record elements were undefined: citations layer', which names a source file the author will never open and does not say what to write instead. A minimal local feast needed 12 lines, two of them noise. Overlay.load now fills each field only where ABSENT, so an explicitly stated value always wins: an overlay may legitimately name a layer different from its own id, and defaulting must not silently overwrite that. A test pins both directions. Deliberately scoped to overlays. Layer.load, which reads the shipped sanctoral, is untouched and stays strict -- that data is the project's own, every field of it is asserted by tests, and a missing one there is a defect rather than a convenience. Parse failures also stop naming kernel source paths: the five prefixes that actually reach a user are rewritten into the vocabulary of the file being edited, and anything unrecognised passes through verbatim rather than being reworded into something possibly wrong. --- lib/kernel/overlay.ml | 83 +++++++++++++++++++++++++++++++++++++++++++++++++-- test/test_overlay.ml | 66 +++++++++++++++++++++++++++++++++++++++- 2 files changed, 146 insertions(+), 3 deletions(-) diff --git a/lib/kernel/overlay.ml b/lib/kernel/overlay.ml index d1d03b3..58d8847 100644 --- a/lib/kernel/overlay.ml +++ b/lib/kernel/overlay.ml @@ -83,6 +83,72 @@ let merge layer overlays = (fun (l, acc) o -> let l, d = apply l o in (l, acc @ d)) (layer, []) overlays +(* A user-supplied overlay is the only sexp this engine reads that a HUMAN + writes by hand, and two of [Celebration.t]'s eight fields carry nothing such + an author can meaningfully supply: [citations] is always empty for a local + feast (citations come from the rite's lectionary, never from calendar data), + and [layer] merely repeats the overlay file's own [id]. Requiring both made + the commonest first mistake -- omitting them -- fail with + "lib/kernel/celebration.ml.t_of_sexp: the following record elements were + undefined: citations layer", which names a source file the author will never + open and does not say what to write instead. + + [fill_defaults] walks the raw sexp before the derived parser sees it and + supplies each field only where it is ABSENT, so an explicitly stated value + always wins -- an overlay may legitimately name a layer different from its + own id, and defaulting must not silently overwrite that. + + Deliberately scoped to overlays. {!Layer.load}, which reads the SHIPPED + sanctoral, is untouched and stays strict: that data is the project's own, + every field of it is asserted by tests, and a missing one there is a defect + rather than a convenience. This is a leniency for user input only. *) +let fill_defaults ~id sexp = + let open Sexplib0.Sexp in + let has_field name = function + | List (Atom k :: _) -> String.equal k name + | _ -> false + in + (* [cel] is a record: a list of (key value) pairs. Add what is missing. *) + let rec fix_cel = function + | List fields when List.exists (has_field "slug") fields -> + let add name v acc = if List.exists (has_field name) acc then acc else acc @ [ v ] in + fields + |> add "citations" (List [ Atom "citations"; List [] ]) + |> add "layer" (List [ Atom "layer"; Atom id ]) + |> fun fs -> List fs + | List l -> List (List.map fix_cel l) + | a -> a + in + let rec walk = function + | List [ Atom "cel"; body ] -> List [ Atom "cel"; fix_cel body ] + | List l -> List (List.map walk l) + | a -> a + in + walk sexp + +(* The derived parsers report failures as [Of_sexp_error] carrying the + defining module's own path -- accurate for a colitur developer, useless to + someone editing their parish's calendar. Rewrite the two prefixes that + actually reach a user into the vocabulary of the file they are looking at. + Anything unrecognised passes through verbatim rather than being reworded + into something possibly wrong. *) +let humanise_error msg = + let replace ~sub ~by s = + let n = String.length sub and len = String.length s in + let rec go i acc = + if i > len - n then acc ^ String.sub s i (len - i) + else if String.equal (String.sub s i n) sub then go (i + n) (acc ^ by) + else go (i + 1) (acc ^ String.make 1 s.[i]) + in + if n = 0 then s else go 0 "" + in + msg + |> replace ~sub:"lib/kernel/celebration.ml.t_of_sexp" ~by:"celebration" + |> replace ~sub:"lib/kernel/colour.ml.t_of_sexp" ~by:"colour" + |> replace ~sub:"lib/kernel/subject.ml.t_of_sexp" ~by:"subject" + |> replace ~sub:"lib/kernel/date_spec.ml.t_of_sexp" ~by:"date" + |> replace ~sub:"lib/kernel/overlay.ml.directive_of_sexp" ~by:"directive" + let load rank_of_sexp path = match Sexplib.Sexp.load_sexp path with | exception Sys_error msg -> Error msg @@ -93,6 +159,19 @@ let load rank_of_sexp path = [Error] instead of escaping. *) | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn)) | sexp -> ( - match t_of_sexp rank_of_sexp sexp with + (* The overlay's own [id] is needed to default [layer], so read it off + the raw sexp first. If it is missing or malformed the derived parser + below reports that properly; "" here just means no useful default. *) + let id = + let open Sexplib0.Sexp in + let rec find = function + | List [ Atom "id"; Atom v ] -> Some v + | List l -> List.find_map find l + | Atom _ -> None + in + Option.value (find sexp) ~default:"" + in + match t_of_sexp rank_of_sexp (fill_defaults ~id sexp) with | t -> Ok t - | exception exn -> Error (Printf.sprintf "%s: %s" path (Printexc.to_string exn))) + | exception exn -> + Error (Printf.sprintf "%s: %s" path (humanise_error (Printexc.to_string exn)))) diff --git a/test/test_overlay.ml b/test/test_overlay.ml index f3d1aee..12eb56d 100644 --- a/test/test_overlay.ml +++ b/test/test_overlay.ml @@ -307,9 +307,73 @@ let prop_deterministic = let a, da = O.apply (base ()) o and b, db = O.apply (base ()) o in a = b && da = db) +(* Overlay ERGONOMICS (branch overlay-ergonomics). A user-supplied overlay is + hand-written, unlike every other sexp this engine reads, and two of + [Celebration.t]'s eight fields carry no information a user could supply + meaningfully: [citations] is always empty for a local feast (colitur emits + citations from the lectionary, not the calendar), and [layer] just repeats + the overlay file's own [id]. Requiring both meant the commonest first + mistake -- omitting them -- produced + "lib/kernel/celebration.ml.t_of_sexp: the following record elements were + undefined: citations layer", which names a source file the author will + never open. + + {!Overlay.load} now fills both in before the strict parser runs. This is + deliberately scoped to OVERLAY loading: {!Layer.load}, which reads the + SHIPPED sanctoral, stays strict, because that data is the project's own and + a missing field there is a defect rather than a convenience. *) +let overlay_missing_citations_and_layer = + {|((id my-parish) + (directives + ((Add + ((date (Fixed (month 5) (day 20))) + (cel + ((slug st-example) + (names ((en "St Example"))) + (rank Class3) (status Feast) (colour White) (subject Saint))))))))|} + +let test_overlay_defaults_citations_and_layer () = + with_temp_file (fun path -> + let oc = open_out path in + output_string oc overlay_missing_citations_and_layer; + close_out oc; + match O.load rank_of_sexp path with + | Error e -> Alcotest.failf "expected the overlay to load, got: %s" e + | Ok o -> + Alcotest.(check string) "id" "my-parish" o.O.id; + (match o.O.directives with + | [ O.Add e ] -> + Alcotest.(check string) "citations defaulted to empty" "0" + (string_of_int (List.length e.L.cel.Cel.citations)); + (* [layer] defaults to the overlay's own id: the value the author + would have typed, so a later Suppress/Edit naming it works. *) + Alcotest.(check string) "layer defaulted to the overlay id" "my-parish" + e.L.cel.Cel.layer + | _ -> Alcotest.fail "expected exactly one Add directive")) + +(* An explicit [layer] must still win: an overlay may deliberately claim a + different layer name from its own id (e.g. one file shipping two logical + layers), and defaulting must not overwrite a stated value. *) +let test_overlay_explicit_layer_wins () = + with_temp_file (fun path -> + let oc = open_out path in + output_string oc + (replace_first ~sub:"(subject Saint)" + ~by:"(subject Saint) (layer stated-explicitly)" overlay_missing_citations_and_layer); + close_out oc; + match O.load rank_of_sexp path with + | Ok { O.directives = [ O.Add e ]; _ } -> + Alcotest.(check string) "explicit layer preserved" "stated-explicitly" e.L.cel.Cel.layer + | Ok _ -> Alcotest.fail "expected exactly one Add directive" + | Error e -> Alcotest.failf "expected the overlay to load, got: %s" e) + let suite = ( "Layer/Overlay", - [ Alcotest.test_case "layer basics" `Quick test_layer_basics; + [ Alcotest.test_case "overlay: citations and layer default when omitted" `Quick + test_overlay_defaults_citations_and_layer; + Alcotest.test_case "overlay: an explicit layer is not overwritten" `Quick + test_overlay_explicit_layer_wins; + Alcotest.test_case "layer basics" `Quick test_layer_basics; Alcotest.test_case "layer by-date index" `Quick test_layer_index; Alcotest.test_case "layer by-date index accumulates same date" `Quick test_layer_index_same_date; -- cgit v1.3 From 49494c3aedf3f1b40c6ee36cb4de5615f097274c Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Tue, 18 Aug 2026 13:16:53 +0200 Subject: 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. --- bin/main.ml | 161 +++++++++++++++++++++++++++++++++++++++++++++++++++++++--- man/colitur.1 | 21 ++++++++ test/cli.t | 38 ++++++++++++-- 3 files changed, 210 insertions(+), 10 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 the resolved day identity, one line per day colitur readings the Mass reading citations, one line per day colitur day|readings --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 | colitur temporal | colitur day | colitur \ - readings (try: colitur --help)"; + readings | 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 ()) diff --git a/man/colitur.1 b/man/colitur.1 index 8a52858..a637f19 100644 --- a/man/colitur.1 +++ b/man/colitur.1 @@ -65,6 +65,27 @@ occurrence, commemoration and transfer. .BI readings " YEAR" The Mass reading citations, one line per day. .TP +.B new\-overlay +Print a starter overlay file to standard output, for redirection. Every value +in it is a placeholder that will appear in +.B day +output if left unedited, so a half\-finished overlay is visible rather than +silently inert. +.TP +.BI check " FILE" ... +Load each overlay, apply it to the shipped calendar, and report what it does: +the directive counts, the slug each targets, and any directive that matched +nothing. Exits +.B 2 +if a file fails to load or a directive found no target, so it composes into a +Makefile or a pre\-commit hook. It answers three narrow questions \(em does +the file parse, does every directive find its target, and what does the merged +result contain. It does +.I not +validate a calendar against the rubrics, and cannot: see +.B OVERLAYS +below. +.TP .BI \-\-overlay " FILE" Apply a user calendar on top of the shipped one. Repeatable and ordered; .B day diff --git a/test/cli.t b/test/cli.t index 0c79db4..d735e69 100644 --- a/test/cli.t +++ b/test/cli.t @@ -17,7 +17,7 @@ A year outside the supported domain is rejected (exit 2): No/garbage arguments give a usage error (exit 2): $ colitur - colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings (try: colitur --help) + colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings | colitur check FILE | colitur new-overlay (try: colitur --help) [2] The EF temporal cycle for a year, one line per day: @@ -327,17 +327,49 @@ A flag needing a value, given none: $ colitur day 2026 --overlay colitur: --overlay needs a file path - colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings (try: colitur --help) + colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings | colitur check FILE | colitur new-overlay (try: colitur --help) [2] An unknown option is rejected rather than treated as a positional word: $ colitur day 2026 --diocese colitur: unknown option --diocese - colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings (try: colitur --help) + colitur: usage: colitur easter | colitur temporal | colitur day | colitur readings | colitur check FILE | colitur new-overlay (try: colitur --help) [2] The shipped example overlay is runnable documentation, and it must actually load -- an example that silently rotted would be worse than none. The cram sandbox cannot reach data/, so the assertion that it loads and applies lives in test_lectionary_ef.ml, which reads it from the source tree directly. + +`new-overlay` prints a starter file to stdout for redirection, and what it +prints must itself be valid -- a template that does not load is worse than no +template, because it teaches the wrong shape. Round-tripped here rather than +pinned line by line, so editing the template's prose does not fail this test +while a syntax error in it still does: + + $ colitur new-overlay > starter.sexp + $ colitur check starter.sexp + starter.sexp: ok -- overlay my-parish, 2 directive(s): 2 add, 0 suppress, 0 replace, 0 edit + every directive found its target + add my-local-patron + add my-dedication + +`check` exits 2 when a directive matches nothing, so it is usable in a +Makefile or a pre-commit hook, not merely readable: + + $ printf '((id p) (directives ((Suppress no-such-slug))))' > bad.sexp + $ colitur check bad.sexp + bad.sexp: ok -- overlay p, 1 directive(s): 0 add, 1 suppress, 0 replace, 0 edit + MATCHED NOTHING: overlay p: suppress no-such-slug: slug not present; nothing to suppress + suppress no-such-slug + [2] + +`citations` and `layer` may be omitted from an added celebration; they default +to empty and to the overlay's own id: + + $ printf '((id tiny) (directives ((Add ((date (Fixed (month 5) (day 20))) (cel ((slug tiny-feast) (names ((en "Tiny"))) (rank Class3) (status Feast) (colour White) (subject Saint))))))))' > tiny.sexp + $ colitur check tiny.sexp + tiny.sexp: ok -- overlay tiny, 1 directive(s): 1 add, 0 suppress, 0 replace, 0 edit + every directive found its target + add tiny-feast -- cgit v1.3