open Remind_sync open Icalendar type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec 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_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 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 ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates -> let added = 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 let get_rdates ev = let event_props = ev.props in let dates_or_datetimes = List.filter_map (fun prop -> match prop with | `Rdate (_, dates) -> Some dates | _ -> None) event_props in ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates -> let added = 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 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 -> Right ev | Some _ -> Left ev) recur_ids in match master_and_recurrences with | [], _ -> failwith "No master event found" | master :: _, recurrences -> (master, recurrences)