diff options
Diffstat (limited to 'bin/main.ml')
| -rw-r--r-- | bin/main.ml | 269 |
1 files changed, 247 insertions, 22 deletions
diff --git a/bin/main.ml b/bin/main.ml index 49f06e5..7c6427b 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -29,7 +29,7 @@ let easter_report y = same claim. [Colitur_kernel.Record.of_temporal] was already fully polymorphic over [('s, 'r)] (record.mli), so this is the same plumbing already done for `day`/`readings`/etc, not new library work. *) -let temporal_report ~rite y = +let temporal_report ~rite ~pretty y = let jan1 = match D.make ~year:y ~month:1 ~day:1 with | Ok t -> t | Error e -> failwith e @@ -54,10 +54,28 @@ let temporal_report ~rite y = let d = ref jan1 in while D.compare !d dec31 <= 0 do let r = record_of_day !d 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; + (if pretty then + (* The temporal cycle has no sanctoral, so there is never a + commemoration to indent -- same row shape as `day --pretty`, minus + that. Shown here from the flat Record rather than a Liturgical_day + because that is all this report ever had. *) + Printf.printf "%s %s %s%s %s%s\n" + (Pretty.pad Pretty.w_date r.Colitur_kernel.Record.date) + (Pretty.pad Pretty.w_dow + (let w = r.Colitur_kernel.Record.weekday in + String.sub w 0 (min 3 (String.length w)))) + (Pretty.swatch r.Colitur_kernel.Record.colour) + (Printf.sprintf " %s" (Pretty.pad Pretty.w_rank r.Colitur_kernel.Record.rank)) + (Pretty.pad Pretty.w_season + (match r.Colitur_kernel.Record.week with + | "" -> r.Colitur_kernel.Record.season + | w -> r.Colitur_kernel.Record.season ^ " " ^ w)) + r.Colitur_kernel.Record.slug + else + 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 @@ -764,9 +782,114 @@ let resolved_year_days ~overlays y = let resolved_year_report ~line ~overlays y = List.iter line (resolved_year_days ~overlays y) -let day_report ~lang ~overlays y = resolved_year_report ~line:(day_line ~lang) ~overlays y -let readings_report ~lang ~sigla ~overlays y = - resolved_year_report ~line:(readings_line ~lang ~sigla) ~overlays y + +(* ---------------------------------------------------------------------- *) +(* --pretty: the same days, laid out for a person rather than for awk. + * + * These mirror the plain formatters above one for one and share their data; + * they do NOT recompute anything. The plain output stays byte-identical -- + * see bin/pretty.ml's own note on why this format is free to change while + * every other one is a contract. *) + +let pretty_day_generic ~date ~dow ~colour ~rank ~season ~week ~name ~comms = + let season_col = + match week with + | Some w -> Printf.sprintf "%s %s" season w + | None -> season + in + (* The prefix is built, then MEASURED, rather than its width being assumed + from the column constants. Those constants are a minimum, not a maximum + -- a season name longer than its column (the Latin "Tempus per annum ante + Septuagesimam" is 35 against 34) pushes everything after it right, and an + indent computed from the constants would then sit under the wrong column + on exactly the rows that have something to indent. *) + let prefix = + Printf.sprintf "%s %s " (Pretty.pad Pretty.w_date date) + (Pretty.pad Pretty.w_dow (String.sub dow 0 (min 3 (String.length dow)))) + in + let mid = + Printf.sprintf " %s %s" + (Pretty.pad Pretty.w_rank rank) + (Pretty.pad Pretty.w_season season_col) + in + Printf.printf "%s%s%s%s\n" prefix (Pretty.swatch colour) mid name; + (* Commemorations take their own indented line rather than a suffix: the EF + admits up to three, and appending them runs the row past any sensible + terminal width on precisely the days worth reading. The swatch counts as + one display column however it was rendered. *) + let indent = Pretty.utf8_len prefix + 1 + Pretty.utf8_len mid in + List.iter + (fun c -> Printf.printf "%s%s\n" (String.make indent ' ') (Pretty.dim ("+ " ^ c))) + comms + +let day_line_pretty ~lang (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 slug_s = Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug in + let name = Colitur_naming.Lang.celebration lang slug_s in + pretty_day_generic + ~date:(D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + ~dow:(D.weekday_to_string t.Colitur_kernel.Temporal.weekday) + ~colour:(Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour) + ~rank:(Colitur_naming.Lang.rank lang (Rite_ef.Vocab_ef.rank_to_string cel.Colitur_kernel.Celebration.rank)) + ~season:(Colitur_naming.Lang.season lang (Rite_ef.Vocab_ef.season_to_string t.Colitur_kernel.Temporal.season)) + ~week:(match t.Colitur_kernel.Temporal.week with Some n -> Some (string_of_int n) | None -> None) + ~name:(if name = slug_s then slug_s else name) + ~comms:(List.map + (fun (c, _) -> + let cs = Colitur_kernel.Slug.to_string c.Colitur_kernel.Celebration.slug in + let cn = Colitur_naming.Lang.celebration lang cs in + if cn = cs then cs else cn) + d.Colitur_kernel.Liturgical_day.commemorations) + +let day_report ~lang ~pretty ~overlays y = + resolved_year_report + ~line:(if pretty then day_line_pretty ~lang else day_line ~lang) + ~overlays y +let readings_pretty_row ~date ~dow ~name ~first ~second ~gospel = + Printf.printf "%s %s %s\n" + (Pretty.pad Pretty.w_date date) + (Pretty.pad Pretty.w_dow (String.sub dow 0 (min 3 (String.length dow)))) + name; + let show label v = + if v <> "" && v <> "-" then + Printf.printf "%s%s %s\n" + (String.make (Pretty.w_date + Pretty.w_dow + 5) ' ') + (Pretty.dim (Pretty.pad 8 label)) v + in + (* Labelled and stacked rather than pipe-separated. A citation is what a + person came here to read, and "Isai 63:16b-17, 19b; 64:2-7" is hard to + find in a row of three when the separators are bars. The OF's second + reading simply does not print on the days that have none, which is most + of them. *) + show "First" first; + show "Second" second; + show "Gospel" gospel + +let readings_line_pretty ~lang ~sigla (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 -> 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 n = Colitur_naming.Lang.celebration lang slug_s in + readings_pretty_row + ~date:(D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + ~dow:(D.weekday_to_string d.Colitur_kernel.Liturgical_day.temporal.Colitur_kernel.Temporal.weekday) + ~name:(if n = slug_s then slug_s else n) + ~first:(part_ref Colitur_kernel.Citation.First) + ~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 + ~line:(if pretty then readings_line_pretty ~lang ~sigla else readings_line ~lang ~sigla) + ~overlays y (* Fix wave I1 (final-review.md, 2026-08-25-colitur-of-phases-3-5): unlike EF's [Celebration.names] (almost always empty -- lang/la.ini is EF's own @@ -866,19 +989,96 @@ let readings_line_of ~lang ~sigla 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 +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 + let cel = d.Colitur_kernel.Liturgical_day.observed in + let slug_s = Colitur_kernel.Slug.to_string cel.Colitur_kernel.Celebration.slug in + (* Same preference [day_line_of] itself uses: the shipped OF data's own + verified per-slug name first, the generic lang table only as a fallback. + Reusing [observed_name_of] rather than restating it keeps the two row + shapes from drifting apart. *) + let name = observed_name_of ~lang cel slug_s in + pretty_day_generic + ~date:(D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + ~dow:(D.weekday_to_string t.Colitur_kernel.Temporal.weekday) + ~colour:(Colitur_kernel.Colour.to_string cel.Colitur_kernel.Celebration.colour) + ~rank:(Colitur_naming.Lang.rank lang (Rite_of.Vocab_of.rank_to_string cel.Colitur_kernel.Celebration.rank)) + ~season:(Colitur_naming.Lang.season lang (Rite_of.Vocab_of.season_to_string t.Colitur_kernel.Temporal.season)) + ~week:(match t.Colitur_kernel.Temporal.week with Some n -> Some (string_of_int n) | None -> None) + ~name ~comms:[] + +let day_report_of ~lang ~pretty ~overlays y = + resolved_of_year_report + ~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) = + 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 + readings_pretty_row + ~date:(D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + ~dow:(D.weekday_to_string d.Colitur_kernel.Liturgical_day.temporal.Colitur_kernel.Temporal.weekday) + ~name:(observed_name_of ~lang cel slug_s) + ~first:(part_ref Colitur_kernel.Citation.First) + ~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 + ~line:(if pretty then readings_line_of_pretty ~lang ~sigla else readings_line_of ~lang ~sigla) + ~overlays y (* Fix 1 (cli-flags-report, 2026-08-27): `rubrics` widened to `--rite of`. [rubrics_line] above needs no OF twin (it type-checks polymorphic over [('s, 'r)] already -- see its own header), so dispatching here is only ever about which resolver walks the year, never about which printer prints it. *) -let rubrics_report ~rite ~lang ~overlays y = + +(* --pretty for `readings` and `rubrics`. Both keep the same one-row-per-day + shape as `day --pretty`, so the four commands scan alike; only the columns + after the date differ, because what they are FOR differs. *) + +let rubrics_pretty_row ~date ~said ~via ~creed ~gloria ~preface = + let tick b = if b then "yes" else Pretty.dim "no" in + Printf.printf "%s %s %s %s %s %s\n" + (Pretty.pad Pretty.w_date date) + (Pretty.pad 34 said) + (Pretty.pad 10 via) + (Pretty.pad 8 ("Creed " ^ tick creed)) + (Pretty.pad 9 ("Gloria " ^ tick gloria)) + preface + + +let rubrics_line_pretty (d : (_, _) Colitur_kernel.Liturgical_day.t) = + let said, via = + match d.Colitur_kernel.Liturgical_day.formulary with + | Some f -> + ((match f.Colitur_kernel.Mass_formulary.said with + | Some sl -> Colitur_kernel.Slug.to_string sl + | None -> "-"), + Colitur_kernel.Mass_formulary.source_to_string f.Colitur_kernel.Mass_formulary.via) + | None -> ("-", "-") + in + rubrics_pretty_row + ~date:(D.to_iso8601 d.Colitur_kernel.Liturgical_day.date) + ~said ~via + ~creed:d.Colitur_kernel.Liturgical_day.creed + ~gloria:d.Colitur_kernel.Liturgical_day.gloria + ~preface:(match d.Colitur_kernel.Liturgical_day.preface with + | Some pf -> Colitur_kernel.Preface.to_string pf + | None -> "-") + +let rubrics_report ~rite ~lang ~pretty ~overlays y = match rite with - | `Ef -> resolved_year_report ~line:(rubrics_line ~lang) ~overlays y - | `Of -> resolved_of_year_report ~line:(rubrics_line ~lang) ~overlays y + | `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 (* Fix 1 (cli-flags-report, 2026-08-27): shared by [table_report] and [publish_report], which each need only the rendered [Template.value] -- @@ -2185,6 +2385,7 @@ type parsed_args = { prune : bool; lang : string option; raw : bool; + pretty : bool; dump : string option; check : string option; list : bool; @@ -2222,6 +2423,7 @@ let parse_args argv = | "--lang" :: v :: rest -> go { acc with lang = Some v } rest | [ "--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 | "--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 @@ -2246,7 +2448,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; + template = None; flavour = None; out = None; prune = false; lang = None; raw = false; pretty = false; dump = None; check = None; list = false; show = false; sigla_style = None; sigla_book = None; sigla_tradition = None; positional = [] } argv @@ -2382,6 +2584,20 @@ let reject_publish_flags_for cmd ~out ~prune = `check`/`convert`/`new-overlay` (operate on overlay files, not a rendered calendar), or `lang`/`config` themselves (which take their OWN flags, `--dump`/`--check`/`--list`/`--show`, disjoint from these). *) +(* Sibling to [reject_lang_for] and the rest: --pretty is terminal + presentation for the four commands that print one row per day. `emit`, + `table`/`render` and `publish` already choose their own shape through + --format and --template, so prettifying them would compete with the + template engine rather than complement it; `easter` prints six key/value + lines, not a day grid. Accepting the flag there and quietly doing nothing + is the failure mode this program refuses everywhere else. *) +let reject_pretty_for cmd ~pretty = + if pretty then begin + Printf.eprintf + "colitur: --pretty has no effect on `%s`; refusing rather than ignoring it\n" cmd; + exit 2 + end + let reject_lang_for cmd ~lang ~raw = if lang <> None || raw then begin Printf.eprintf "colitur: --lang/--raw have no effect on `%s`; refusing rather than ignoring them\n" cmd; @@ -2865,13 +3081,15 @@ let () = Printf.eprintf "colitur: %s\n" msg; usage () | 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 } -> ( + raw; pretty; 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_template_flavour cmd = reject_template_flavour_for cmd ~template ~flavour in 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_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 @@ -2948,6 +3166,7 @@ let () = reject_publish "easter"; reject_lang "easter"; reject_lang_sub "easter"; + reject_pretty "easter"; reject_sigla "easter"; with_year ys easter_report | [ "temporal"; ys ] -> @@ -2958,7 +3177,7 @@ let () = reject_lang "temporal"; reject_lang_sub "temporal"; reject_sigla "temporal"; - with_year ys (temporal_report ~rite:(resolve_rite rite)) + with_year ys (temporal_report ~rite:(resolve_rite rite) ~pretty) | "check" :: (_ :: _ as files) -> reject_overlays_for "check" overlays; reject_rite "check"; @@ -2967,6 +3186,7 @@ let () = reject_publish "check"; reject_lang "check"; reject_lang_sub "check"; + reject_pretty "check"; reject_sigla "check"; check_report files | [ "convert"; path ] -> @@ -2977,6 +3197,7 @@ let () = reject_publish "convert"; reject_lang "convert"; reject_lang_sub "convert"; + reject_pretty "convert"; reject_sigla "convert"; convert_report path | [ "new-overlay" ] -> @@ -2987,6 +3208,7 @@ let () = reject_publish "new-overlay"; reject_lang "new-overlay"; reject_lang_sub "new-overlay"; + reject_pretty "new-overlay"; reject_sigla "new-overlay"; print_string new_overlay_template; exit 0 @@ -3066,8 +3288,8 @@ let () = ~flag:year in (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)) + | `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)) | "readings" :: rest when List.length rest <= 1 -> reject_emit "readings"; reject_template_flavour "readings"; @@ -3084,8 +3306,8 @@ let () = ~sigla_tradition_flag:sigla_tradition ~config in (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)) + | `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)) | "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 @@ -3120,11 +3342,12 @@ let () = ~positional:(match rest with [ ys ] -> Some ys | _ -> None) ~flag:year in - with_year ys (rubrics_report ~rite:(resolve_rite rite) ~lang:(rubrics_lang ()) ~overlays:effective_overlays) + with_year ys (rubrics_report ~rite:(resolve_rite rite) ~lang:(rubrics_lang ()) ~pretty ~overlays:effective_overlays) | [ "emit" ] -> ( reject_table "emit"; reject_publish "emit"; reject_lang_sub "emit"; + reject_pretty "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"; @@ -3152,6 +3375,7 @@ let () = reject_emit cmd; reject_publish cmd; reject_lang_sub cmd; + reject_pretty cmd; let positional_year = match rest with [ ys ] -> Some ys | _ -> None in match (match template with Some t -> Some t | None -> Colitur_naming.Config.template config) with | None -> @@ -3180,6 +3404,7 @@ let () = reject_table "publish"; reject_format_for "publish" format; reject_lang_sub "publish"; + reject_pretty "publish"; match out with | None -> Printf.eprintf "colitur: publish requires --out DIR\n"; |