summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorLukasz Kasprzak <lukas@labunix.xyz>2026-08-28 10:03:37 +0200
committerLukasz Kasprzak <lukas@labunix.xyz>2026-08-28 10:03:37 +0200
commitd0807440309e2357d51cd56c72a443072b0ba57f (patch)
tree919c412b4814261f15c21f57f34d3fa8e7b92a72 /bin
parent4b3c18d61a243f1ec9c39e6279f7c687402b8dda (diff)
parent8ba98d24499bedbc2491bd56268ea4f69aaddb2f (diff)
downloadcolitur-1.2.0.tar.gz
colitur-1.2.0.zip
Merge branch 'cli-pretty'v1.2.0
--pretty, and the --month/--date/--today flags that make it usable: a box spans seven lines, so the flag that improved reading had removed grepping.
Diffstat (limited to 'bin')
-rw-r--r--bin/dune1
-rw-r--r--bin/main.ml458
-rw-r--r--bin/pretty.ml151
3 files changed, 571 insertions, 39 deletions
diff --git a/bin/dune b/bin/dune
index 09c2009..a143250 100644
--- a/bin/dune
+++ b/bin/dune
@@ -1,5 +1,6 @@
(executable
(name main)
+ (modules main pretty)
(public_name colitur)
(package colitur)
; [unix] ships with the OCaml compiler -- it is not a new entry in
diff --git a/bin/main.ml b/bin/main.ml
index 49f06e5..7565090 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);
@@ -29,7 +50,34 @@ 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 pretty_day_box ~date ~dow ~colour ~rank ~season ~week ~name ~comms ~extra =
+ let season_col =
+ match week with Some w -> Printf.sprintf "%s, week %s" season w | None -> season
+ in
+ print_endline (Pretty.rule ());
+ print_endline (Pretty.line_lr (date ^ " " ^ Pretty.cap dow) (Pretty.tint colour colour));
+ print_endline (Pretty.divider ());
+ List.iter (fun l -> print_endline (Pretty.line l)) (Pretty.wrap name);
+ print_endline (Pretty.line (rank ^ " . " ^ season_col));
+ (* Commemorations get their own rows inside the box rather than a suffix:
+ the EF admits up to three, and they are a different KIND of fact from the
+ day's own identity, which the box can show and a single row cannot. *)
+ List.iter (fun c ->
+ List.iter (fun l -> print_endline (Pretty.line l))
+ (Pretty.wrap (Pretty.dim "also: " ^ c)))
+ comms;
+ (match extra with
+ | [] -> ()
+ | rows ->
+ print_endline (Pretty.divider ());
+ List.iter print_endline rows);
+ print_endline (Pretty.rule ());
+ (* One blank line between boxes. Without it the bottom rule of one day and
+ the top rule of the next sit adjacent and read as a single doubled line,
+ which is exactly the "not distinct enough" this format exists to fix. *)
+ print_newline ()
+
+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
@@ -54,10 +102,24 @@ 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 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.
+ Same box as `day --pretty`, one row shorter. *)
+ pretty_day_box ~extra:[] ~comms:[]
+ ~date:r.Colitur_kernel.Record.date
+ ~dow:r.Colitur_kernel.Record.weekday
+ ~colour:r.Colitur_kernel.Record.colour
+ ~rank:r.Colitur_kernel.Record.rank
+ ~season:r.Colitur_kernel.Record.season
+ ~week:(match r.Colitur_kernel.Record.week with "" -> None | w -> Some w)
+ ~name: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
@@ -761,12 +823,142 @@ 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)
+
+
+(* ---------------------------------------------------------------------- *)
+(* --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 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_box ~extra:[]
+ ~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 ~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 =
+ print_endline (Pretty.rule ());
+ print_endline (Pretty.line (date ^ " " ^ Pretty.cap dow));
+ print_endline (Pretty.divider ());
+ List.iter (fun l -> print_endline (Pretty.line l)) (Pretty.wrap name);
+ let rows =
+ List.filter (fun (_, v) -> v <> "" && v <> "-")
+ [ ("First", first); ("Second", second); ("Gospel", gospel) ]
+ in
+ (* The label column is what makes a citation findable. In the default row
+ format the three references are separated by bars and you count fields to
+ tell which is which; here each says what it is. The OF second reading is
+ absent on most days and simply does not print a row. *)
+ if rows <> [] then begin
+ print_endline (Pretty.divider ());
+ List.iter (fun (k, v) -> print_endline (Pretty.line_kv k v)) rows
+ end;
+ print_endline (Pretty.rule ());
+ print_newline ()
+
+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 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
+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
(* 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
@@ -864,21 +1056,104 @@ 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_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_box ~extra:[] ~comms:[]
+ ~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
+
+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) =
+ 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 ~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
(* 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 yn b = if b then "yes" else "no" in
+ print_endline (Pretty.rule ());
+ print_endline (Pretty.line date);
+ print_endline (Pretty.divider ());
+ print_endline (Pretty.line_kv "Mass of" said);
+ print_endline (Pretty.line_kv "taken" via);
+ print_endline (Pretty.line_kv "Creed" (yn creed));
+ print_endline (Pretty.line_kv "Gloria" (yn gloria));
+ print_endline (Pretty.line_kv "Preface" preface);
+ print_endline (Pretty.rule ());
+ print_newline ()
+
+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 ~window ~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 ~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] --
@@ -1709,24 +1984,27 @@ let publish_report ~rite ~lang ~sigla ~from_y ~to_y ~out ~overlays ~dtstamp ~pru
same reason. Deliberately NOT embedded in [help_text]: the cram test pins
help's first line, and a version in it would make every release edit a
test expectation for no gain. *)
-let version = "1.1.0"
+let version = "1.2.0"
let help_text =
{|colitur -- deterministic liturgical calendar engine (Roman rite, 1962)
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
@@ -1760,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
@@ -2131,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
@@ -2185,6 +2504,10 @@ type parsed_args = {
prune : bool;
lang : string option;
raw : bool;
+ pretty : bool;
+ month : string option;
+ date_sel : string option;
+ today : bool;
dump : string option;
check : string option;
list : bool;
@@ -2222,6 +2545,12 @@ 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
+ | "--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
@@ -2246,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;
+ 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
@@ -2382,6 +2711,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 +3208,23 @@ 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; 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
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_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
@@ -2941,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";
@@ -2948,9 +3302,16 @@ let () =
reject_publish "easter";
reject_lang "easter";
reject_lang_sub "easter";
+ 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";
@@ -2958,8 +3319,14 @@ let () =
reject_lang "temporal";
reject_lang_sub "temporal";
reject_sigla "temporal";
- with_year ys (temporal_report ~rite:(resolve_rite rite))
+ 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";
@@ -2967,9 +3334,11 @@ let () =
reject_publish "check";
reject_lang "check";
reject_lang_sub "check";
+ reject_pretty "check";
reject_sigla "check";
check_report files
| [ "convert"; path ] ->
+ reject_window "convert";
reject_overlays_for "convert" overlays;
reject_rite "convert";
reject_emit "convert";
@@ -2977,9 +3346,11 @@ let () =
reject_publish "convert";
reject_lang "convert";
reject_lang_sub "convert";
+ reject_pretty "convert";
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";
@@ -2987,10 +3358,12 @@ 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
| [ "lang" ] -> (
+ reject_window "lang";
reject_overlays_for "lang" overlays;
reject_rite "lang";
reject_emit "lang";
@@ -3013,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
@@ -3060,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 ()) ~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 ~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 =
@@ -3084,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 ~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 ~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
@@ -3115,16 +3489,18 @@ 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 ()) ~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";
+ 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";
@@ -3149,9 +3525,11 @@ 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;
+ 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 ->
@@ -3177,9 +3555,11 @@ 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";
+ reject_pretty "publish";
match out with
| None ->
Printf.eprintf "colitur: publish requires --out DIR\n";
diff --git a/bin/pretty.ml b/bin/pretty.ml
new file mode 100644
index 0000000..1b875d4
--- /dev/null
+++ b/bin/pretty.ml
@@ -0,0 +1,151 @@
+(* pretty -- terminal presentation for the row commands.
+ *
+ * This module is PRESENTATION ONLY. It never decides what a day is, only how
+ * it is shown, and nothing else in colitur reads it. That separation matters
+ * here more than usual: every other output format this program has is a
+ * contract something parses, and a change to one is a breaking change. This
+ * one is for a person reading a terminal, so it is free to change.
+ *
+ * The default output is deliberately unaffected. `--pretty` is opt-in, and a
+ * command that does not take it refuses rather than ignoring it, like every
+ * other flag here. *)
+
+(* ------------------------------------------------------------ colour *)
+
+(* Colour is emitted only when stdout is a terminal AND NO_COLOR is unset.
+ *
+ * The TTY test is what keeps `colitur day --pretty 2026 | less` and
+ * `> file` free of escape sequences: alignment survives the pipe, colour does
+ * not, which is the behaviour a person actually wants from both.
+ *
+ * NO_COLOR (https://no-color.org) is honoured on PRESENCE, whatever its
+ * value -- that is the convention's own rule, and reading it as a boolean
+ * ("NO_COLOR=0 means colour") is the usual way tools get it wrong. *)
+let use_colour =
+ lazy
+ (match Sys.getenv_opt "NO_COLOR" with
+ | Some _ -> false
+ | None -> ( try Unix.isatty Unix.stdout with Unix.Unix_error _ -> false))
+
+(* The six liturgical colours the engine can emit, as the nearest sensible
+ ANSI. Rose is the one that needs a note: it is a distinct liturgical colour
+ (Gaudete, Laetare), not a shade of red, so it gets bright magenta rather
+ than being folded into red -- collapsing them would lose a distinction the
+ calendar deliberately makes. Black is rendered bright-black (grey) because
+ true black is invisible on a dark terminal, which is where this is mostly
+ read. *)
+let ansi_of_colour = function
+ | "white" -> "\027[97m"
+ | "red" -> "\027[31m"
+ | "green" -> "\027[32m"
+ | "violet" -> "\027[35m"
+ | "rose" -> "\027[95m"
+ | "black" -> "\027[90m"
+ | _ -> "\027[37m"
+
+let reset = "\027[0m"
+
+(* A filled circle in the day's colour. Chosen over tinting the whole row:
+ violet and black text are hard to read on a dark background, and a fully
+ coloured line reads as a status indicator (red = error) rather than as
+ liturgical information. *)
+let swatch colour =
+ if Lazy.force use_colour then ansi_of_colour colour ^ "\xe2\x97\x8f" ^ reset
+ else
+ (* Without colour the swatch would be six identical dots, carrying nothing.
+ Print the colour's own initial instead, so the information survives a
+ pipe rather than silently vanishing with the escapes. *)
+ (match colour with
+ | "white" -> "w" | "red" -> "r" | "green" -> "g"
+ | "violet" -> "v" | "rose" -> "o" | "black" -> "k" | _ -> "?")
+
+let dim s = if Lazy.force use_colour then "\027[2m" ^ s ^ reset else s
+
+(* The colour NAME, tinted in that colour on a terminal and left as plain text
+ everywhere else. The word carries the information either way -- this is
+ what keeps `--pretty | tee ordo.txt` meaningful rather than a box with a
+ missing field. *)
+let tint colour s =
+ if Lazy.force use_colour then ansi_of_colour colour ^ s ^ reset else s
+
+(* ------------------------------------------------------------- boxes *)
+
+(* One box per day, drawn in PURE ASCII -- '+', '-' and '|' only.
+ *
+ * No Unicode box-drawing characters, deliberately. The whole point of this
+ * format is that it can be pasted or piped into a document, a mail, a commit
+ * message or a plain-text ordo, and U+2500 and friends survive that journey
+ * only when every stage of it agrees about encoding and font. '+---+' has
+ * never once failed to render anywhere. *)
+
+let utf8_len s =
+ let n = ref 0 in
+ String.iter (fun c -> if Char.code c land 0xC0 <> 0x80 then incr n) s;
+ !n
+
+(* Inner width. 72 leaves the whole box at 74 columns, inside an 80-column
+ terminal and inside the 80-ish column a plain-text document usually wants,
+ with room for a quote marker or a couple of levels of indent. *)
+let width = 72
+
+let rule () = "+" ^ String.make (width + 2) '-' ^ "+"
+
+(* A divider INSIDE the box. Corners are '+' rather than '|' for the same
+ reason the outer rule uses them: '+' at every junction is the shape every
+ ASCII table has had since forever, and a '|' there reads as a broken edge. *)
+let divider () = "+" ^ String.make (width + 2) '-' ^ "+"
+
+(* Capitalise a lowercase weekday/season word for display. The engine emits
+ these lowercase because they are DATA there; a box is prose. *)
+let cap s =
+ if s = "" then s
+ else String.make 1 (Char.uppercase_ascii s.[0]) ^ String.sub s 1 (String.length s - 1)
+
+let line s =
+ let l = utf8_len s in
+ let s = if l > width then
+ (* Truncated rather than overflowing: a box whose right edge does
+ not line up is worse than a clipped name, and the full value is
+ always available in the default output. *)
+ (let b = Buffer.create width in
+ let n = ref 0 in
+ String.iter (fun c ->
+ if Char.code c land 0xC0 <> 0x80 then incr n;
+ if !n <= width - 1 then Buffer.add_char b c) s;
+ Buffer.contents b ^ "~")
+ else s in
+ let l = utf8_len s in
+ "| " ^ s ^ String.make (width - l) ' ' ^ " |"
+
+(* A heading row: left text, right text, flush to the two edges. Used for the
+ date and the day's colour, which are the two things you scan for. *)
+let line_lr left right =
+ let ll = utf8_len left and rl = utf8_len right in
+ if ll + rl + 2 > width then line (left ^ " " ^ right)
+ else "| " ^ left ^ String.make (width - ll - rl) ' ' ^ right ^ " |"
+
+(* Wrap on spaces to the inner width, so a long Latin title becomes two body
+ lines rather than being clipped. Falls back to a hard break for a single
+ token longer than the box, which no real celebration name is. *)
+let wrap s =
+ if utf8_len s <= width then [ s ]
+ else begin
+ let words = String.split_on_char ' ' s in
+ let out = ref [] and cur = Buffer.create width in
+ let flush () =
+ if Buffer.length cur > 0 then (out := Buffer.contents cur :: !out; Buffer.clear cur)
+ in
+ List.iter (fun w ->
+ let cand = if Buffer.length cur = 0 then w else Buffer.contents cur ^ " " ^ w in
+ if utf8_len cand <= width then (Buffer.clear cur; Buffer.add_string cur cand)
+ else (flush (); Buffer.add_string cur w)) words;
+ flush ();
+ List.rev !out
+ end
+
+(* A label/value body row, label column fixed so the values align down the box. *)
+let line_kv label value =
+ let lw = 9 in
+ let l = utf8_len label in
+ let label = if l >= lw then label else label ^ String.make (lw - l) ' ' in
+ line (dim label ^ value)