diff options
| author | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-28 10:03:27 +0200 |
|---|---|---|
| committer | Lukasz Kasprzak <lukas@labunix.xyz> | 2026-08-28 10:03:27 +0200 |
| commit | b39c8187ef1b87eea084e3c3d2226be5cf320dca (patch) | |
| tree | a12a09c8c4dfd8e69442e616b162d9dcc2dfc6a5 /bin | |
| parent | f1d562a3a4d53a707385334ab553b8a6cad36b1b (diff) | |
| download | colitur-b39c8187ef1b87eea084e3c3d2226be5cf320dca.tar.gz colitur-b39c8187ef1b87eea084e3c3d2226be5cf320dca.zip | |
feat(cli): --month, --date and --today narrow a report
--pretty made a report readable and, in the same stroke, ungreppable: a box
spans seven lines, so `grep 2026-03-` returns fragments of March rather than
March. The nearest working equivalent is a paragraph-mode awk incantation that
depends on the boxes happening to be blank-line separated -- knowledge no
reader should need to select a month.
The three flags are ALTERNATIVES, not a stack. Naming two exits 2 rather than
letting one quietly win, the same discipline the positional year and --year
already follow, and the same reason this program refuses a flag it cannot
honour instead of accepting and ignoring it.
--date and --today CARRY a year, so the year becomes optional on those two and
required only after the window has had its say: `colitur day --today` is a
complete command while `colitur day` still is not. A year named alongside them
must agree. The disagreement message names the flag rather than printing two
bare numbers, because with --today the second year appears nowhere on the
command line for the reader to trace.
temporal refuses --year yet accepts --date/--today including as its year
source. That is not a back door to the refused spelling: --year is a second
spelling of the positional year, which temporal deliberately does not offer,
whereas --date selects a DAY and merely happens to determine which year
contains it.
The window is a predicate over an ISO date STRING rather than over a Date.t,
because the two report shapes reach it differently -- resolved days carry a
Date.t, temporal_report carries a flat Record whose date is already text --
and one shared test is one implementation rather than two that can drift.
Accepted by day, readings, rubrics and temporal; refused by easter, emit,
table, render, publish, check, convert, lang, config and new-overlay.
--pretty had shipped undocumented in both --help and colitur(1). Both now
carry it, alongside the new narrowing section; the man page's awk example is
shown precisely so the flag that replaces it is justified.
Default output is byte-identical to 1.1.0 across seven years, five commands
and both rites, and across all five emit formats and the shipped templates.
Diffstat (limited to 'bin')
| -rw-r--r-- | bin/main.ml | 234 |
1 files changed, 198 insertions, 36 deletions
diff --git a/bin/main.ml b/bin/main.ml index 76c19e1..8b514b0 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -3,6 +3,27 @@ module C = Colitur_kernel.Computus let fmt d = Printf.sprintf "%04d-%02d-%02d" (D.year d) (D.month d) (D.day d) +(* ------------------------------------------------------------------ *) +(* Narrowing a report to part of a year. + * + * The window is a predicate over an ISO date STRING rather than over a + * Date.t, because the report shapes reach it differently -- resolved days + * carry a Date.t, [temporal_report] carries a flat Record whose date is + * already text -- and one shared string test is one implementation rather + * than two that can drift apart. + * + * Independent of --pretty. Narrowing is useful in the default format too, + * and more so in --pretty, whose boxes span several lines and so cannot be + * grepped line-wise at all. *) + +type day_window = Whole_year | In_month of int | On_date of string + +let in_window w iso = + match w with + | Whole_year -> true + | In_month n -> String.length iso >= 7 && int_of_string_opt (String.sub iso 5 2) = Some n + | On_date d -> iso = d + let easter_report y = [ ("easter", C.gregorian_easter y); ("ash-wednesday", C.ash_wednesday y); @@ -56,7 +77,7 @@ let pretty_day_box ~date ~dow ~colour ~rank ~season ~week ~name ~comms ~extra = which is exactly the "not distinct enough" this format exists to fix. *) print_newline () -let temporal_report ~rite ~pretty y = +let temporal_report ~rite ~pretty ~window y = let jan1 = match D.make ~year:y ~month:1 ~day:1 with | Ok t -> t | Error e -> failwith e @@ -81,6 +102,7 @@ let temporal_report ~rite ~pretty y = let d = ref jan1 in while D.compare !d dec31 <= 0 do let r = record_of_day !d in + if in_window window r.Colitur_kernel.Record.date then (if pretty then (* The temporal cycle carries no sanctoral, so a temporal box has no commemorations and no proper name -- here the slug IS the identity. @@ -801,8 +823,64 @@ let resolved_year_days ~overlays y = done; List.rev !acc -let resolved_year_report ~line ~overlays y = - List.iter line (resolved_year_days ~overlays y) +(* [window_of] validates the three narrowing flags and reports the year they + imply, if any. Kept beside [resolved_year_report] rather than beside + {!in_window} at the top because it needs [D.of_iso8601] and [Unix]. *) + +let window_of cmd ~month ~date_sel ~today ~year_hint = + let named = + (match month with Some _ -> [ "--month" ] | None -> []) + @ (match date_sel with Some _ -> [ "--date" ] | None -> []) + @ (if today then [ "--today" ] else []) + in + (match named with + | _ :: _ :: _ -> + Printf.eprintf "colitur: %s: %s are alternatives; name one\n" cmd + (String.concat " and " named); + exit 2 + | _ -> ()); + (* Names the flag, not just the two numbers: "year 2027 and 2026 disagree" + leaves the reader to work out where the second year came from, and with + --today it is nowhere on the command line at all. *) + let check_year ~src y = + match year_hint with + | Some h when h <> y -> + Printf.eprintf "colitur: %s: year %s and %s (%s) disagree\n" cmd h src y; + exit 2 + | _ -> () + in + match (month, date_sel, today) with + | None, None, false -> (Whole_year, year_hint) + | Some m, _, _ -> ( + match int_of_string_opt m with + | Some n when n >= 1 && n <= 12 -> (In_month n, year_hint) + | _ -> + Printf.eprintf "colitur: %s: --month wants a number 1-12, got %s\n" cmd m; + exit 2) + | _, Some d, _ -> + (* Parsed rather than pattern-matched on length: "2026-3-1" and + "20260301" both look plausible to a person and neither is what + Date.of_iso8601 accepts, so let it say so. *) + (match D.of_iso8601 d with + | Ok t -> + let y = string_of_int (D.year t) in + check_year ~src:("--date " ^ d) y; + (On_date (D.to_iso8601 t), Some y) + | Error e -> + Printf.eprintf "colitur: %s: --date %s: %s\n" cmd d e; + exit 2) + | _, _, true -> + let tm = Unix.localtime (Unix.time ()) in + let y = tm.Unix.tm_year + 1900 in + let ds = Printf.sprintf "%04d-%02d-%02d" y (tm.Unix.tm_mon + 1) tm.Unix.tm_mday in + check_year ~src:"--today" (string_of_int y); + (On_date ds, Some (string_of_int y)) + +let resolved_year_report ~line ~window ~overlays y = + List.iter + (fun d -> + if in_window window (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) then line d) + (resolved_year_days ~overlays y) (* ---------------------------------------------------------------------- *) @@ -833,8 +911,8 @@ let day_line_pretty ~lang (d : (Rite_ef.Vocab_ef.season, Rite_ef.Vocab_ef.rank) if cn = cs then cs else cn) d.Colitur_kernel.Liturgical_day.commemorations) -let day_report ~lang ~pretty ~overlays y = - resolved_year_report +let day_report ~lang ~pretty ~window ~overlays y = + resolved_year_report ~window ~line:(if pretty then day_line_pretty ~lang else day_line ~lang) ~overlays y let readings_pretty_row ~date ~dow ~name ~first ~second ~gospel = @@ -877,8 +955,8 @@ let readings_line_pretty ~lang ~sigla (d : (Rite_ef.Vocab_ef.season, Rite_ef.Voc ~second:(part_ref Colitur_kernel.Citation.Second) ~gospel:(part_ref Colitur_kernel.Citation.Gospel) -let readings_report ~lang ~sigla ~pretty ~overlays y = - resolved_year_report +let readings_report ~lang ~sigla ~pretty ~window ~overlays y = + resolved_year_report ~window ~line:(if pretty then readings_line_pretty ~lang ~sigla else readings_line ~lang ~sigla) ~overlays y @@ -978,7 +1056,11 @@ let readings_line_of ~lang ~sigla (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 resolved_of_year_report ~line ~window ~overlays y = + List.iter + (fun d -> + if in_window window (D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) then line d) + (resolved_of_year_days ~overlays y) let day_line_of_pretty ~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 @@ -998,8 +1080,8 @@ let day_line_of_pretty ~lang (d : (Rite_of.Vocab_of.season, Rite_of.Vocab_of.ran ~week:(match t.Colitur_kernel.Temporal.week with Some n -> Some (string_of_int n) | None -> None) ~name -let day_report_of ~lang ~pretty ~overlays y = - resolved_of_year_report +let day_report_of ~lang ~pretty ~window ~overlays y = + resolved_of_year_report ~window ~line:(if pretty then day_line_of_pretty ~lang else day_line_of ~lang) ~overlays y let readings_line_of_pretty ~lang ~sigla (d : (Rite_of.Vocab_of.season, Rite_of.Vocab_of.rank) Colitur_kernel.Liturgical_day.t) = @@ -1021,8 +1103,8 @@ let readings_line_of_pretty ~lang ~sigla (d : (Rite_of.Vocab_of.season, Rite_of. ~second:(part_ref Colitur_kernel.Citation.Second) ~gospel:(part_ref Colitur_kernel.Citation.Gospel) -let readings_report_of ~lang ~sigla ~pretty ~overlays y = - resolved_of_year_report +let readings_report_of ~lang ~sigla ~pretty ~window ~overlays y = + resolved_of_year_report ~window ~line:(if pretty then readings_line_of_pretty ~lang ~sigla else readings_line_of ~lang ~sigla) ~overlays y @@ -1068,10 +1150,10 @@ let rubrics_line_pretty (d : (_, _) Colitur_kernel.Liturgical_day.t) = | Some pf -> Colitur_kernel.Preface.to_string pf | None -> "-") -let rubrics_report ~rite ~lang ~pretty ~overlays y = +let rubrics_report ~rite ~lang ~pretty ~window ~overlays y = match rite with - | `Ef -> resolved_year_report ~line:(if pretty then rubrics_line_pretty else rubrics_line ~lang) ~overlays y - | `Of -> resolved_of_year_report ~line:(if pretty then rubrics_line_pretty else rubrics_line ~lang) ~overlays y + | `Ef -> resolved_year_report ~window ~line:(if pretty then rubrics_line_pretty else rubrics_line ~lang) ~overlays y + | `Of -> resolved_of_year_report ~window ~line:(if pretty then rubrics_line_pretty else rubrics_line ~lang) ~overlays y (* Fix 1 (cli-flags-report, 2026-08-27): shared by [table_report] and [publish_report], which each need only the rendered [Template.value] -- @@ -1909,17 +1991,20 @@ let help_text = usage: colitur easter <year> Easter, and the movable feasts anchored to it - colitur temporal <year> [--rite ef|of] + colitur temporal <year> [--rite ef|of] [--pretty] + [--month N | --date YYYY-MM-DD | --today] 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 rubrics <year> the Mass formulary said, one line per day colitur day|readings|rubrics [<year>] [--year Y] [--rite ef|of] - [--overlay FILE ...] [--lang CODE|FILE] [--raw] + [--overlay FILE ...] [--lang CODE|FILE] [--raw] [--pretty] + [--month N | --date YYYY-MM-DD | --today] <year> may be given positionally or as --year (both, if they agree); rubrics's own --lang/--raw govern its trailing formulary-name column, --sigla-* stay refused there (see - "naming" below) + "naming" below); --pretty and the narrowing flags are described + under "reading it yourself" below colitur emit --format csv|json|sexp|xml|ics --from Y --to Y [--rite ef|of] [--overlay FILE ...] [--dtstamp S] [--lang CODE|FILE] [--raw] render a resolved year range through one of five emitters @@ -1953,6 +2038,28 @@ RANGE instead (--from Y --to Y, inclusive) and do not also accept a single run, and a third, single-year spelling on top of the range form would add parsing surface for no real workflow gain. +reading it yourself: + --pretty lay the rows out as boxes for a person rather + than for awk; accepted on day/readings/rubrics/ + temporal, refused elsewhere. The box format is + for eyes only and may change between releases -- + parse the default rows, which will not. + --month N print only that month, 1..12 + --date YYYY-MM-DD print only that day + --today print only today + + The three narrowing flags are ALTERNATIVES -- naming two is an error, not a + silent win for one. They work in the default format too, and matter most + under --pretty, whose boxes span several lines and so survive no line-wise + grep at all. + + --date and --today NAME a year, so on those two the year may be omitted: + `colitur day --today` is complete. Give one anyway and it must agree, the + same rule a positional year and --year already follow. --month names no + year, so it still needs one. On `temporal`, which refuses --year, --date + and --today may still supply the year: they select a day and merely happen + to determine the year, which --year does not do. + output formats: day date weekday season week slug rank colour [+commemoration ...] [name] 2026-04-05 sunday paschaltide 1 ef-easter-sunday class-1 white @@ -2324,6 +2431,25 @@ let resolve_single_year cmd ~positional ~flag = Printf.eprintf "colitur: %s requires a year (positional or --year)\n" cmd; exit 2 +(* A window may CARRY a year: --date states one outright, --today means this + one. So the year is resolved in two steps -- what the words said, then + what the window implies -- and is required only after the window has had + its say. `colitur day --today` is thereby a complete command while + `colitur day` still is not, and a positional year that CONTRADICTS the + window is refused by [window_of] rather than silently overridden. *) +let resolve_year_and_window cmd ~positional ~flag ~month ~date_sel ~today = + let hint = + match (positional, flag) with + | None, None -> None + | p, f -> Some (resolve_single_year cmd ~positional:p ~flag:f) + in + match window_of cmd ~month ~date_sel ~today ~year_hint:hint with + | w, Some y -> (y, w) + | _, None -> + Printf.eprintf + "colitur: %s requires a year (positional, --year, --date or --today)\n" cmd; + 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 @@ -2379,6 +2505,9 @@ type parsed_args = { lang : string option; raw : bool; pretty : bool; + month : string option; + date_sel : string option; + today : bool; dump : string option; check : string option; list : bool; @@ -2417,6 +2546,11 @@ let parse_args argv = | [ "--lang" ] -> Error "--lang needs a language code or file path" | "--raw" :: rest -> go { acc with raw = true } rest | "--pretty" :: rest -> go { acc with pretty = true } rest + | "--month" :: v :: rest -> go { acc with month = Some v } rest + | [ "--month" ] -> Error "--month needs a number 1-12" + | "--date" :: v :: rest -> go { acc with date_sel = Some v } rest + | [ "--date" ] -> Error "--date needs a date, YYYY-MM-DD" + | "--today" :: rest -> go { acc with today = true } rest | "--dump" :: v :: rest -> go { acc with dump = Some v } rest | [ "--dump" ] -> Error "--dump needs a language code" | "--check" :: v :: rest -> go { acc with check = Some v } rest @@ -2441,7 +2575,7 @@ let parse_args argv = in go { 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; pretty = false; + template = None; flavour = None; out = None; prune = false; lang = None; raw = false; pretty = false; month = None; date_sel = None; today = false; dump = None; check = None; list = false; show = false; sigla_style = None; sigla_book = None; sigla_tradition = None; positional = [] } argv @@ -3074,7 +3208,8 @@ let () = Printf.eprintf "colitur: %s\n" msg; usage () | Ok { overlays; rite; format; from_y; to_y; dtstamp; year; template; flavour; out; prune; lang; - raw; pretty; dump; check; list; show; sigla_style; sigla_book; sigla_tradition; + raw; pretty; month; date_sel; today; 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 @@ -3083,6 +3218,13 @@ let () = let reject_publish = reject_publish_flags_for ~out ~prune in let reject_lang = reject_lang_for ~lang ~raw in let reject_pretty = reject_pretty_for ~pretty in + let reject_window cmd = + if month <> None || date_sel <> None || today then begin + Printf.eprintf + "colitur: --month/--date/--today have no effect on `%s`; refusing rather than ignoring them\n" cmd; + exit 2 + end + in let reject_lang_sub = reject_lang_subcommand_flags_for ~dump ~check ~list ~show in let reject_sigla = reject_sigla_for ~sigla_style ~sigla_book ~sigla_tradition in (* Loaded once, unconditionally: a config file the user wrote and @@ -3152,6 +3294,7 @@ let () = print_endline version; exit 0 | [ "easter"; ys ] -> + reject_window "easter"; reject_overlays_for "easter" overlays; reject_rite "easter"; reject_emit "easter"; @@ -3162,7 +3305,13 @@ let () = reject_pretty "easter"; reject_sigla "easter"; with_year ys easter_report - | [ "temporal"; ys ] -> + (* `temporal` refuses [--year] ([reject_table] below, Fix 3) yet takes + the narrowing flags, so its positional year is now optional in + exactly one way: when [--date]/[--today] NAME the year. That is not + a back door to the refused spelling -- [--year] still exits before + the resolver runs -- because [--date] selects a day and merely + happens to determine the year, which [--year] does not do. *) + | "temporal" :: rest when List.length rest <= 1 -> reject_overlays_for "temporal" overlays; reject_emit "temporal"; reject_table "temporal"; @@ -3170,8 +3319,14 @@ let () = reject_lang "temporal"; reject_lang_sub "temporal"; reject_sigla "temporal"; - with_year ys (temporal_report ~rite:(resolve_rite rite) ~pretty) + let ys, window = + resolve_year_and_window "temporal" + ~positional:(match rest with [ ys ] -> Some ys | _ -> None) + ~flag:None ~month ~date_sel ~today + in + with_year ys (temporal_report ~rite:(resolve_rite rite) ~pretty ~window) | "check" :: (_ :: _ as files) -> + reject_window "check"; reject_overlays_for "check" overlays; reject_rite "check"; reject_emit "check"; @@ -3183,6 +3338,7 @@ let () = reject_sigla "check"; check_report files | [ "convert"; path ] -> + reject_window "convert"; reject_overlays_for "convert" overlays; reject_rite "convert"; reject_emit "convert"; @@ -3194,6 +3350,7 @@ let () = reject_sigla "convert"; convert_report path | [ "new-overlay" ] -> + reject_window "new-overlay"; reject_overlays_for "new-overlay" overlays; reject_rite "new-overlay"; reject_emit "new-overlay"; @@ -3206,6 +3363,7 @@ let () = print_string new_overlay_template; exit 0 | [ "lang" ] -> ( + reject_window "lang"; reject_overlays_for "lang" overlays; reject_rite "lang"; reject_emit "lang"; @@ -3228,6 +3386,7 @@ let () = Printf.eprintf "colitur: lang takes only one of --list, --dump CODE or --check FILE\n"; exit 2) | [ "config" ] -> + reject_window "config"; (* Unlike every other subcommand's own rejector, `config --show` deliberately ACCEPTS --lang/--template/--format/--overlay: they are the very settings it previews the resolution of (so @@ -3275,23 +3434,23 @@ let () = reject_publish "day"; reject_lang_sub "day"; reject_sigla "day"; - let ys = - resolve_single_year "day" + let ys, window = + resolve_year_and_window "day" ~positional:(match rest with [ ys ] -> Some ys | _ -> None) - ~flag:year + ~flag:year ~month ~date_sel ~today in (match resolve_rite rite with - | `Ef -> with_year ys (day_report ~lang:(resolved_lang ()) ~pretty ~overlays:effective_overlays) - | `Of -> with_year ys (day_report_of ~lang:(resolved_lang ()) ~pretty ~overlays:effective_overlays)) + | `Ef -> with_year ys (day_report ~lang:(resolved_lang ()) ~pretty ~window ~overlays:effective_overlays) + | `Of -> with_year ys (day_report_of ~lang:(resolved_lang ()) ~pretty ~window ~overlays:effective_overlays)) | "readings" :: rest when List.length rest <= 1 -> reject_emit "readings"; reject_template_flavour "readings"; reject_publish "readings"; reject_lang_sub "readings"; - let ys = - resolve_single_year "readings" + let ys, window = + resolve_year_and_window "readings" ~positional:(match rest with [ ys ] -> Some ys | _ -> None) - ~flag:year + ~flag:year ~month ~date_sel ~today in let lang_t = resolved_lang () in let sigla = @@ -3299,8 +3458,8 @@ let () = ~sigla_tradition_flag:sigla_tradition ~config in (match resolve_rite rite with - | `Ef -> with_year ys (readings_report ~lang:lang_t ~sigla ~pretty ~overlays:effective_overlays) - | `Of -> with_year ys (readings_report_of ~lang:lang_t ~sigla ~pretty ~overlays:effective_overlays)) + | `Ef -> with_year ys (readings_report ~lang:lang_t ~sigla ~pretty ~window ~overlays:effective_overlays) + | `Of -> with_year ys (readings_report_of ~lang:lang_t ~sigla ~pretty ~window ~overlays:effective_overlays)) | "rubrics" :: rest when List.length rest <= 1 -> (* --overlay accepted, same reasoning as `readings`: an overlay can change which celebration is observed, hence which Mass formulary @@ -3330,13 +3489,14 @@ let () = reject_lang "rubrics"; reject_lang_sub "rubrics"; reject_sigla "rubrics"; - let ys = - resolve_single_year "rubrics" + let ys, window = + resolve_year_and_window "rubrics" ~positional:(match rest with [ ys ] -> Some ys | _ -> None) - ~flag:year + ~flag:year ~month ~date_sel ~today in - with_year ys (rubrics_report ~rite:(resolve_rite rite) ~lang:(rubrics_lang ()) ~pretty ~overlays:effective_overlays) + with_year ys (rubrics_report ~rite:(resolve_rite rite) ~lang:(rubrics_lang ()) ~pretty ~window ~overlays:effective_overlays) | [ "emit" ] -> ( + reject_window "emit"; reject_table "emit"; reject_publish "emit"; reject_lang_sub "emit"; @@ -3365,6 +3525,7 @@ let () = [cmd] (year from [--year], as before `table`/`render` accepted any year at all) or [cmd; ys] (year positional, NEW). *) | (("table" | "render") as cmd) :: rest when List.length rest <= 1 -> ( + reject_window cmd; reject_emit cmd; reject_publish cmd; reject_lang_sub cmd; @@ -3394,6 +3555,7 @@ let () = | None -> Colitur_naming.Config.flavour config) ~overlays:effective_overlays y))) | [ "publish" ] -> ( + reject_window "publish"; reject_table "publish"; reject_format_for "publish" format; reject_lang_sub "publish"; |
