pdonadeo/ical2rem
1
0
Fork 0
Code Issues Pull Requests Actions Projects Releases 1 Activity

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

Browse Source 
- 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:
Paolo Donadeo
2026-05-24 12:25:22 +02:00
parent 510f178630
commit 69384dcfc2
7 changed files with 150 additions and 55 deletions
Download Patch File Download Diff File Expand all files Collapse all files

61
bin/commandLine.ml
View File

@@ -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

10
bin/config.ml Normal file
View File

@@ -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

2
bin/dune
View File

@@ -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

31
bin/eventPredicates.ml
View File

@@ -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

37
bin/main.ml
View File

@@ -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);

46
bin/remind.ml
View File

@@ -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

18
bin/utils.ml
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)