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 /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. /../share/colitur/ef -- the INSTALLED layout, from an opam or `dune install` prefix where the binary sits at /bin/colitur. data/dune puts the four runtime files there. 2. /../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 ` -- 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], [readings_report] and [emit_report] (Task 8): they differ only in what happens to each day, 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. [resolved_year_days] owns that walk and returns the resolved days, in date order, for one civil year; every caller layers its own handling (a line-printer, an accumulator for a whole-year [Template.value]) on top rather than repeating the indexing. *) let resolved_year_days ~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 let acc = ref [] in while D.compare !d dec31 <= 0 do (match Hashtbl.find_opt by_rata (D.to_rata !d) with | Some day -> acc := day :: !acc | 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; List.rev !acc let resolved_year_report ~line ~overlays y = List.iter line (resolved_year_days ~overlays y) 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 (* Task 8: `colitur emit` -- the five template-family emitters built in Tasks 5-7, wired to a year RANGE rather than a single year, because a published feed (ics) or a data export (csv/json/xml) is usually wanted for more than one civil year at a time. Reuses [resolved_year_days] rather than re-walking the two-liturgical-year index: see that function's own comment. CSV is the one format that spans years in a single stream deliberately printed as ONE header followed by every year's rows: emitting a fresh header per year would make `wc -l` and `awk 'NR>1'` both wrong on a multi-year run, and nothing about RFC 4180 requires a header per file rather than per stream. json/xml/sexp/ics are printed once per year instead -- concatenating whole JSON objects or VCALENDARs into one stream is what each of those formats itself expects a multi-document feed to look like (SEXP: printed one form per line, matching the sexp-per-day shape [Liturgical_day.t] already uses elsewhere in this file; XML: one document per year, the schema's own root is a single year; ICS: one VCALENDAR per year, valid to concatenate for a subscriber that reads multiple files). *) let emit_report ~format ~overlays ~dtstamp ~from_y ~to_y = if from_y > to_y then begin Printf.eprintf "colitur: --from %d is after --to %d\n" from_y to_y; exit 2 end; for y = from_y to to_y do let days = resolved_year_days ~overlays y in let v = Colitur_render.View.of_days ~vocab:Rite_ef.Vocab_ef.vocab ~rite:"ef" ~year:y days in match format with | "csv" -> (* One header for the whole run, not one per year. *) let body = Colitur_render.Emit_csv.year v in if y = from_y then print_string body else print_string (match String.index_opt body '\n' with | Some i -> String.sub body (i + 1) (String.length body - i - 1) | None -> body) | "json" -> print_string (Colitur_render.Emit_json.year v) | "xml" -> print_string (Colitur_render.Emit_xml.year v) | "ics" -> print_string (Colitur_render.Emit_ics.year ?dtstamp v) | "sexp" -> List.iter (fun d -> print_string (Sexplib.Sexp.to_string_hum (Colitur_kernel.Liturgical_day.sexp_of_t Rite_ef.Vocab_ef.sexp_of_season Rite_ef.Vocab_ef.sexp_of_rank d)); print_newline ()) days | other -> Printf.eprintf "colitur: unknown format %S (want csv, json, sexp, xml or ics)\n" other; exit 2 done (* 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.7.0" let help_text = {|colitur -- deterministic liturgical calendar engine (Roman rite, 1962) usage: colitur easter Easter, and the movable feasts anchored to it colitur temporal the temporal cycle, one line per day 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 emit --format csv|json|sexp|xml|ics --from Y --to Y [--overlay FILE ...] [--dtstamp S] render a resolved year range through one of five emitters colitur new-overlay print a starter overlay file to stdout colitur convert FILE.ini flat INI overlay -> S-expression, on 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 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. emit one schema (season, week, slug, rank, colour, subject, names, citations, commemorations), rendered five ways: csv (RFC 4180, one header for the whole run), json, sexp, xml (schema/colitur- v1.xsd) and ics (RFC 5545). --from/--to give a civil-year range, inclusive. --dtstamp fixes the ics DTSTAMP so two runs over the same data are byte-identical -- the engine reads no clock. 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. A flatter INI form exists for simple calendars, converted with `colitur convert`, which verifies its own output before emitting it. See colitur-overlay(5) for both forms. 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 (/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, and colitur-overlay(5) for the overlay file format in full.|} let print_help () = print_endline help_text; exit 0 let usage () = prerr_endline "colitur: usage: colitur easter | colitur temporal | colitur day | colitur \ readings | 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. [--format]/[--from]/[--to]/[--dtstamp] (Task 8, `emit`) are each single- valued, unlike [--overlay], so they are plain [string option] fields rather than accumulating lists. *) type parsed_args = { overlays : string list; format : string option; from_y : string option; to_y : string option; dtstamp : string option; positional : string list; } let parse_args argv = let rec go acc = function | [] -> Ok { acc with overlays = List.rev acc.overlays; positional = List.rev acc.positional } | ("--overlay" | "-o") :: path :: rest -> go { acc with overlays = path :: acc.overlays } rest | [ ("--overlay" | "-o") ] -> Error "--overlay needs a file path" | "--format" :: v :: rest -> go { acc with format = Some v } rest | [ "--format" ] -> Error "--format needs a value" | "--from" :: v :: rest -> go { acc with from_y = Some v } rest | [ "--from" ] -> Error "--from needs a value" | "--to" :: v :: rest -> go { acc with to_y = Some v } rest | [ "--to" ] -> Error "--to needs a value" | "--dtstamp" :: v :: rest -> go { acc with dtstamp = Some v } rest | [ "--dtstamp" ] -> Error "--dtstamp needs a value" (* 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 { acc with positional = arg :: acc.positional } rest in go { overlays = []; format = None; from_y = None; to_y = None; dtstamp = None; positional = [] } argv (* Sibling to [reject_overlays_for]: `emit`'s own four flags have no meaning on any other command (they take a single [] positional, not a [--from]/[--to] range), so accepting and silently dropping them would be the same failure mode `--overlay` already refuses on `easter`/`temporal`. *) let reject_emit_flags_for cmd ~format ~from_y ~to_y ~dtstamp = if format <> None || from_y <> None || to_y <> None || dtstamp <> None then begin Printf.eprintf "colitur: --format/--from/--to/--dtstamp have no effect on `%s`; refusing rather than ignoring them\n" cmd; exit 2 end (* [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 convert FILE.ini` -- the flat INI form to the S-expression one, on stdout for redirection. A separate step rather than teaching --overlay to sniff the extension, and deliberately so: the user gets to SEE what their INI became. When a date form was mistyped or an edit silently dropped, "what did the engine actually get" is the question, and an invisible transpile cannot answer it. {!Overlay_ini.convert} verifies its own output before returning it -- see that function's own comment. Nothing is written if the round trip fails. *) let convert_report path = match (try Ok (In_channel.with_open_text path In_channel.input_all) with Sys_error e -> Error e) with | Error e -> Printf.eprintf "colitur: %s\n" e; exit 2 | Ok text -> ( match Colitur_kernel.Overlay_ini.convert ~rank_of_string:Rite_ef.Vocab_ef.rank_of_string ~rank_to_sexp:Rite_ef.Vocab_ef.sexp_of_rank ~rank_of_sexp:Rite_ef.Vocab_ef.rank_of_sexp text with | Error e -> Printf.eprintf "colitur: %s: %s\n" path e; exit 2 | Ok sexp -> print_string sexp; exit 0) (* `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; format; from_y; to_y; dtstamp; positional } -> ( let reject_emit = reject_emit_flags_for ~format ~from_y ~to_y ~dtstamp in match positional with | [ ("-h" | "--help" | "help") ] -> reject_overlays_for "--help" overlays; reject_emit "--help"; print_help () | [ ("-V" | "--version" | "version") ] -> reject_overlays_for "--version" overlays; reject_emit "--version"; print_endline version; exit 0 | [ "easter"; ys ] -> reject_overlays_for "easter" overlays; reject_emit "easter"; with_year ys easter_report | [ "temporal"; ys ] -> reject_overlays_for "temporal" overlays; reject_emit "temporal"; with_year ys temporal_report | "check" :: (_ :: _ as files) -> reject_overlays_for "check" overlays; reject_emit "check"; check_report files | [ "convert"; path ] -> reject_overlays_for "convert" overlays; reject_emit "convert"; convert_report path | [ "new-overlay" ] -> reject_overlays_for "new-overlay" overlays; reject_emit "new-overlay"; print_string new_overlay_template; exit 0 | [ "day"; ys ] -> reject_emit "day"; with_year ys (day_report ~overlays) | [ "readings"; ys ] -> reject_emit "readings"; with_year ys (readings_report ~overlays) | [ "emit" ] -> ( match format with | None -> Printf.eprintf "colitur: emit requires --format csv|json|sexp|xml|ics\n"; exit 2 | Some format -> ( match (from_y, to_y) with | None, _ | _, None -> Printf.eprintf "colitur: emit requires --from YEAR and --to YEAR\n"; exit 2 | Some from_ys, Some to_ys -> with_year from_ys (fun from_y -> with_year to_ys (fun to_y -> emit_report ~format ~overlays ~dtstamp ~from_y ~to_y)))) | _ -> usage ())