open Icalendar type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec let timedesc_wd_to_ical (wd : Timedesc.weekday) : Icalendar.weekday = match wd with | `Mon -> `Monday | `Tue -> `Tuesday | `Wed -> `Wednesday | `Thu -> `Thursday | `Fri -> `Friday | `Sat -> `Saturday | `Sun -> `Sunday let show_error (e : Timedesc.Date.Ymd.error) : string = match e with | `Does_not_exist -> "Date does not exist" | `Invalid_year y -> Printf.sprintf "Invalid year: %d" y | `Invalid_month m -> Printf.sprintf "Invalid month: %d" m | `Invalid_day d -> Printf.sprintf "Invalid day: %d" d 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 | 3 -> Mar | 4 -> Apr | 5 -> May | 6 -> Jun | 7 -> Jul | 8 -> Aug | 9 -> Sep | 10 -> Oct | 11 -> Nov | 12 -> Dec | _ -> failwith "Invalid month number" let string_of_month = function | Jan -> "Jan" | Feb -> "Feb" | Mar -> "Mar" | Apr -> "Apr" | May -> "May" | Jun -> "Jun" | Jul -> "Jul" | Aug -> "Aug" | Sep -> "Sep" | Oct -> "Oct" | Nov -> "Nov" | Dec -> "Dec" let spf = Printf.sprintf let get_uid ev = let _, uid = ev.uid in uid (* Questa funzione serve solo da esempio per copia e incolla *) let unpack_date_or_datetime (d_or_dt : Icalendar.date_or_datetime) = match d_or_dt with | `Datetime (`Local _ptime_ts) -> () | `Datetime (`Utc _ts) -> () | `Datetime (`With_tzid (_ts, (_b, _tz_name))) -> () | `Date (_year, _month, _day) -> () (* Questa funzione serve solo da esempio per copia e incolla *) let unpack_dtend_or_duration dtend_or_dur = match dtend_or_dur with | None -> () | Some (`Dtend (_, date_or_datetime)) -> unpack_date_or_datetime date_or_datetime | Some (`Duration (_, _duration)) -> () let string_of_time (t : Timedesc.Time.t) : string = let view = Timedesc.Time.view t in let hour, minute = (view.Timedesc.Time.hour, view.Timedesc.Time.minute) in spf "%02d:%02d" hour minute let string_of_span (sp : Timedesc.Span.t) : string = let view = Timedesc.Span.For_human.view sp in let hours, minutes = (view.Timedesc.Span.For_human.hours, view.Timedesc.Span.For_human.minutes) in spf "%02d:%02d" hours minutes let timedesc_of_timestamp (ts : timestamp) : 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 | `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 () 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 event_props = ev.props in let dates_or_datetimes = List.filter_map (fun prop -> match prop with | `Exdate (_, dates) -> Some dates | _ -> None) event_props in let datetimes, dates = ListLabels.fold_left ~init:([], []) dates_or_datetimes ~f:(fun (acc_datetimes, acc_dates) dates -> match dates with | `Dates date_list -> (acc_datetimes, acc_dates @ date_list) | `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates)) in 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_or_periods = List.filter_map (fun prop -> match prop with | `Rdate (_, x) -> Some x | _ -> 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 -> match dates with | `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 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 -> match prop with | `Recur_id (_, date_or_datetime) -> Some date_or_datetime | _ -> None) ev.props let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list = (* List.iteri (fun i e -> Printf.eprintf "%02d: %s\n" (i + 1) (Icalendar.show_component (`Event e))) events; *) 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) -> match recur_id_opt with | None -> Left ev (* no RECURRENCE-ID → master *) | Some _ -> Right ev (* has RECURRENCE-ID → override *)) recur_ids in match master_and_recurrences with | [], _ -> 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); (master, recurrences)