From cef6326289090fa54f609604d94696212c5c5004 Mon Sep 17 00:00:00 2001 From: Paolo Donadeo Date: Sun, 24 May 2026 12:25:22 +0200 Subject: [PATCH] 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 --- bin/commandLine.ml | 61 ++++++++++++++++++++++++++++++++++++++++-- bin/config.ml | 10 +++++++ bin/dune | 2 +- bin/eventPredicates.ml | 31 +++++++++++---------- bin/main.ml | 37 +++++++++++++++++++------ bin/remind.ml | 46 +++++++++++++++++-------------- bin/utils.ml | 18 +++++++------ 7 files changed, 150 insertions(+), 55 deletions(-) create mode 100644 bin/config.ml diff --git a/bin/commandLine.ml b/bin/commandLine.ml index 928f0d0..e69e438 100644 --- a/bin/commandLine.ml +++ b/bin/commandLine.ml @@ -14,12 +14,69 @@ let timezone = let doc = "Target timezone for output (e.g. Europe/Rome). Defaults to local timezone." in Arg.(value & opt (some string) None & info [ "timezone"; "z" ] ~docv:"TZ" ~doc) +let verbose = + let doc = "Print diagnostic messages (skipped events, unsupported recurrences, etc.) on stderr." in + Arg.(value & flag & info [ "verbose"; "v" ] ~doc) + +let no_uuid = + let doc = "Omit the INFO line with the event UID from output." in + Arg.(value & flag & info [ "no-uuid" ] ~doc) + +let no_source = + let doc = "Omit the INFO line with the calendar source name from output." in + Arg.(value & flag & info [ "no-source" ] ~doc) + +let no_location = + let doc = "Omit the INFO line with the event location from output." in + Arg.(value & flag & info [ "no-location" ] ~doc) + +let no_description = + let doc = "Omit the INFO line with the event description from output." in + Arg.(value & flag & info [ "no-description" ] ~doc) + +let no_conference_url = + let doc = "Omit the INFO line with the conference URL from output." in + Arg.(value & flag & info [ "no-conference-url" ] ~doc) + +type sort_order = Asc | Desc | Original + +let sort_order_enum = [ ("asc", Asc); ("desc", Desc); ("original", Original) ] + +let sort = + let doc = "Output sort order by date: $(b,desc) (default), $(b,asc), or $(b,none) (file order)." in + Arg.(value & opt (enum sort_order_enum) Desc & info [ "sort" ] ~docv:"ORDER" ~doc) + +let source = + let doc = "Override the calendar source name used in INFO lines. Only valid when processing a single file." in + Arg.(value & opt (some string) None & info [ "source" ] ~docv:"NAME" ~doc) + +type cli_args = { + tz : string option; + verbose : bool; + no_uuid : bool; + no_source : bool; + no_location : bool; + no_description : bool; + no_conference_url : bool; + sort : sort_order; + source : string option; +} + let main_command f = let doc = "Convert iCalendar files to remind format" in let man = [] in Cmd.make (Cmd.info "ical2rem" ~version:(version_string ()) ~doc ~man) @@ - let+ files = files and+ tz = timezone in - f tz files + let+ files = files + and+ tz = timezone + and+ verbose = verbose + and+ no_uuid = no_uuid + and+ no_source = no_source + and+ no_location = no_location + and+ no_description = no_description + and+ no_conference_url = no_conference_url + and+ sort = sort + and+ source = source in + f { tz; verbose; no_uuid; no_source; no_location; no_description; no_conference_url; sort; source } files let main f = Cmd.eval @@ main_command f diff --git a/bin/config.ml b/bin/config.ml new file mode 100644 index 0000000..2f3a1b8 --- /dev/null +++ b/bin/config.ml @@ -0,0 +1,10 @@ +(** Global configuration flags, set once at startup from CLI args. *) + +(** Enable diagnostic output on stderr. Off by default; activated by --verbose. *) +let verbose = ref false + +let no_uuid = ref false +let no_source = ref false +let no_location = ref false +let no_description = ref false +let no_conference_url = ref false diff --git a/bin/dune b/bin/dune index cef7cf3..0f8f443 100644 --- a/bin/dune +++ b/bin/dune @@ -1,7 +1,7 @@ (executable (public_name ical2rem) (name main) - (modules main commandLine remind eventPredicates utils windows_tz) + (modules main commandLine config remind eventPredicates utils windows_tz) (preprocess (pps ppx_deriving.show)) (libraries diff --git a/bin/eventPredicates.ml b/bin/eventPredicates.ml index d82c520..049c05d 100644 --- a/bin/eventPredicates.ml +++ b/bin/eventPredicates.ml @@ -52,7 +52,8 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result = begin match ev.dtend_or_duration with | None -> { rem with Remind.date = day_start } |> Result.ok | Some (`Dtend (_, `Datetime _)) -> - skip (* Start is a date, end is a datetime: invalid case for all-day event *) + Utils.warn "Warning: DTSTART is DATE but DTEND is DATETIME, skipping (UID: %s)\n" rem.Remind.original_uuid; + skip | Some (`Dtend (_, `Date (year, month, day))) -> begin match Timedesc.Date.Ymd.make ~year ~month ~day with | Error e -> invalid_date "DTEND" e @@ -96,7 +97,7 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result = Ok rem end | `Date (_year, _month, _day) -> - (* Start is a datetime, end is a date: invalid case for timed event *) + Utils.warn "Warning: DTSTART is DATETIME but DTEND is DATE, skipping (UID: %s)\n" rem.Remind.original_uuid; skip end | Some (`Duration (_, duration)) -> @@ -121,20 +122,15 @@ let yearly_simple_date rem ev : (Remind.rem, error) result = | Some _ -> Ok rem | None -> Ok rem -let debug_print_of_recurrence_and_skip ev recurs = - let uid = Utils.get_uid ev in - Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence recurs) uid; - skip - let simple_recurrence rem ev : (Remind.rem, error) result = match ev.rrule with | Some (_, (`Yearly, None, None, [])) -> Ok rem (* handled in yearly_simple_date *) | Some (_, ((`Weekly as freq), count_or_until, interval, recurs)) | Some (_, ((`Daily as freq), count_or_until, interval, recurs)) -> begin if List.length rem.recurring > 0 then ( - Printf.eprintf "Warning: skipping complex recurrence with EXDATE/RDATE/overrides, not supported\t\t\tUID: %s\n" + Utils.warn "Warning: complex recurrence with EXDATE/RDATE/overrides not supported, skipping (UID: %s)\n" (Utils.get_uid ev); - debug_print_of_recurrence_and_skip ev (freq, count_or_until, interval, recurs)) + skip) else let days = ListLabels.filter_map recurs ~f:(function @@ -162,8 +158,8 @@ let simple_recurrence rem ev : (Remind.rem, error) result = | Some (_, (`Monthly, count_or_until, interval, recurs)) -> begin match interval with | Some n when n > 1 -> - Printf.eprintf "Warning: MONTHLY INTERVAL=%d not supported\t\t\tUID: %s\n" n (Utils.get_uid ev); - debug_print_of_recurrence_and_skip ev (`Monthly, count_or_until, interval, recurs) + Utils.warn "Warning: MONTHLY INTERVAL=%d not supported, skipping (UID: %s)\n" n (Utils.get_uid ev); + skip | _ -> ( let bymonthday = List.find_map @@ -187,11 +183,13 @@ let simple_recurrence rem ev : (Remind.rem, error) result = in match pattern with | None -> - Printf.eprintf "Warning: MONTHLY with unsupported BYDAY\t\t\tUID: %s\n" (Utils.get_uid ev); - debug_print_of_recurrence_and_skip ev (`Monthly, count_or_until, interval, recurs) + Utils.warn "Warning: MONTHLY with unsupported BYDAY, skipping (UID: %s)\n" (Utils.get_uid ev); + skip | Some p -> Ok { rem with Remind.monthly = Some { count_or_until; interval; pattern = p } }) end - | Some (_, recurs) -> debug_print_of_recurrence_and_skip ev recurs + | Some (_, recurs) -> + Utils.warn "Warning: unsupported recurrence rule, skipping (UID: %s)\n" (Utils.get_uid ev); + skip | None -> Ok rem let is_cancelled (ev : Icalendar.event) : bool = @@ -219,7 +217,8 @@ let collect_overrides rem _ev : (Remind.rem, error) result = let exdates = match recur_id_opt with | None -> - Printf.eprintf "Warning: override event has no RECURRENCE-ID\t\t\tUID: %s\n" (Utils.get_uid override_ev); + Utils.warn "Warning: override event has no RECURRENCE-ID, skipping (UID: %s)\n" + (Utils.get_uid override_ev); exdates | Some date_or_dt -> date_or_dt :: exdates in @@ -228,7 +227,7 @@ let collect_overrides rem _ev : (Remind.rem, error) result = else match build_override_rem rem.Remind.source override_ev with | Error _ -> - Printf.eprintf "Warning: could not build override REM\t\t\tUID: %s\n" (Utils.get_uid override_ev); + Utils.warn "Warning: could not build override REM, skipping (UID: %s)\n" (Utils.get_uid override_ev); overrides | Ok override_rem -> override_rem :: overrides in diff --git a/bin/main.ml b/bin/main.ml index 6eb1243..e7be7ef 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -14,16 +14,32 @@ let read_file filename = close_in ic; Bytes.unsafe_to_string s -let ical2rem tz_opt ical_files = - Utils.init_target_tz tz_opt; +let ical2rem (args : CommandLine.cli_args) ical_files = + (* Validate --source with multiple files *) + (match args.source with + | Some _ when List.length ical_files > 1 -> + Printf.eprintf "Error: --source can only be used with a single input file.\n"; + exit 1 + | _ -> ()); + Config.verbose := args.verbose; + Config.no_uuid := args.no_uuid; + Config.no_source := args.no_source; + Config.no_location := args.no_location; + Config.no_description := args.no_description; + Config.no_conference_url := args.no_conference_url; + Utils.init_target_tz args.tz; let good_rems = ListLabels.fold_left ~init:[] ical_files ~f:(fun good_rems_acc filename -> try let file_content = read_file filename in - let basename = Filename.remove_extension (Filename.basename filename) in + let basename = + match args.source with + | Some name -> name + | None -> Filename.remove_extension (Filename.basename filename) + in match Icalendar.parse file_content with | Error e -> - if e <> ": not enough input" then prerr_endline ("Error parsing iCalendar file: " ^ e); + if e <> ": not enough input" then Utils.warn "Error: could not parse %s: %s\n" filename e; good_rems_acc | Ok (_, components) -> begin let events_map : Icalendar.event list Map.t = @@ -44,21 +60,26 @@ let ical2rem tz_opt ical_files = match rem_or_error with | Ok rem -> rem :: good_rems | Error (EventPredicates.Invalid_date s) -> - Printf.eprintf "UID: %s Invalid date: %s\n" uid s; + Utils.warn "Warning: invalid date: %s (UID: %s)\n" s uid; good_rems | Error Skip -> - Printf.eprintf "UID: %s Skipped\n" uid; + Utils.warn "Warning: event skipped (UID: %s)\n" uid; good_rems) in let good_rems = List.rev good_rems in good_rems @ good_rems_acc end with e -> - prerr_endline ("Error reading file " ^ filename ^ ": " ^ Printexc.to_string e); + Utils.warn "Error: could not read file %s: %s\n" filename (Printexc.to_string e); good_rems_acc) in - let good_rems = List.sort (fun a b -> Timedesc.Date.compare b.Remind.date a.Remind.date) good_rems in + let good_rems = + match args.sort with + | CommandLine.Desc -> List.sort (fun a b -> Timedesc.Date.compare b.Remind.date a.Remind.date) good_rems + | CommandLine.Asc -> List.sort (fun a b -> Timedesc.Date.compare a.Remind.date b.Remind.date) good_rems + | CommandLine.Original -> good_rems + in try ListLabels.iter good_rems ~f:(fun rem -> Printf.printf "%s" (Remind.string_of_rem rem)) with e -> Printf.eprintf "Error processing reminders: %s\n" (Printexc.to_string e); diff --git a/bin/remind.ml b/bin/remind.ml index ccc2f30..a17be22 100644 --- a/bin/remind.ml +++ b/bin/remind.ml @@ -164,10 +164,13 @@ let render_alarm (rem : rem) : alarm_rendering = end (* ── buffer primitives ────────────────────────────────────────── *) - let add_rem b = Buffer.add_string b "REM " -let add_uid b uuid = Buffer.add_string b (spf "\\\n INFO \"UID: %s\" " uuid) -let add_source b source = Buffer.add_string b (spf "\\\n INFO \"Calendar: %s\" " (String.uppercase_ascii source)) +let add_uid b uuid = if not !Config.no_uuid then Buffer.add_string b (spf "\\\n INFO \"UID: %s\" " uuid) + +let add_source b source = + if not !Config.no_source then + Buffer.add_string b (spf "\\\n INFO \"Calendar: %s\" " (String.uppercase_ascii source)) + let add_date b date = Buffer.add_string b (Timedesc.Date.to_rfc3339 date) let add_weekday b wd = Buffer.add_string b (spf "%s " (string_of_weekday wd)) @@ -275,26 +278,28 @@ let add_msg b ?(alarm = empty_alarm) ?(timed = false) summary = Buffer.add_string b (spf " MSG %s\n" body) let add_location b loc = - match loc with - | Some loc -> begin - let loc = String.trim loc in - Buffer.add_string b (spf "\\\n INFO \"Location: %s\" " (escape_msg loc)) - end - | None -> () + if not !Config.no_location then + match loc with + | Some loc -> + let loc = String.trim loc in + Buffer.add_string b (spf "\\\n INFO \"Location: %s\" " (escape_msg loc)) + | None -> () let add_description b desc = - match desc with - | Some desc -> - let desc = String.trim desc in - Buffer.add_string b (spf "\\\n INFO \"Description: %s\" " (escape_msg desc)) - | None -> () + if not !Config.no_description then + match desc with + | Some desc -> + let desc = String.trim desc in + Buffer.add_string b (spf "\\\n INFO \"Description: %s\" " (escape_msg desc)) + | None -> () let add_url b url = - match url with - | Some url -> - let url = String.trim url in - Buffer.add_string b (spf "\\\n INFO \"Url: %s\" " (escape_msg url)) - | None -> () + if not !Config.no_conference_url then + match url with + | Some url -> + let url = String.trim url in + Buffer.add_string b (spf "\\\n INFO \"Url: %s\" " (escape_msg url)) + | None -> () let add_common_part b rem = add_rem b; @@ -302,7 +307,8 @@ let add_common_part b rem = add_source b rem.source; add_location b rem.location; add_description b rem.description; - add_url b rem.conference_url + add_url b rem.conference_url; + Buffer.add_string b "\\\n " let date_of_date_or_datetime (d : Icalendar.date_or_datetime) : Timedesc.Date.t = match d with diff --git a/bin/utils.ml b/bin/utils.ml index 4a7207c..6a1d96c 100644 --- a/bin/utils.ml +++ b/bin/utils.ml @@ -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)