diff options
Diffstat (limited to 'bin/main.ml')
| -rw-r--r-- | bin/main.ml | 129 |
1 files changed, 108 insertions, 21 deletions
diff --git a/bin/main.ml b/bin/main.ml index 141f016..06732b3 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -137,17 +137,40 @@ let data_dir () = 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. *) -let load_ef_layer () = +(* [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 Colitur_kernel.Overlay.load Rite_ef.Vocab_ef.rank_of_sexp adjustments_path with - | Error e -> Error (Printf.sprintf "failed to load %s: %s" adjustments_path e) - | Ok overlay -> - let layer, diagnostics = Colitur_kernel.Overlay.apply layer overlay in + 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; @@ -271,8 +294,8 @@ let readings_line (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) Colitur_ 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 () = - match load_ef_layer () with +let load_ef_data ?(user_overlays = []) () = + match load_ef_layer ~user_overlays () with | Error msg -> Error msg | Ok layer -> ( match load_ef_lectionary () with @@ -287,8 +310,8 @@ let load_ef_data () = indexing below (with its own reasoning about civil-vs-liturgical spans) is exactly the part that must not be duplicated and drift. [line] is the only difference between the two commands. *) -let resolved_year_report ~line y = - match load_ef_data () with +let resolved_year_report ~line ~overlays y = + match load_ef_data ~user_overlays:overlays () with | Error msg -> Printf.eprintf "colitur: %s\n" msg; exit 2 @@ -327,8 +350,8 @@ let resolved_year_report ~line y = d := D.add_days !d 1 done -let day_report y = resolved_year_report ~line:day_line y -let readings_report y = resolved_year_report ~line:readings_line 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 (* 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 @@ -355,6 +378,7 @@ usage: colitur temporal <year> the temporal cycle, one line per day 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 -h, --help this help colitur -V, --version print the version and exit @@ -371,6 +395,20 @@ output formats: day stays space-separated; that is why they are separate commands rather than extra columns. +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. + environment: COLITUR_DATA_DIR Read the calendar data from this directory instead of the @@ -403,14 +441,63 @@ let with_year ys f = 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. *) +let parse_args argv = + let rec go overlays positional = function + | [] -> Ok (List.rev overlays, List.rev positional) + | ("--overlay" | "-o") :: path :: rest -> go (path :: overlays) positional rest + | [ ("--overlay" | "-o") ] -> Error "--overlay needs a file path" + (* 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 overlays (arg :: positional) rest + in + go [] [] argv + +(* [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 + let () = - match Sys.argv with - | [| _; ("-h" | "--help" | "help") |] -> print_help () - | [| _; ("-V" | "--version" | "version") |] -> - print_endline version; - exit 0 - | [| _; "easter"; ys |] -> with_year ys easter_report - | [| _; "temporal"; ys |] -> with_year ys temporal_report - | [| _; "day"; ys |] -> with_year ys day_report - | [| _; "readings"; ys |] -> with_year ys readings_report - | _ -> usage () + match parse_args (List.tl (Array.to_list Sys.argv)) with + | Error msg -> + Printf.eprintf "colitur: %s\n" msg; + usage () + | Ok (overlays, positional) -> ( + match positional with + | [ ("-h" | "--help" | "help") ] -> + reject_overlays_for "--help" overlays; + print_help () + | [ ("-V" | "--version" | "version") ] -> + reject_overlays_for "--version" overlays; + print_endline version; + exit 0 + | [ "easter"; ys ] -> + reject_overlays_for "easter" overlays; + with_year ys easter_report + | [ "temporal"; ys ] -> + reject_overlays_for "temporal" overlays; + with_year ys temporal_report + | [ "day"; ys ] -> with_year ys (day_report ~overlays) + | [ "readings"; ys ] -> with_year ys (readings_report ~overlays) + | _ -> usage ()) |