open Utils type week_first_day = [ `Sunday | `Monday ] 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 *) } (** A simple weekly REM command *) type simple_daily = { count_or_until : Icalendar.count_or_until option; interval : int option; (** Optional interval for daily recurrence, default is 1 *) week_start : week_first_day option; (** First day of the week for weekly recurrence *) } (** 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 *) summary : string; (** Summary or title of the reminder *) location : string option; (** Optional location of the event *) description : string option; (** Optional description of the event *) date : Timedesc.Date.t; (** Date specification (day, month, year) *) 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 *) 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; (** 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 *) overrides : rem list; (** Single-event REMs generated from non-cancelled RECURRENCE-ID overrides *) tz : Timedesc.Time_zone.t option; (** Timezone of the event's DTSTART, used for UNTIL conversion *) } (** A complete REM command *) let empty = { source = ""; original_uuid = ""; summary = ""; location = None; description = None; date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1; end_date = None; time = None; duration = None; yearly = None; monthly = None; weekly = None; daily = None; recurring = []; exdate = []; overrides = []; tz = None; } (* ── 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_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)) let add_interval b (w : simple_weekly) = let n = Option.value ~default:1 w.interval in Buffer.add_string b (spf "*%d " (n * 7)) let add_interval_daily b (d : simple_daily) = let n = Option.value ~default:1 d.interval in Buffer.add_string b (spf "*%d " n) (** Adjust an UNTIL date: if the event has a start time and the local time of the UNTIL timestamp is strictly before that start time, the last valid occurrence is on the previous day. *) let until_date_adjusted (until_ts : Timedesc.t) (event_time : Timedesc.Time.t option) : Timedesc.Date.t = let until_date = Timedesc.date until_ts in match event_time with | None -> until_date | Some evt_t -> let until_t = Timedesc.time until_ts in let cmp = Timedesc.Span.compare (Timedesc.Time.to_span until_t) (Timedesc.Time.to_span evt_t) in if cmp < 0 then Timedesc.Date.add ~days:(-1) until_date else until_date let add_until b rem (w : simple_weekly) = match w.count_or_until with | None -> () | Some (`Until d) -> let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in let ts = timedesc_of_utc_or_timestamp_tz tz d 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 wd = Timedesc.Date.weekday rem.date in let wd_int = Timedesc.Utils.tm_int_of_weekday wd in let sub = match w.week_start with | Some `Monday -> wd_int - 1 | _ -> wd_int in let iv = Option.value ~default:1 w.interval in let until = Timedesc.Date.add ~days:((count * 7 * iv) - sub) rem.date in Buffer.add_string b (spf "UNTIL %s " (Timedesc.Date.to_rfc3339 until)) let add_until_daily b rem (d : simple_daily) = match d.count_or_until with | None -> () | Some (`Until dt) -> let tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in let ts = timedesc_of_utc_or_timestamp_tz tz 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 iv = Option.value ~default:1 d.interval in 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 tz = Option.value ~default:(Timedesc.Time_zone.local_exn ()) rem.tz in let ts = timedesc_of_utc_or_timestamp_tz tz 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 -> () let add_duration b = function | Some d -> Buffer.add_string b (spf " DURATION %s" (string_of_span d)) | None -> () let add_through b = function | Some d -> Buffer.add_string b (spf " THROUGH %s" (Timedesc.Date.to_rfc3339 d)) | None -> () (** Escape special characters in the body of a MSG clause. - '%' must become '%%' (literal percent) - '[' must become '["["]' (a Remind expression that evaluates to the literal string "[") *) let escape_msg s = let buf = Buffer.create (String.length s) in String.iter (function | '\n' -> Buffer.add_string buf "\\n" | '\t' -> () | '"' -> Buffer.add_string buf "\\\"" | '%' -> Buffer.add_string buf "%%" | '[' -> Buffer.add_string buf {|["["]|} | c -> Buffer.add_char buf c) s; Buffer.contents buf let add_msg b summary = Buffer.add_string b (spf " MSG %s\n" (escape_msg summary)) 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 -> () 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 -> () let date_of_date_or_datetime (d : Icalendar.date_or_datetime) : Timedesc.Date.t = match d with | `Date (year, month, day) -> Timedesc.Date.Ymd.make_exn ~year ~month ~day | `Datetime ts -> Timedesc.date (timedesc_of_timestamp ts) let add_omit b (d : Icalendar.date_or_datetime) = let date = date_of_date_or_datetime d in let day = Timedesc.Date.day date in let month = string_of_month (month_of_int (Timedesc.Date.month date)) in let year = Timedesc.Date.year date in Buffer.add_string b (spf "OMIT %d %s %d\n" day month year) let add_omit_context b exdates = if exdates <> [] then begin Buffer.add_string b "PUSH-OMIT-CONTEXT\n"; List.iter (add_omit b) exdates end let close_omit_context b exdates = if exdates <> [] then Buffer.add_string b "POP-OMIT-CONTEXT\n" let add_skip b exdates = if exdates <> [] then Buffer.add_string b "SKIP " (* ── rendering ────────────────────────────────────────────────── *) let render_daily rem (d : simple_daily) = let b = Buffer.create 256 in add_omit_context b rem.exdate; add_rem b; add_uid b rem.original_uuid; add_source b rem.source; add_location b rem.location; add_description b rem.description; add_date b rem.date; Buffer.add_char b ' '; add_interval_daily b d; add_until_daily b rem d; 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_weekly rem (w : simple_weekly) = let b = Buffer.create 256 in add_omit_context b rem.exdate; List.iter (fun wd -> add_rem b; add_uid b rem.original_uuid; add_source b rem.source; add_location b rem.location; add_description b rem.description; add_weekday b wd; add_date b rem.date; Buffer.add_char b ' '; add_interval b w; add_until b rem w; add_skip b rem.exdate; add_at b rem.time; add_duration b rem.duration; add_msg b rem.summary) w.byday; 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_uid b rem.original_uuid; add_source b rem.source; add_location b rem.location; add_description b rem.description; (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; add_uid b rem.original_uuid; add_source b rem.source; add_location b rem.location; add_description b rem.description; add_date b rem.date; add_at b rem.time; add_duration b rem.duration; add_through b rem.end_date; add_msg b rem.summary; Buffer.contents b let render_yearly rem month day = let b = Buffer.create 64 in add_rem b; add_uid b rem.original_uuid; add_source b rem.source; add_location b rem.location; add_description b rem.description; Buffer.add_string b (spf "%s %d" (month_of_int month |> string_of_month) day); add_msg b rem.summary; Buffer.contents b (* ── dispatcher ───────────────────────────────────────────────── *) let string_of_rem rem = let main = match rem.daily with | Some d -> render_daily rem d | None -> ( match rem.weekly with | Some w -> render_weekly rem w | None -> ( 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)