diff --git a/bin/eventPredicates.ml b/bin/eventPredicates.ml index 889f550..cbd1bcc 100644 --- a/bin/eventPredicates.ml +++ b/bin/eventPredicates.ml @@ -58,7 +58,7 @@ open Utils snippet: 'REM FROM 2025-10-01 UNTIL 2025-10-10 AT 08:30 MSG Daily' priorita: Subito - - id: P07 + - id: P07 ✅ pattern: Ricorrenza mensile per giorno fisso ics: "RRULE:FREQ=MONTHLY;BYMONTHDAY=…" remind_support: nativo @@ -66,7 +66,7 @@ open Utils snippet: 'REM 15 AT 10:00 FROM 2025-01-01 MSG Fatture' priorita: Dopo - - id: P08 + - id: P08 ✅ pattern: Ricorrenza “n-esimo weekday” del mese ics: "RRULE:FREQ=MONTHLY;BYDAY=MO;BYSETPOS=3" remind_support: espansione @@ -323,6 +323,38 @@ RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) Remind.weekly = Some { count_or_until; interval; byday = days; week_start }; } end + | 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) + | _ -> ( + let bymonthday = + List.find_map + (function + | `Bymonthday (d :: _) -> Some d + | _ -> None) + recurs + in + let byday = + List.find_map + (function + | `Byday pairs -> List.find_map (fun (n, wd) -> if n <> 0 then Some (n, wd) else None) pairs + | _ -> None) + recurs + in + let pattern = + match (bymonthday, byday) with + | _, Some (n, wd) -> Some (Remind.By_nth_weekday (n, wd)) (* BYDAY takes precedence *) + | Some day, None -> Some (Remind.By_month_day day) + | None, None -> Some (Remind.By_month_day (Timedesc.Date.day rem.Remind.date)) + 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) + | 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 | None -> Ok rem diff --git a/bin/remind.ml b/bin/remind.ml index 9b9a6ac..0f988e0 100644 --- a/bin/remind.ml +++ b/bin/remind.ml @@ -17,6 +17,17 @@ type simple_daily = { } (** A simple daily REM command *) +type monthly_pattern = + | By_month_day of int (** P07: BYMONTHDAY=n or implicit day from DTSTART *) + | By_nth_weekday of int * Icalendar.weekday (** P08: BYDAY=nWD, n≠0, can be negative *) + +type simple_monthly = { + count_or_until : Icalendar.count_or_until option; + interval : int option; + pattern : monthly_pattern; +} +(** A simple monthly REM command *) + type rem = { source : string; (** Source file or identifier for the reminder *) original_uuid : string; (** Original UID from the iCalendar event *) @@ -26,6 +37,7 @@ type rem = { time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *) duration : Timedesc.Span.t option; (** Optional duration for timed events *) yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *) + monthly : simple_monthly option; (** Optional simple monthly recurrence *) weekly : simple_weekly option; (** Optional simple weekly recurrence *) daily : simple_daily option; (** Optional simple daily recurrence *) recurring : Icalendar.event list; @@ -46,6 +58,7 @@ let empty = time = None; duration = None; yearly = None; + monthly = None; weekly = None; daily = None; recurring = []; @@ -111,6 +124,22 @@ let add_until_daily b rem (d : simple_daily) = let until = Timedesc.Date.add ~days:((count - 1) * iv) rem.date in Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until)) +let add_until_monthly b rem (m : simple_monthly) = + match m.count_or_until with + | None -> () + | Some (`Until dt) -> + let ts = timedesc_of_utc_or_timestamp_local dt in + let date = until_date_adjusted ts rem.time in + Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 date)) + | Some (`Count count) -> + let base = Utils.add_months rem.date (count - 1) in + let until = + match m.pattern with + | By_month_day _ -> base + | By_nth_weekday _ -> Timedesc.Date.add ~days:6 base (* weekday can shift up to 6 days *) + in + Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until)) + let add_at b = function | Some t -> Buffer.add_string b (spf " AT %s" (string_of_time t)) | None -> () @@ -199,6 +228,31 @@ let render_weekly rem (w : simple_weekly) = close_omit_context b rem.exdate; Buffer.contents b +let render_monthly rem (m : simple_monthly) = + let b = Buffer.create 256 in + add_omit_context b rem.exdate; + add_rem b; + add_info b rem.original_uuid; + add_source b rem.source; + (match m.pattern with + | By_month_day day -> Buffer.add_string b (spf "%d " day) + | By_nth_weekday (n, wd) when n > 0 -> + let day = ((n - 1) * 7) + 1 in + add_weekday b wd; + Buffer.add_string b (spf "%d " day) + | By_nth_weekday (n, wd) (* n < 0 *) -> + let back = -n * 7 in + add_weekday b wd; + Buffer.add_string b (spf "1 --%d " back)); + Buffer.add_string b (spf "FROM %s " (Timedesc.Date.to_rfc3339 rem.date)); + add_until_monthly b rem m; + add_skip b rem.exdate; + add_at b rem.time; + add_duration b rem.duration; + add_msg b rem.summary; + close_omit_context b rem.exdate; + Buffer.contents b + let render_single rem = let b = Buffer.create 256 in add_rem b; @@ -230,9 +284,12 @@ let string_of_rem rem = match rem.weekly with | Some w -> render_weekly rem w | None -> ( - match rem.yearly with - | Some (month, day) -> render_yearly rem month day - | None -> render_single rem)) + match rem.monthly with + | Some m -> render_monthly rem m + | None -> ( + match rem.yearly with + | Some (month, day) -> render_yearly rem month day + | None -> render_single rem))) in let overrides = List.map render_single rem.overrides in String.concat "" (main :: overrides) diff --git a/bin/utils.ml b/bin/utils.ml index 9af9901..e1cd9d7 100644 --- a/bin/utils.ml +++ b/bin/utils.ml @@ -160,6 +160,20 @@ let get_rdates ev = Printf.eprintf "Found RDATE with periods: %d entries; UID: %s\n" (List.length periods) uid; [] +let add_months (date : Timedesc.Date.t) (n : int) : Timedesc.Date.t = + let year = Timedesc.Date.year date in + let month = Timedesc.Date.month date in + let day = Timedesc.Date.day date in + let total_months = (year * 12) + (month - 1) + n in + let new_year = total_months / 12 in + let new_month = (total_months mod 12) + 1 in + let rec try_day d = + match Timedesc.Date.Ymd.make ~year:new_year ~month:new_month ~day:d with + | Ok date -> date + | Error _ -> try_day (d - 1) + in + try_day day + let get_recurrence_id ev = List.find_map (fun prop ->