Paolo Donadeo
1372d330ff
Add a `tz` field to `rem` to carry the event's DTSTART timezone, and introduce `timedesc_of_utc_or_timestamp_tz` to convert UNTIL timestamps in that timezone instead of the process locale. This makes UNTIL comparisons locale-independent for events with a known TZID.
446 lines
19 KiB
OCaml
446 lines
19 KiB
OCaml
open Icalendar
|
||
open Utils
|
||
|
||
(* CASE ANALYSIS PREDICATES
|
||
- id: P00 ✅
|
||
pattern: Ha un SUMMARY?
|
||
ics: "SUMMARY:…"
|
||
remind_support: nativo
|
||
strategia: "REM <data> MSG <summary>"
|
||
snippet: 'REM 2025-12-25 MSG Natale'
|
||
priorita: Subito
|
||
|
||
- id: P01 ✅
|
||
pattern: All-day singolo
|
||
ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
|
||
remind_support: nativo
|
||
strategia: "REM <data> MSG <summary>"
|
||
snippet: 'REM 2025-12-25 MSG Natale'
|
||
priorita: Subito
|
||
|
||
- id: P02 ✅
|
||
pattern: All-day multi-giorno
|
||
ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "espandi in eventi giornalieri; stesso SUMMARY"
|
||
snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno'
|
||
priorita: Subito
|
||
|
||
- id: P03 ✅
|
||
pattern: Evento a orario locale
|
||
ics: "DTSTART;TZID=… + DTEND oppure DURATION"
|
||
remind_support: nativo
|
||
strategia: "REM <data> AT <hh:mm> [DURATION] MSG …"
|
||
snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
|
||
priorita: Subito
|
||
|
||
- id: P04 ✅
|
||
pattern: Evento a orario in UTC
|
||
ics: "DTSTART/DTEND con suffisso Z"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "converti a fuso locale prima di emettere AT"
|
||
snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
|
||
priorita: Subito
|
||
|
||
- id: P05 ✅
|
||
pattern: Ricorrenza settimanale semplice
|
||
ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
|
||
remind_support: nativo
|
||
strategia: "REM <giorni> FROM <start> [UNTIL <end>] AT <hh:mm> MSG …"
|
||
snippet: 'REM Mon Wed FROM 2025-09-01 UNTIL 2025-10-31 AT 09:00 MSG Standup'
|
||
priorita: Subito
|
||
|
||
- id: P06 ✅
|
||
pattern: Ricorrenza giornaliera semplice
|
||
ics: "RRULE:FREQ=DAILY;[UNTIL|COUNT]"
|
||
remind_support: nativo
|
||
strategia: "REM FROM <start> UNTIL <end> AT <hh:mm> EVERY 1 MSG …"
|
||
snippet: 'REM FROM 2025-10-01 UNTIL 2025-10-10 AT 08:30 MSG Daily'
|
||
priorita: Subito
|
||
|
||
- id: P07 ✅
|
||
pattern: Ricorrenza mensile per giorno fisso
|
||
ics: "RRULE:FREQ=MONTHLY;BYMONTHDAY=…"
|
||
remind_support: nativo
|
||
strategia: "REM <giorno-num> AT <hh:mm> FROM/UNTIL"
|
||
snippet: 'REM 15 AT 10:00 FROM 2025-01-01 MSG Fatture'
|
||
priorita: Dopo
|
||
|
||
- id: P08 ✅
|
||
pattern: Ricorrenza “n-esimo weekday” del mese
|
||
ics: "RRULE:FREQ=MONTHLY;BYDAY=MO;BYSETPOS=3"
|
||
remind_support: espansione
|
||
strategia: "materializza occorrenze in singoli REM o calcola in codice"
|
||
snippet: '# genera REM per ciascuna data calcolata'
|
||
priorita: Dopo
|
||
|
||
- id: P09 ✅
|
||
pattern: Ricorrenza annuale semplice
|
||
ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
|
||
remind_support: nativo
|
||
strategia: "REM <data ricorrente> MSG …"
|
||
snippet: 'REM Jul 29 MSG Compleanno'
|
||
priorita: Dopo
|
||
|
||
- id: P10 ✅
|
||
pattern: Eccezioni
|
||
ics: "EXDATE (una o più), RDATE aggiuntive"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "usa OMIT per rimuovere date; aggiungi REM singoli per RDATE"
|
||
snippet: 'REM Mon AT 09:00 FROM 2025-09-01 UNTIL 2025-10-31 MSG Standup\nOMIT 2025-10-13'
|
||
priorita: Subito
|
||
|
||
- id: P11 ✅
|
||
pattern: Override/cancellazioni per istanza
|
||
ics: "RECURRENCE-ID con contenuto modificato o STATUS:CANCELLED"
|
||
remind_support: espansione
|
||
strategia: "OMIT la data dalla serie; aggiungi REM singolo con i campi override"
|
||
snippet: '# serie + REM specifico per l’istanza'
|
||
priorita: Subito
|
||
|
||
- id: P12 ✅
|
||
pattern: DURATION al posto di DTEND
|
||
ics: "DURATION:PT…"
|
||
remind_support: nativo
|
||
strategia: "mappa su DURATION <h:mm> in REM"
|
||
snippet: 'REM 2025-10-05 AT 14:00 DURATION 2:30 MSG Workshop'
|
||
priorita: Subito
|
||
|
||
- id: P13
|
||
pattern: Allarmi
|
||
ics: "VALARM DISPLAY/AUDIO/EMAIL; TRIGGER relativo"
|
||
remind_support: parziale
|
||
strategia: "mappa 1 allarme principale su WARN; multipli opzionali come REM duplicati HIDE"
|
||
snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
|
||
priorita: Dopo
|
||
|
||
- id: P14 ✅
|
||
pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
|
||
ics: "VTIMEZONE + DTSTART;TZID=…"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "normalizza tutto al fuso locale del sistema prima dell’output"
|
||
snippet: '# conversione in pre-processing'
|
||
priorita: Subito
|
||
|
||
- id: P15
|
||
pattern: Partecipanti/organizzatore
|
||
ics: "ORGANIZER, ATTENDEE*, PARTSTAT…"
|
||
remind_support: non previsto
|
||
strategia: "appendi a DESCRIPTION/MSG come testo"
|
||
snippet: '# nessuna semantica in Remind'
|
||
priorita: Quando serve
|
||
|
||
- id: P16
|
||
pattern: Allegati/URL esterni
|
||
ics: "ATTACH, URL"
|
||
remind_support: non previsto
|
||
strategia: "conserva URL in coda al MSG"
|
||
snippet: '# link nel testo'
|
||
priorita: Quando serve
|
||
|
||
- id: P17
|
||
pattern: Meeting online (Google/Teams metadati)
|
||
ics: "X-GOOGLE-CONFERENCE, X-MICROSOFT-*"
|
||
remind_support: non previsto
|
||
strategia: "estrai solo URL di join nel MSG"
|
||
snippet: '# riduci al link'
|
||
priorita: Quando serve
|
||
*)
|
||
|
||
type error = Invalid_date of string | Skip
|
||
|
||
let invalid_date s e = Error (Invalid_date (spf "Invalid date: %s, error: %s" s (show_error e)))
|
||
let skip = Error Skip
|
||
|
||
type collector = Remind.rem -> event -> (Remind.rem, error) result
|
||
|
||
let collect_uuid rem ev : (Remind.rem, error) result =
|
||
let uid = Utils.get_uid ev in
|
||
Ok { rem with Remind.original_uuid = uid }
|
||
|
||
let collect_summary rem ev : (Remind.rem, error) result =
|
||
let summary_opt =
|
||
List.find_map
|
||
(function
|
||
| `Summary (_, s) -> Some s
|
||
| _ -> None)
|
||
ev.props
|
||
in
|
||
match summary_opt with
|
||
| Some s -> Ok { rem with Remind.summary = s }
|
||
| None -> Ok { rem with Remind.summary = "" }
|
||
|
||
let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||
let _, dtstart = ev.dtstart in
|
||
match dtstart with
|
||
| `Date (year, month, day) -> (
|
||
match Timedesc.Date.Ymd.make ~year ~month ~day with
|
||
| Error e -> invalid_date "DTSTART" e
|
||
| Ok day_start ->
|
||
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 *)
|
||
| 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 =
|
||
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)) ->
|
||
(* DATE + DURATION: compute end_date as start + duration_in_days - 1 *)
|
||
let days, _ = Ptime.Span.to_d_ps duration in
|
||
if days <= 1 then Ok { rem with Remind.date = day_start; Remind.end_date = None }
|
||
else
|
||
let day_end = Timedesc.Date.add ~days:(days - 1) day_start in
|
||
Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
|
||
end)
|
||
| `Datetime datetime -> begin
|
||
let start_td = Utils.timedesc_of_timestamp datetime in
|
||
let rem =
|
||
{
|
||
rem with
|
||
Remind.date = Timedesc.date start_td;
|
||
Remind.time = Some (Timedesc.time start_td);
|
||
Remind.tz = Some (Timedesc.tz start_td);
|
||
}
|
||
in
|
||
|
||
match ev.dtend_or_duration with
|
||
| None -> Ok rem
|
||
| Some (`Dtend (_, date_or_datetime)) ->
|
||
begin match date_or_datetime with
|
||
| `Datetime datetime -> begin
|
||
let end_td = Utils.timedesc_of_timestamp datetime in
|
||
let duration =
|
||
Timedesc.Span.sub (Timedesc.to_timestamp_single end_td) (Timedesc.to_timestamp_single start_td)
|
||
in
|
||
let rem = { rem with Remind.duration = Some duration } in
|
||
Ok rem
|
||
end
|
||
| `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
|
||
let rem = { rem with Remind.duration = Some span } in
|
||
Ok rem
|
||
end
|
||
|
||
let collect_exdates rem ev : (Remind.rem, error) result =
|
||
let exdates = Utils.get_exdates ev in
|
||
Ok { rem with Remind.exdate = exdates }
|
||
|
||
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.yearly = Some (month, day) }
|
||
| 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 =
|
||
(* Here we want to handle simple recurrences, both weekly and daily, but without RDATE or EXDATE or overrides *)
|
||
|
||
(*
|
||
type recur =
|
||
[ `Byminute of int list
|
||
| `Byday of (int * weekday) list
|
||
| `Byhour of int list
|
||
| `Bymonth of int list
|
||
| `Bymonthday of int list
|
||
| `Bysecond of int list
|
||
| `Bysetposday of int list
|
||
| `Byweek of int list
|
||
| `Byyearday of int list
|
||
| `Weekday of weekday ]
|
||
[@@deriving show]
|
||
|
||
type freq = [ `Daily | `Hourly | `Minutely | `Monthly | `Secondly | `Weekly | `Yearly ] [@@deriving show]
|
||
type count_or_until = [ `Count of int | `Until of utc_or_timestamp_local (* TODO date or datetime *) ] [@@deriving show]
|
||
type interval = int [@@deriving show]
|
||
type recurrence = freq * count_or_until option * interval option * recur list [@@deriving show]
|
||
|
||
QUESTE SONO **TUTTE** LE RRULE NEL MIO DATASET
|
||
|
||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0b48208b22php2mv6r157rk23v@google.com
|
||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0cb95edhq1d00bd3gcpomb9mcg@google.com
|
||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0kbt3i5d6dpq6uncmhlcr335vq@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 11:15:00 +00:00))), None, [`Weekday (`Monday)]) UID: dmkfr0h3p1fq6p6v8i62vm1n4k@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 15:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: bh5mhev3uq6p5casisrqufksd8@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-24 22:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: tsdjd2jlcsgi0c0ei1celg41v4@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-25 10:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: ha0rjkp62uqh3boc9n6k4f6cuo@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2025-05-22 07:00:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E008000000008FD3AF9B24B9DB01000000000000000010000000A152B8147DB736439366702297C68F98
|
||
RRULE: (`Daily, (Some `Until (`Utc (2026-02-04 13:30:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E00800000000CEF108493A94DC010000000000000000100000005D7F32754B6575419990179984830EFC
|
||
RRULE: (`Weekly, (Some `Count (3)), None, [`Byday ([(0, `Wednesday)])]) UID: 605de987-4600-419f-a40a-eb585b7e1ba2
|
||
RRULE: (`Weekly, (Some `Count (7)), (Some 2), [`Byday ([(0, `Tuesday)])]) UID: 13C-6A06C880-D-48221A00
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2009-07-31 18:00:00 +00:00))), None, [`Byday ([(0, `Tuesday); (0, `Friday)]); `Weekday (`Monday)]) UID: hrpg4ovdou2ae57pqb9niobb3c@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2013-04-18 17:30:00 +00:00))), None, [`Byday ([(0, `Monday); (0, `Thursday)])]) UID: ool8g85jgfd5db57mdqbkt52nk@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2014-12-20 10:30:00 +00:00))), None, [`Byday ([(0, `Saturday)])]) UID: rr96e7fr98g8j9vner8mmdtfls@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2020-09-16 21:59:59 +00:00))), None, [`Byday ([(0, `Thursday)])]) UID: 5n174r33j7ep7t5eete9307949@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2021-08-25 21:59:59 +00:00))), None, [`Byday ([(0, `Wednesday)]); `Weekday (`Monday)]) UID: 20kb6se0oog5e9hi5l7uu6jiq6@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2021-09-18 21:59:59 +00:00))), (Some 1), [`Byday ([(0, `Sunday)]); `Weekday (`Monday)]) UID: 6sp30e9oc4sjebb264o3gb9kcos3ab9pccoj2b9j6kom2chjcco6ad9nck@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2024-06-12 08:00:00 +00:00))), (Some 4), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: 040000008200E00074C5B7101A82E00800000000DD1EB23CE8ACDA01000000000000000010000000FED71D085A97144F8C716EC999301E3A
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2025-02-04 22:59:59 +00:00))), (Some 1), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: _60q30c1g60o30e1i60o4ac1g60rj8gpl88rj2c1h84s34h9g60s30c1g60o30c1g85248hhg6kq30hhn6ork8ghg64o30c1g60o30c1g60o30c1g60o32c1g60o30c1g6kqj4g9g89234chl852kadpk890j2h9m6op44dpn6t238h1k8ks0_R20250129T080000@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2025-06-22 21:59:59 +00:00))), (Some 1), [`Weekday (`Monday); `Byday ([(0, `Monday)])]) UID: 040000008200E00074C5B7101A82E00800000000AE5AF0ED6ADCDB0100000000000000001000000040E4ACABB0843749950BEB4B273F862E
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2026-02-24 22:59:59 +00:00))), (Some 2), [`Weekday (`Monday); `Byday ([(0, `Tuesday)])]) UID: fjlqvi1ekuefpa8rb65meoklct@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Weekday (`Monday); `Byday ([(0, `Wednesday)])]) UID: 1iue0uq2l3imtfdsff785o9u35@google.com
|
||
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 (* 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.get_uid ev);
|
||
debug_print_of_recurrence_and_skip ev (freq, 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
|
||
match freq with
|
||
| `Daily -> Ok { rem with Remind.weekly = None; Remind.daily = Some { count_or_until; interval; week_start } }
|
||
| `Weekly ->
|
||
let days = if days = [] then [ timedesc_wd_to_ical (Timedesc.Date.weekday rem.date) ] else days in
|
||
Ok
|
||
{
|
||
rem with
|
||
Remind.daily = 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
|
||
|
||
let is_cancelled (ev : Icalendar.event) : bool =
|
||
List.exists
|
||
(function
|
||
| `Status (_, `Cancelled) -> true
|
||
| _ -> false)
|
||
ev.props
|
||
|
||
let build_override_rem (source : string) (override_ev : Icalendar.event) : (Remind.rem, error) result =
|
||
let rem = { Remind.empty with Remind.source } in
|
||
let collectors = [ collect_uuid; collect_summary; collect_start_end_duration ] in
|
||
ListLabels.fold_left ~init:(Ok rem) collectors ~f:(fun rem_or_error pred ->
|
||
match rem_or_error with
|
||
| Error e -> Error e
|
||
| Ok rem -> pred rem override_ev)
|
||
|
||
let collect_overrides rem _ev : (Remind.rem, error) result =
|
||
(* Process each RECURRENCE-ID override event stored in rem.recurring:
|
||
- add its RECURRENCE-ID date to rem.exdate (feeds the OMIT mechanism)
|
||
- for non-cancelled overrides, build a single REM and add to rem.overrides *)
|
||
let new_exdates, new_overrides =
|
||
ListLabels.fold_left ~init:([], []) rem.Remind.recurring ~f:(fun (exdates, overrides) override_ev ->
|
||
let recur_id_opt = Utils.get_recurrence_id override_ev in
|
||
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);
|
||
exdates
|
||
| Some date_or_dt -> date_or_dt :: exdates
|
||
in
|
||
let overrides =
|
||
if is_cancelled override_ev then overrides
|
||
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);
|
||
overrides
|
||
| Ok override_rem -> override_rem :: overrides
|
||
in
|
||
(exdates, overrides))
|
||
in
|
||
Ok
|
||
{
|
||
rem with
|
||
Remind.exdate = rem.Remind.exdate @ List.rev new_exdates;
|
||
Remind.overrides = List.rev new_overrides;
|
||
Remind.recurring = [];
|
||
}
|
||
|
||
let all_collectors : collector list =
|
||
[
|
||
collect_uuid;
|
||
collect_summary;
|
||
collect_start_end_duration;
|
||
collect_exdates;
|
||
collect_overrides;
|
||
yearly_simple_date;
|
||
simple_recurrence;
|
||
]
|
||
|
||
let remind_of_event (source : string) (ev : Icalendar.event list) : (Remind.rem, error) result =
|
||
let () = if List.length ev = 0 then failwith "No events provided" in
|
||
|
||
let master, recurrence =
|
||
if List.length ev > 1 then begin
|
||
separate_master_and_recurrence ev
|
||
end
|
||
else begin
|
||
let ev = List.hd ev in
|
||
(ev, [])
|
||
end
|
||
in
|
||
|
||
let rem = { Remind.empty with Remind.source; Remind.recurring = recurrence } in
|
||
|
||
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)
|