feat(cli): add output control flags, sort order, and verbose mode

- Add `--verbose`/`-v` flag; gate all diagnostic stderr output behind it
- Add `--no-uuid`, `--no-source`, `--no-location`, `--no-description`,
  `--no-conference-url` flags to suppress individual INFO lines
- Add `--sort` option (`asc`, `desc`, `original`) replacing hardcoded
  descending sort
- Add `--source` option to override calendar name (single-file only)
- Introduce `Config` module with global `ref` flags set at startup from
  CLI args
- Add `Utils.warn` helper that writes to stderr only when
  `Config.verbose` is set
- Normalise all diagnostic messages to a consistent format (`Warning:
  ... (UID: ...)`)
- Remove `debug_print_of_recurrence_and_skip`; inline skip at each call
  site
- Fix `add_common_part` to always emit a trailing `\\\n    `
  continuation line
This commit is contained in:
2026-05-24 12:25:22 +02:00
parent 510f178630
commit 69384dcfc2
7 changed files with 150 additions and 55 deletions

View File

@@ -68,6 +68,9 @@ let string_of_month = function
let spf = Printf.sprintf
(** Print a diagnostic message on stderr, but only when --verbose is active. *)
let warn fmt = if !Config.verbose then Printf.eprintf fmt else Printf.ifprintf stderr fmt
let get_uid ev =
let _, uid = ev.uid in
uid
@@ -114,7 +117,7 @@ let timedesc_of_timestamp (ts : timestamp) : Timedesc.t =
match Timedesc.Time_zone.make candidate with
| Some tz -> tz
| None ->
Printf.eprintf "Warning: unresolvable timezone %S, falling back to local timezone\n" tz_name;
warn "Warning: unresolvable timezone %S, falling back to local timezone\n" tz_name;
!target_tz
in
let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in
@@ -193,7 +196,6 @@ let get_rdates ev =
| _ -> None)
event_props
in
let datetimes, dates, periods =
ListLabels.fold_left ~init:([], [], []) dates_or_datetimes_or_periods
~f:(fun (acc_datetimes, acc_dates, acc_periods) dates ->
@@ -203,11 +205,12 @@ let get_rdates ev =
| `Periods period_list -> (acc_datetimes, acc_dates, acc_periods @ period_list))
in
if List.length dates > 0 then Printf.eprintf "Found RDATE with dates: %d entries; UID: %s\n" (List.length dates) uid;
if List.length dates > 0 then
warn "Warning: RDATE with dates (%d entries) not supported, skipping (UID: %s)\n" (List.length dates) uid;
if List.length datetimes > 0 then
Printf.eprintf "Found RDATE with datetimes: %d entries; UID: %s\n" (List.length datetimes) uid;
warn "Warning: RDATE with datetimes (%d entries) not supported, skipping (UID: %s)\n" (List.length datetimes) uid;
if List.length periods > 0 then
Printf.eprintf "Found RDATE with periods: %d entries; UID: %s\n" (List.length periods) uid;
warn "Warning: RDATE with periods (%d entries) not supported, skipping (UID: %s)\n" (List.length periods) uid;
[]
let add_months (date : Timedesc.Date.t) (n : int) : Timedesc.Date.t =
@@ -259,7 +262,6 @@ let get_conference_url ev =
let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list =
let recur_ids = List.map (fun ev -> (ev, get_recurrence_id ev)) events in
let master_and_recurrences =
List.partition_map
(fun (ev, recur_id_opt) ->
@@ -272,6 +274,6 @@ let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.e
| [], _ -> failwith "No master event found"
| [ master ], recurrences -> (master, recurrences)
| master :: rest, recurrences ->
Printf.eprintf "Warning: %d extra master events (no RECURRENCE-ID) for UID: %s — only first used\n"
(List.length rest) (get_uid master);
warn "Warning: %d extra master events (no RECURRENCE-ID), only first used (UID: %s)\n" (List.length rest)
(get_uid master);
(master, recurrences)