aboutsummaryrefslogtreecommitdiff
path: root/bin/main.ml
diff options
context:
space:
mode:
Diffstat (limited to 'bin/main.ml')
-rw-r--r--bin/main.ml251
1 files changed, 246 insertions, 5 deletions
diff --git a/bin/main.ml b/bin/main.ml
index 59f18f2..6827fbc 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -257,6 +257,127 @@ let load_ef_commons () =
| Error e -> Error (Printf.sprintf "failed to load %s: %s" path e)
| Ok commons -> Ok commons
+(* Task 5 (2026-08-25-colitur-of-phases-3-5): `--rite of`, the OF (post-1970)
+ counterpart of everything above. Mirrors [data_dir]'s own probe order
+ (installed prefix, then the build tree) but scoped to "of" and keyed on
+ [calendar-2002.sexp] rather than [sanctoral.sexp] -- Task 1's own
+ transcription of the General Roman Calendar, the OF base layer.
+
+ Deliberately does NOT honour [COLITUR_DATA_DIR]: that variable's existing
+ contract (documented on [data_dir] above) is "an explicit override
+ pointing at a single flat directory containing sanctoral.sexp" -- an
+ EF-shaped contract this function would either have to silently reinterpret
+ (the same directory, now also expected to carry calendar-2002.sexp) or
+ split into a second variable, and neither is this task's call to make.
+ Left unaddressed rather than guessed at. *)
+let of_data_dir () =
+ let has_data d = Sys.file_exists (Filename.concat d "calendar-2002.sexp") in
+ let prefix = Filename.dirname (Filename.dirname Sys.executable_name) in
+ let installed = List.fold_left Filename.concat prefix [ "share"; "colitur"; "of" ] in
+ let build_tree = Filename.concat prefix (Filename.concat "data" "of") in
+ if has_data installed then installed else build_tree
+
+(* [load_of_layer]'s own [~user_overlays] follows [load_ef_layer]'s exact
+ discipline: applied AFTER the shipped base, never instead of it. The OF
+ base is [calendar-2002.sexp] (Task 1) plus all 13 decree-chronological
+ amendment overlays (Task 2, data/of/amendments/*.sexp) -- never edited
+ after the fact, per that file's own header -- so a diocesan/local
+ overlay a user supplies via [--overlay] layers on top of THOSE, exactly
+ mirroring how an EF user overlay layers on top of adjustments.sexp. *)
+let of_amendment_files =
+ [ "001-padre-pio.sexp"; "002-juan-diego-cuauhtlatoatzin.sexp"; "003-our-lady-of-guadalupe.sexp";
+ "004-john-xxiii-john-paul-ii.sexp"; "005-mary-magdalene-rank.sexp"; "006-mary-mother-of-the-church.sexp";
+ "007-paul-vi.sexp"; "008-our-lady-of-loreto.sexp"; "009-faustina-kowalska.sexp";
+ "010-narek-avila-hildegard.sexp"; "011-martha-mary-lazarus.sexp"; "012-teresa-of-calcutta.sexp";
+ "013-john-henry-newman.sexp" ]
+
+let load_of_layer ?(user_overlays = []) () =
+ let dir = of_data_dir () in
+ let base_path = Filename.concat dir "calendar-2002.sexp" in
+ let amendment_paths =
+ List.map (fun name -> Filename.concat dir (Filename.concat "amendments" name)) of_amendment_files
+ in
+ let load_overlay path =
+ match Colitur_kernel.Overlay.load Rite_of.Vocab_of.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_of.Vocab_of.rank_of_sexp base_path with
+ | Error e -> Error (Printf.sprintf "failed to load %s: %s" base_path e)
+ | Ok layer -> (
+ match load_all [] (amendment_paths @ user_overlays) with
+ | Error e -> Error e
+ | Ok overlays -> Ok (Colitur_kernel.Overlay.merge layer overlays))
+
+(* Sibling to [load_ef_lectionary], same [~lectionary]-is-a-caller-supplied-
+ parameter discipline [Rite_of.context]'s own .mli documents: a missing or
+ malformed data/of/lectionary.sexp is reported via [Error], never an
+ uncaught exception. *)
+let load_of_lectionary () =
+ let path = Filename.concat (of_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
+
+(* [load_of_data]/[resolved_of_year_days]/[day_report_of]/[readings_report_of]
+ mirror [load_ef_data]/[resolved_year_days]/[day_report]/[readings_report]
+ exactly, one rite down: no [~commons] (OF's [Lectionary_of.readings] has
+ none to thread, see rite_of.mli), and every EF-specific module reference
+ swapped for its OF sibling. Duplicated rather than parameterised over the
+ rite for the same reason test_amendments_of.ml's own header gives for its
+ near-identical EF twin: no [.mli] either file shares, and a shared
+ higher-order version would have to abstract over TWO different [Vocab.t]
+ instantiations plus TWO different [Rite.t] result types, which
+ [day_line]/[readings_line] below cannot be generic over either (they print
+ rite-specific vocabulary strings). *)
+let load_of_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_of_layer ~user_overlays ())
+ with
+ | Error msg -> Error msg
+ | Ok layer -> ( match load_of_lectionary () with Error msg -> Error msg | Ok lectionary -> Ok (layer, lectionary))
+
+let resolved_of_year_days ~overlays y =
+ match load_of_data ~user_overlays:overlays () with
+ | Error msg ->
+ Printf.eprintf "colitur: %s\n" msg;
+ exit 2
+ | Ok (layer, lectionary) ->
+ let context = Rite_of.context ~lectionary in
+ let module Cal = Colitur_kernel.Calendar in
+ let by_rata : (int, (Rite_of.Vocab_of.season, Rite_of.Vocab_of.rank) Colitur_kernel.Liturgical_day.t) Hashtbl.t =
+ Hashtbl.create 400
+ in
+ let index days =
+ Array.iter
+ (fun (d : (Rite_of.Vocab_of.season, Rite_of.Vocab_of.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 -> 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
+
(* [~lang] resolves the observed slug to a display NAME, appended as a new
LAST field rather than substituted into the slug's own position: a name
contains spaces (Latin and English both), and inserting it where the slug
@@ -543,6 +664,59 @@ let readings_report ~lang ~sigla ~overlays y =
resolved_year_report ~line:(readings_line ~lang ~sigla) ~overlays y
let rubrics_report ~overlays y = resolved_year_report ~line:rubrics_line ~overlays y
+(* Task 5 (2026-08-25-colitur-of-phases-3-5): [day_line]/[readings_line]'s
+ OF twins -- same two row shapes, same [~lang]/[~sigla] append-only rules
+ (see those functions' own citations just above for the full reasoning,
+ not repeated here), [Rite_of.Vocab_of] in place of [Rite_ef.Vocab_ef]. *)
+let day_line_of ~lang (d : (Rite_of.Vocab_of.season, Rite_of.Vocab_of.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
+ let slug_s = Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug in
+ let name = Colitur_naming.Lang.celebration lang slug_s in
+ let name_suffix = if name = slug_s then "" else " " ^ name in
+ Printf.printf "%s %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_of.Vocab_of.season_to_string t.Colitur_kernel.Temporal.season)
+ week slug_s
+ (Rite_of.Vocab_of.rank_to_string cel.Colitur_kernel.Celebration.rank)
+ (Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour)
+ commemorations name_suffix
+
+let readings_line_of ~lang ~sigla
+ (d : (Rite_of.Vocab_of.season, Rite_of.Vocab_of.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 -> Colitur_citation.Sigla.format sigla c.Colitur_kernel.Citation.reference
+ | None -> "-"
+ in
+ let slug_s = Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug in
+ let name = Colitur_naming.Lang.celebration lang slug_s in
+ let name_suffix = if name = slug_s then "" else " | " ^ name in
+ Printf.printf "%s %s | %s | %s%s\n"
+ (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date)
+ slug_s
+ (part_ref Colitur_kernel.Citation.First)
+ (part_ref Colitur_kernel.Citation.Gospel)
+ name_suffix
+
+let resolved_of_year_report ~line ~overlays y = List.iter line (resolved_of_year_days ~overlays y)
+
+let day_report_of ~lang ~overlays y = resolved_of_year_report ~line:(day_line_of ~lang) ~overlays y
+let readings_report_of ~lang ~sigla ~overlays y =
+ resolved_of_year_report ~line:(readings_line_of ~lang ~sigla) ~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
@@ -1269,7 +1443,7 @@ usage:
colitur day <year> the resolved day identity, one line per day
colitur readings <year> the Mass reading citations, one line per day
colitur rubrics <year> the Mass formulary said, one line per day
- colitur day|readings <year> [--overlay FILE ...] [--lang CODE|FILE] [--raw]
+ colitur day|readings <year> [--rite ef|of] [--overlay FILE ...] [--lang CODE|FILE] [--raw]
colitur rubrics <year> [--overlay FILE ...]
colitur emit --format csv|json|sexp|xml|ics --from Y --to Y
[--overlay FILE ...] [--dtstamp S] [--lang CODE|FILE] [--raw]
@@ -1344,6 +1518,12 @@ output formats:
inclusive. --dtstamp fixes the ics DTSTAMP so two runs over the
same data are byte-identical -- the engine reads no clock.
+rite:
+ --rite ef|of selects the rite `day`/`readings` compute against; default ef
+ (so every invocation written before this flag existed is
+ unaffected). `of` is the 1970 Missale Romanum (editio typica
+ tertia, 2002); no other command accepts the flag yet.
+
overlays:
--overlay FILE (repeatable, ordered; -o) applies a user calendar ON TOP of
the shipped universal one, never instead of it, so local feasts
@@ -1559,6 +1739,23 @@ let with_year ys f =
exit 2
| None -> usage ()
+(* Task 5 (2026-08-25-colitur-of-phases-3-5): resolves [--rite] to a closed
+ choice -- [None] (the flag was never given) and [Some "ef"] both mean
+ "ef", so that existing invocations with no [--rite] at all are
+ byte-identical to before this flag existed (spec's own requirement,
+ verified in test/cli.t). Anything other than "ef"/"of" is a usage error,
+ not a silent fallback to "ef" -- the same "an unrecognised value is
+ refused, not guessed at" discipline every other closed-choice flag in
+ this file follows (`--sigla-book full|abbr`, `lang --dump CODE`). Shared
+ by `day`/`readings`, the only two commands [reject_rite_for] lets the
+ flag reach. *)
+let resolve_rite = function
+ | None | Some "ef" -> `Ef
+ | Some "of" -> `Of
+ | Some other ->
+ Printf.eprintf "colitur: unknown --rite %S (expected \"ef\" or \"of\")\n" other;
+ exit 2
+
(* 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
@@ -1590,8 +1787,18 @@ let with_year ys f =
single-valued optional settings, the same shape as [lang] -- each has a
config-key counterpart in [Colitur_naming.Config] and is resolved through
the identical [Config.resolve] precedence (flag > config > default). *)
+(* [rite] (Task 5, 2026-08-25-colitur-of-phases-3-5): single-valued like
+ [lang], and deliberately a bare [string option] with no config-key
+ counterpart -- unlike [lang]/[template]/[format], nothing in
+ [Colitur_naming.Config] resolves a default rite, and this task does not
+ add one (out of scope: the brief asks for `--rite of` on `day`/
+ `readings` only). [None] means "ef", not "unset and therefore an
+ error" -- existing invocations with no [--rite] at all must stay
+ byte-identical, so the default has to be the CURRENT behaviour, not a
+ forced choice. *)
type parsed_args = {
overlays : string list;
+ rite : string option;
format : string option;
from_y : string option;
to_y : string option;
@@ -1618,6 +1825,8 @@ let parse_args argv =
| [] -> 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"
+ | "--rite" :: v :: rest -> go { acc with rite = Some v } rest
+ | [ "--rite" ] -> Error "--rite needs a value (ef or of)"
| "--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
@@ -1661,7 +1870,7 @@ let parse_args argv =
| arg :: rest -> go { acc with positional = arg :: acc.positional } rest
in
go
- { overlays = []; format = None; from_y = None; to_y = None; dtstamp = None; year = None;
+ { overlays = []; rite = None; format = None; from_y = None; to_y = None; dtstamp = None; year = None;
template = None; flavour = None; out = None; prune = false; lang = None; raw = false;
dump = None; check = None; list = false; show = false; sigla_style = None; sigla_book = None;
sigla_tradition = None; positional = [] }
@@ -1689,6 +1898,20 @@ let reject_overlays_for cmd overlays =
exit 2
end
+(* Sibling to [reject_overlays_for]: `--rite` (Task 5) is meaningful only on
+ `day`/`readings` -- the brief's own scope for this task. Every other
+ command either reads no rite-specific data at all (`easter`, `temporal`,
+ `check`, `convert`, `new-overlay`, `lang`, `--help`, `--version`) or has
+ not been widened to a second rite in this task (`rubrics`, `emit`,
+ `table`/`render`, `publish`, `config`) -- accepting the flag there and
+ silently ignoring it would be the exact failure mode [reject_overlays_for]
+ above already refuses. *)
+let reject_rite_for cmd rite =
+ if rite <> None then begin
+ Printf.eprintf "colitur: --rite has no effect on `%s`; refusing rather than ignoring it\n" cmd;
+ exit 2
+ end
+
(* Sibling to [reject_emit_flags_for]/[reject_overlays_for]: `table`/`render`'s
own three flags (Task 9) have no meaning on any other command, so accepting
and silently dropping them would be the same failure mode this project
@@ -2211,9 +2434,10 @@ let () =
| Error msg ->
Printf.eprintf "colitur: %s\n" msg;
usage ()
- | Ok { overlays; format; from_y; to_y; dtstamp; year; template; flavour; out; prune; lang;
+ | Ok { overlays; rite; format; from_y; to_y; dtstamp; year; template; flavour; out; prune; lang;
raw; dump; check; list; show; sigla_style; sigla_book; sigla_tradition; positional } -> (
let reject_emit = reject_emit_flags_for ~format ~from_y ~to_y ~dtstamp in
+ let reject_rite cmd = reject_rite_for cmd rite in
let reject_table = reject_table_flags_for ~year ~template ~flavour in
let reject_publish = reject_publish_flags_for ~out ~prune in
let reject_lang = reject_lang_for ~lang ~raw in
@@ -2244,6 +2468,7 @@ let () =
match positional with
| [ ("-h" | "--help" | "help") ] ->
reject_overlays_for "--help" overlays;
+ reject_rite "--help";
reject_emit "--help";
reject_table "--help";
reject_publish "--help";
@@ -2253,6 +2478,7 @@ let () =
print_help ()
| [ ("-V" | "--version" | "version") ] ->
reject_overlays_for "--version" overlays;
+ reject_rite "--version";
reject_emit "--version";
reject_table "--version";
reject_publish "--version";
@@ -2263,6 +2489,7 @@ let () =
exit 0
| [ "easter"; ys ] ->
reject_overlays_for "easter" overlays;
+ reject_rite "easter";
reject_emit "easter";
reject_table "easter";
reject_publish "easter";
@@ -2272,6 +2499,7 @@ let () =
with_year ys easter_report
| [ "temporal"; ys ] ->
reject_overlays_for "temporal" overlays;
+ reject_rite "temporal";
reject_emit "temporal";
reject_table "temporal";
reject_publish "temporal";
@@ -2281,6 +2509,7 @@ let () =
with_year ys temporal_report
| "check" :: (_ :: _ as files) ->
reject_overlays_for "check" overlays;
+ reject_rite "check";
reject_emit "check";
reject_table "check";
reject_publish "check";
@@ -2290,6 +2519,7 @@ let () =
check_report files
| [ "convert"; path ] ->
reject_overlays_for "convert" overlays;
+ reject_rite "convert";
reject_emit "convert";
reject_table "convert";
reject_publish "convert";
@@ -2299,6 +2529,7 @@ let () =
convert_report path
| [ "new-overlay" ] ->
reject_overlays_for "new-overlay" overlays;
+ reject_rite "new-overlay";
reject_emit "new-overlay";
reject_table "new-overlay";
reject_publish "new-overlay";
@@ -2309,6 +2540,7 @@ let () =
exit 0
| [ "lang" ] -> (
reject_overlays_for "lang" overlays;
+ reject_rite "lang";
reject_emit "lang";
reject_table "lang";
reject_publish "lang";
@@ -2339,6 +2571,7 @@ let () =
config preview is still refused, not silently ignored. *)
reject_table "config";
reject_publish "config";
+ reject_rite "config";
if from_y <> None || to_y <> None || dtstamp <> None then begin
Printf.eprintf
"colitur: --from/--to/--dtstamp have no effect on `config`; refusing rather than ignoring them\n";
@@ -2367,7 +2600,9 @@ let () =
reject_publish "day";
reject_lang_sub "day";
reject_sigla "day";
- with_year ys (day_report ~lang:(resolved_lang ()) ~overlays:effective_overlays)
+ (match resolve_rite rite with
+ | `Ef -> with_year ys (day_report ~lang:(resolved_lang ()) ~overlays:effective_overlays)
+ | `Of -> with_year ys (day_report_of ~lang:(resolved_lang ()) ~overlays:effective_overlays))
| [ "readings"; ys ] ->
reject_emit "readings";
reject_table "readings";
@@ -2378,7 +2613,9 @@ let () =
load_sigla ~raw ~lang_t ~sigla_style_flag:sigla_style ~sigla_book_flag:sigla_book
~sigla_tradition_flag:sigla_tradition ~config
in
- with_year ys (readings_report ~lang:lang_t ~sigla ~overlays:effective_overlays)
+ (match resolve_rite rite with
+ | `Ef -> with_year ys (readings_report ~lang:lang_t ~sigla ~overlays:effective_overlays)
+ | `Of -> with_year ys (readings_report_of ~lang:lang_t ~sigla ~overlays:effective_overlays))
| [ "rubrics"; ys ] ->
(* --overlay accepted, same reasoning as `readings`: an overlay can
change which celebration is observed, hence which Mass formulary
@@ -2391,11 +2628,13 @@ let () =
reject_lang "rubrics";
reject_lang_sub "rubrics";
reject_sigla "rubrics";
+ reject_rite "rubrics";
with_year ys (rubrics_report ~overlays:effective_overlays)
| [ "emit" ] -> (
reject_table "emit";
reject_publish "emit";
reject_lang_sub "emit";
+ reject_rite "emit";
match (match format with Some f -> Some f | None -> Colitur_naming.Config.format config) with
| None ->
Printf.eprintf "colitur: emit requires --format csv|json|sexp|xml|ics\n";
@@ -2419,6 +2658,7 @@ let () =
reject_emit cmd;
reject_publish cmd;
reject_lang_sub cmd;
+ reject_rite cmd;
match (match template with Some t -> Some t | None -> Colitur_naming.Config.template config) with
| None ->
Printf.eprintf "colitur: %s requires --year YEAR and --template FILE\n" cmd;
@@ -2450,6 +2690,7 @@ let () =
reject_table "publish";
reject_format_for "publish" format;
reject_lang_sub "publish";
+ reject_rite "publish";
match out with
| None ->
Printf.eprintf "colitur: publish requires --out DIR\n";
generated by cgit v1.3 (git 2.53.0) at 2026-09-19 10:00:02 +0000