Initial commit

bin/utils.ml

@@ -0,0 +1,167 @@
+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)