From b39c8187ef1b87eea084e3c3d2226be5cf320dca Mon Sep 17 00:00:00 2001 From: Lukasz Kasprzak Date: Fri, 28 Aug 2026 10:03:27 +0200 Subject: 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. --- bin/main.ml | 234 ++++++++++++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 198 insertions(+), 36 deletions(-) (limited to 'bin') 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 Easter, and the movable feasts anchored to it - colitur temporal [--rite ef|of] + colitur temporal [--rite ef|of] [--pretty] + [--month N | --date YYYY-MM-DD | --today] 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 rubrics the Mass formulary said, one line per day colitur day|readings|rubrics [] [--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] 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"; -- cgit v1.3