From 21215a224880b0105b1f8210fd59af46e06cc39e Mon Sep 17 00:00:00 2001 From: Paolo Donadeo Date: Sat, 16 May 2026 21:56:14 +0200 Subject: [PATCH] feat: implement simple weekly recurrence rendering MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - Add `simple_weekly` type and `weekly` field to `rem` record - Add `exdate` field to `rem` for excluded dates - Add `collect_exdates` collector to pipeline - implement weekly `RRULE` handling with `BYDAY`, `INTERVAL`, `COUNT`/`UNTIL` - Add `render_weekly` to emit one `REM` per weekday with `UNTIL`/`*N` - Replace `timedesc_of_date_or_datetime` with `timedesc_of_utc_or_timestamp_local` in utils - Refactor `get_exdates`/`get_rdates` to separate dates, datetimes and periods; add debug logging per UID - Wrap reminder output in try/catch in main; drop trailing newline duplication - Mark implemented predicates (P00–P05, P09, P12, P14) with ✅; remove P18–P20 (ignored/deferred) --- bin/eventPredicates.ml | 129 +++++++++++++++++++++-------------------- bin/main.ml | 5 +- bin/remind.ml | 108 +++++++++++++++++++++++++++++----- bin/utils.ml | 85 ++++++++++++++------------- 4 files changed, 208 insertions(+), 119 deletions(-) diff --git a/bin/eventPredicates.ml b/bin/eventPredicates.ml index 3ea0624..e5bdc9c 100644 --- a/bin/eventPredicates.ml +++ b/bin/eventPredicates.ml @@ -3,7 +3,7 @@ open Icalendar open Utils (* CASE ANALYSIS PREDICATES - - id: P00 + - id: P00 ✅ pattern: Ha un SUMMARY? ics: "SUMMARY:…" remind_support: nativo @@ -11,7 +11,7 @@ open Utils snippet: 'REM 2025-12-25 MSG Natale' priorita: Subito - - id: P01 + - id: P01 ✅ pattern: All-day singolo ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1" remind_support: nativo @@ -19,7 +19,7 @@ open Utils snippet: 'REM 2025-12-25 MSG Natale' priorita: Subito - - id: P02 + - id: P02 ✅ pattern: All-day multi-giorno ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo" remind_support: nativo+accorgimenti @@ -27,7 +27,7 @@ open Utils snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno' priorita: Subito - - id: P03 + - id: P03 ✅ pattern: Evento a orario locale ics: "DTSTART;TZID=… + DTEND oppure DURATION" remind_support: nativo @@ -35,7 +35,7 @@ open Utils snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione' priorita: Subito - - id: P04 + - id: P04 ✅ pattern: Evento a orario in UTC ics: "DTSTART/DTEND con suffisso Z" remind_support: nativo+accorgimenti @@ -43,7 +43,7 @@ open Utils snippet: 'REM 2025-09-03 AT 06:45 MSG Treno' priorita: Subito - - id: P05 + - id: P05 ✅ pattern: Ricorrenza settimanale semplice ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]" remind_support: nativo @@ -75,7 +75,7 @@ open Utils snippet: '# genera REM per ciascuna data calcolata' priorita: Dopo - - id: P09 + - id: P09 ✅ pattern: Ricorrenza annuale semplice ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]" remind_support: nativo @@ -99,7 +99,7 @@ open Utils snippet: '# serie + REM specifico per l’istanza' priorita: Subito - - id: P12 + - id: P12 ✅ pattern: DURATION al posto di DTEND ics: "DURATION:PT…" remind_support: nativo @@ -115,7 +115,7 @@ open Utils snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione' priorita: Dopo - - id: P14 + - id: P14 ✅ pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi) ics: "VTIMEZONE + DTSTART;TZID=…" remind_support: nativo+accorgimenti @@ -146,41 +146,8 @@ open Utils strategia: "estrai solo URL di join nel MSG" snippet: '# riduci al link' priorita: Quando serve - - - id: P18 - pattern: Visibilità/trasparenza - ics: "CLASS, TRANSP" - remind_support: non previsto - strategia: "ignora o aggiungi prefisso [FREE]/[BUSY] nel MSG" - snippet: '# opzionale' - priorita: Ignora - - - id: P19 - pattern: Stato/versioning - ics: "STATUS, SEQUENCE, CREATED, LAST-MODIFIED" - remind_support: non previsto - strategia: "ignora; usa solo STATUS:CANCELLED per soppressioni" - snippet: '# già coperto in P11' - priorita: Ignora - - - id: P20 - pattern: Categorie/etichette - ics: "CATEGORIES:…" - remind_support: parziale - strategia: "prefisso nel MSG o uso TAG se ti serve filtrare" - snippet: 'REM 2025-10-05 AT 09:00 TAG Work MSG [Work] Riunione' - priorita: Dopo *) -type event_description = - [ `Collect_uuid - | `Has_summary - | `All_day_event - | `Expand_recurrence - | `Yearly_simple_date - | `Simple_weekly_recurrence ] -[@@deriving show] - type error = Invalid_date of string | Skip [@@deriving show] let invalid_date s e = @@ -215,17 +182,22 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result = | Ok day_start -> begin match ev.dtend_or_duration with | None -> { rem with Remind.date = day_start } |> Result.ok - | Some (`Dtend (_, `Datetime _)) -> skip + | Some (`Dtend (_, `Datetime _)) -> + skip (* Start is a date, end is a datetime: invalid case for all-day event *) | Some (`Dtend (_, `Date (year, month, day))) -> begin match Timedesc.Date.Ymd.make ~year ~month ~day with | Error e -> invalid_date "DTEND" e | Ok day_end -> - let day_end = Timedesc.Date.add ~days:(-1) day_end in + let day_end = + if Timedesc.Date.lt day_start day_end then Timedesc.Date.add ~days:(-1) day_end else day_end + in if Timedesc.Date.diff_days day_end day_start = 0 then Ok { rem with Remind.date = day_start; Remind.end_date = None } else Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end } end - | Some (`Duration (_, _duration)) -> skip + | Some (`Duration (_, _duration)) -> + (* Start is a date, duration is not supported: invalid case for all-day event *) + skip end) | `Datetime datetime -> begin let start_td = Utils.timedesc_of_timestamp datetime in @@ -243,7 +215,9 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result = let rem = { rem with Remind.duration = Some duration } in Ok rem end - | `Date (_year, _month, _day) -> skip + | `Date (_year, _month, _day) -> + (* Start is a datetime, end is a date: invalid case for timed event *) + skip end | Some (`Duration (_, duration)) -> let span = Timedesc.Utils.span_of_ptime_span duration in @@ -251,18 +225,29 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result = Ok rem end -let expand_recurrence rem ev : (Remind.rem, error) result = +let collect_exdates rem ev : (Remind.rem, error) result = + let exdates = Utils.get_exdates ev in + Ok { rem with Remind.exdate = exdates } + +let expand_recurrence rem _ev : (Remind.rem, error) result = if List.length rem.Remind.recurring > 0 then skip else Ok rem let yearly_simple_date rem ev : (Remind.rem, error) result = match ev.rrule with | Some (_, (`Yearly, None, None, [])) -> let month, day = (Timedesc.Date.month rem.Remind.date, Timedesc.Date.day rem.Remind.date) in - Ok { rem with Remind.simple_yearly = Some (month, day) } + Ok { rem with Remind.yearly = Some (month, day) } | Some _ -> Ok rem | None -> Ok rem -let simple_weekly_recurrence rem ev : (Remind.rem, error) result = +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 = + (* Here we want to handle simple recurrences, both weekly and daily, but without RDATE or EXDATE or overrides *) + (* type recur = [ `Byminute of int list @@ -309,23 +294,39 @@ RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Week RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) UID: 4479f7fd-7be9-470f-bc10-5ed61636547b *) match ev.rrule with - | Some (_, (`Yearly, None, None, [])) -> Ok rem - | Some (_, (freq, count_or_until, interval, recurs)) -> - let _recur = (freq, count_or_until, interval, recurs) in - let uid = Utils.get_uid ev in - Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence _recur) uid; - skip - (* TODO: implementare *) + | Some (_, (`Yearly, None, None, [])) -> Ok rem (* handled in yearly_simple_date *) + | Some (_, (`Weekly, count_or_until, interval, recurs)) -> + begin if List.length rem.recurring > 0 || List.length rem.exdate > 0 then ( + Printf.eprintf "Warning: skipping complex recurrence with EXDATE/RDATE/overrides, not supported\t\t\tUID: %s\n" + (Utils.get_uid ev); + debug_print_of_recurrence_and_skip ev (`Weekly, count_or_until, interval, recurs)) + else + let days = + ListLabels.filter_map recurs ~f:(function + | `Byday days -> begin List.map (fun (_n, weekday) -> weekday) days |> Option.some end + | _ -> None) + |> List.flatten + in + let week_start = + ListLabels.find_map recurs ~f:(function + | `Weekday `Sunday -> Some `Sunday + | `Weekday `Monday -> Some `Monday + | _ -> None) + in + Ok { rem with Remind.weekly = Some { count_or_until; interval; byday = days; week_start } } + end + | Some (_, recurs) -> debug_print_of_recurrence_and_skip ev recurs | None -> Ok rem -let all_collectors : (collector * event_description) list = +let all_collectors : collector list = [ - (collect_uuid, `Collect_uuid); - (collect_summary, `Has_summary); - (collect_start_end_duration, `All_day_event); - (expand_recurrence, `Expand_recurrence); - (yearly_simple_date, `Yearly_simple_date); - (simple_weekly_recurrence, `Simple_weekly_recurrence); + collect_uuid; + collect_summary; + collect_start_end_duration; + collect_exdates; + expand_recurrence; + yearly_simple_date; + simple_recurrence; ] let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result = @@ -343,7 +344,7 @@ let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result = let rem = { Remind.empty with Remind.recurring = recurrence } in - ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error (pred, _desc) -> + ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error pred -> match rem_or_error with | Error e -> Error e | Ok rem -> pred rem master) diff --git a/bin/main.ml b/bin/main.ml index 17ec544..70beddc 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -58,6 +58,9 @@ let ical2rem ical_files = good_rems_acc) in - ListLabels.iter good_rems ~f:(fun rem -> Printf.printf "%s\n" (Remind.string_of_rem rem)) + 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); + exit 1 let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem) diff --git a/bin/remind.ml b/bin/remind.ml index e725b5e..75b260c 100644 --- a/bin/remind.ml +++ b/bin/remind.ml @@ -1,6 +1,17 @@ open Remind_sync open Utils +type week_first_day = [ `Sunday | `Monday ] [@@deriving show] + +type simple_weekly = { + count_or_until : Icalendar.count_or_until option; + interval : int option; (** Optional interval for weekly recurrence, default is 1 *) + byday : Icalendar.weekday list; + week_start : week_first_day option; (** First day of the week for weekly recurrence *) +} +[@@deriving show] +(** A simple weekly REM command *) + type rem = { original_uuid : string; (** Original UID from the iCalendar event *) summary : string; (** Summary or title of the reminder *) @@ -8,10 +19,12 @@ type rem = { end_date : Timedesc.Date.t option; (** Optional end date for a date range *) time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *) duration : Timedesc.Span.t option; (** Optional duration for timed events *) - simple_yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *) + yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *) + weekly : simple_weekly option; (** Optional simple weekly recurrence *) recurring : Icalendar.event list; (** List of events that are part of the same recurring series: these are only the overrides, not the master event *) + exdate : Icalendar.date_or_datetime list; (** List of excluded dates for recurring events *) } [@@deriving show] (** A complete REM command *) @@ -24,39 +37,104 @@ let empty = end_date = None; time = None; duration = None; - simple_yearly = None; + yearly = None; + weekly = None; recurring = []; + exdate = []; } -let render_simple_yearly month day summary = +let render_yearly month day summary = let month_str = month_of_int month |> string_of_month in - spf "REM %s %d MSG %s" month_str day summary + spf "REM %s %d MSG %s\n" month_str day summary -let string_of_rem rem = - match rem.simple_yearly with - | Some (month, day) -> render_simple_yearly month day rem.summary - | None -> begin - let b = Buffer.create 256 in +let render_weekly rem weekly = + let b = Buffer.create 256 in + List.iter + begin fun weekday -> Buffer.add_string b "REM "; Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid); + Buffer.add_string b (spf "%s " (string_of_weekday weekday)); Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date); + Buffer.add_string b " "; + (match weekly.interval with + | Some interval -> Buffer.add_string b (spf "*%d " (interval * 7)) + | None -> Buffer.add_string b "*7 "); + + (match weekly.count_or_until with + | Some (`Count count) -> begin + (* We must compute the until date based on the count and the interval *) + let wd = Timedesc.Date.weekday rem.date in + let wd_int = Timedesc.Utils.tm_int_of_weekday wd in + let day_to_subtract = + match weekly.week_start with + | Some `Sunday -> wd_int + | Some `Monday -> wd_int - 1 + | None -> wd_int (* Default to Sunday if not specified *) + in + let interval = Option.value ~default:1 weekly.interval in + let until_date = Timedesc.Date.add ~days:((count * 7 * interval) - day_to_subtract) rem.date in + Buffer.add_string b "UNTIL "; + Buffer.add_string b (Timedesc.Date.to_rfc3339 until_date); + Buffer.add_string b " " + end + | Some (`Until until_date) -> begin + Buffer.add_string b "UNTIL "; + let ts = timedesc_of_utc_or_timestamp_local until_date in + Buffer.add_string b (Timedesc.Date.to_rfc3339 (Timedesc.date ts)); + Buffer.add_string b " " + end + | None -> ()); + (match rem.time with | Some time -> Buffer.add_string b " AT "; Buffer.add_string b (string_of_time time) | None -> ()); + (match rem.duration with | Some duration -> Buffer.add_string b " DURATION "; Buffer.add_string b (string_of_span duration); Buffer.add_string b "" | None -> ()); - (match rem.end_date with - | Some end_date -> - Buffer.add_string b " THROUGH "; - Buffer.add_string b (Timedesc.Date.to_rfc3339 end_date) - | None -> ()); + Buffer.add_string b " MSG "; Buffer.add_string b rem.summary; - Buffer.contents b + Buffer.add_string b "\n" end + weekly.byday; + Buffer.contents b + +let string_of_rem rem = + match rem.weekly with + | Some weekly -> render_weekly rem weekly + | None -> + begin match rem.yearly with + | Some (month, day) -> render_yearly month day rem.summary + | None -> begin + let b = Buffer.create 256 in + Buffer.add_string b "REM "; + Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid); + Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date); + (match rem.time with + | Some time -> + Buffer.add_string b " AT "; + Buffer.add_string b (string_of_time time) + | None -> ()); + (match rem.duration with + | Some duration -> + Buffer.add_string b " DURATION "; + Buffer.add_string b (string_of_span duration); + Buffer.add_string b "" + | None -> ()); + (match rem.end_date with + | Some end_date -> + Buffer.add_string b " THROUGH "; + Buffer.add_string b (Timedesc.Date.to_rfc3339 end_date) + | None -> ()); + Buffer.add_string b " MSG "; + Buffer.add_string b rem.summary; + Buffer.add_string b "\n"; + Buffer.contents b + end + end diff --git a/bin/utils.ml b/bin/utils.ml index fe0322a..77a3f01 100644 --- a/bin/utils.ml +++ b/bin/utils.ml @@ -3,6 +3,15 @@ open Icalendar type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec +let string_of_weekday = function + | `Monday -> "Mon" + | `Tuesday -> "Tue" + | `Wednesday -> "Wed" + | `Thursday -> "Thu" + | `Friday -> "Fri" + | `Saturday -> "Sat" + | `Sunday -> "Sun" + let month_of_int = function | 1 -> Jan | 2 -> Feb @@ -80,28 +89,15 @@ let timedesc_of_timestamp (ts : timestamp) : Timedesc.t = let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz () -let timedesc_of_date_or_datetime (t : date_or_datetime) : Timedesc.t = - match t with - | `Datetime (`Local _ptime_ts) -> - (* this case is not present in my current dataset… *) - failwith "Unhandled case: `Local datetime" - | `Datetime (`Utc ts) -> - Timedesc.Utils.timestamp_of_ptime ts - |> Timedesc.of_timestamp_exn ~tz_of_date_time:(Timedesc.Time_zone.local_exn ()) - | `Datetime (`With_tzid (ts, (_b, tz_name))) -> - (* Qui il timestamp è SCRITTO come se fosse UTC (+00:00) ma in realtà va interpretato con - il fuso orario indicato da tz_name. *) - let tz = Timedesc.Time_zone.make_exn tz_name in - let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in - let date = Timedesc.date (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in - let year, month, day = (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date) in - let time = Timedesc.time_view (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in - let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in - Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz () - | `Date (year, month, day) -> - Timedesc.make_exn ~year ~month ~day ~hour:0 ~minute:0 ~second:0 ~tz:(Timedesc.Time_zone.local_exn ()) () +let timedesc_of_utc_or_timestamp_local (ts : utc_or_timestamp_local) : Timedesc.t = + let local_tz = Timedesc.Time_zone.local_exn () in + match ts with + | `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz + (* this case is not present in my current dataset… *) + | `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz let get_exdates ev = + let uid = get_uid ev in let event_props = ev.props in let dates_or_datetimes = List.filter_map @@ -111,36 +107,47 @@ let get_exdates ev = | _ -> None) event_props in - ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates -> - let added = + + let datetimes, dates = + ListLabels.fold_left ~init:([], []) dates_or_datetimes ~f:(fun (acc_datetimes, acc_dates) dates -> match dates with - | `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list - | `Dates date_list -> List.map (fun date -> `Date date) date_list - in - added @ acc) - |> List.map timedesc_of_date_or_datetime + | `Dates date_list -> (acc_datetimes, acc_dates @ date_list) + | `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates)) + in + + if List.length dates > 0 then Printf.eprintf "Found EXDATE with dates: %d entries; UID: %s\n" (List.length dates) uid; + if List.length datetimes > 0 then + Printf.eprintf "Found EXDATE with datetimes: %d entries; UID: %s\n" (List.length datetimes) uid; + + List.map (fun d -> `Date d) dates @ List.map (fun dt -> `Datetime dt) datetimes let get_rdates ev = + let uid = get_uid ev in let event_props = ev.props in - let dates_or_datetimes = + let dates_or_datetimes_or_periods = List.filter_map (fun prop -> match prop with - | `Rdate (_, dates) -> Some dates + | `Rdate (_, x) -> Some x | _ -> None) event_props in - ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates -> - let added = + + let datetimes, dates, periods = + ListLabels.fold_left ~init:([], [], []) dates_or_datetimes_or_periods + ~f:(fun (acc_datetimes, acc_dates, acc_periods) dates -> match dates with - | `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list - | `Dates date_list -> List.map (fun date -> `Date date) date_list - | `Periods _ -> - (* Ignored for now, does not appear in my current dataset *) - failwith "Unhandled case: `Periods in RDATE" - in - added @ acc) - |> List.map timedesc_of_date_or_datetime + | `Dates date_list -> (acc_datetimes, acc_dates @ date_list, acc_periods) + | `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates, acc_periods) + | `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 datetimes > 0 then + Printf.eprintf "Found RDATE with datetimes: %d entries; 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; + [] let get_recurrence_id ev = List.find_map