refactor: replace predicate-based event matching with collector pipeline

- Simplify `.ocamlformat` to use `default` profile with fewer overrides
- Extract shared types and utilities into a `remind_sync` library
  (`icalendar_augmented`, `ptime_augmented`, `timedesc_augmented`,
  `result_augmented`, `utf8`)
- Replace `eventTransformer.ml` and the predicate system in
  `eventPredicates.ml` with a sequential collector pipeline
  (`collect_uuid`, `collect_summary`, `collect_start_end_duration`,
  etc.)
- Simplify `Remind.rem` to a flat record with `Timedesc` date/time
  fields and replace `rem_to_string` with a leaner `string_of_rem`
- Add `separate_master_and_recurrence` and `get_recurrence_id` helpers
  to `utils.ml`
- Wire `main.ml` to call `EventPredicates.remind_of_event` per UID group
  and print results directly
- Remove `eventTransformer` module from `bin/dune` and enable the
  `remind_sync` library dependency

.ocamlformat

@@ -1,19 +1,7 @@
+profile = default
 version = 0.29.0
-profile = conventional
 
+margin = 120
 break-cases = fit-or-vertical
 break-infix = fit-or-vertical
-break-separators = after
-cases-exp-indent = 2
 exp-grouping = preserve
-if-then-else = keyword-first
-leading-nested-match-parens = false
-let-and = sparse
-margin = 120
-space-around-arrays = false
-space-around-lists = false
-space-around-records = false
-space-around-records = true
-space-around-variants = false
-type-decl = sparse
-wrap-fun-args = false

bin/dune

@@ -1,11 +1,11 @@
 (executable
  (public_name remind_sync)
  (name main)
- (modules main commandLine remind eventTransformer eventPredicates utils)
+ (modules main commandLine remind eventPredicates utils)
  (preprocess
   (pps ppx_deriving.show))
  (libraries
-  ;remind_sync
+  remind_sync
   cmdliner
   icalendar
   timedesc-tzdb.full

bin/eventPredicates.ml

@@ -1,3 +1,4 @@
+open Remind_sync
 open Icalendar
 open Utils
 
@@ -172,186 +173,159 @@ open Utils
 *)
 
 type event_description =
-  [ `Has_summary (* P00 *)
+  [ `Collect_uuid | `Has_summary | `All_day_event | `Expand_recurrence | `Simple_weekly_recurrence ]
-  | `All_day_event_single (* P01 *)
-  | `All_day_event_multi (* P02 *)
-  | `Timed_event (* P03 and P04 *)
-  | `Weekly_simple_recurrence (* P05 *)
-  | `Daily_simple_recurrence (* P06 *)
-  | `Exception_events (* P10 *)
-  | `Override_events (* P11 *) ]
 [@@deriving show]
 
-type features =
+type error = Invalid_date of string | Skip [@@deriving show]
-  | Generic_feature_presence (* TODO: TO BE REMOVED *)
-  | Summary of string
-  | Day_start of int * int * int (* year, month, day *)
-  | Multi_day of int (* number of days *)
-[@@deriving show]
 
-type predicate = Icalendar.event -> features list option
+let invalid_date s e =
+  Error (Invalid_date (spf "Invalid date: %s, error: %s" s (Remind_sync.Timedesc.Date.Ymd.show_error e)))
 
-let has_summary ev : features list option =
+let skip = Error Skip
-  (* P00 *)
+
+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 [Summary s]
+        | `Summary (_, s) -> Some s
         | _ -> None)
       ev.props
   in
   match summary_opt with
-  | Some s -> Some s
+  | Some s -> Ok { rem with Remind.summary = s }
-  | None -> None
+  | None -> Ok { rem with Remind.summary = "" }
 
-let all_day_event_single ev : features list option =
+let collect_start_end_duration rem ev : (Remind.rem, error) result =
-  (* P01 *)
   let _, dtstart = ev.dtstart in
   match dtstart with
-  | `Date d ->
+  | `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 ->
+          | None -> { rem with Remind.date = day_start } |> Result.ok
-      let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
+          | Some (`Dtend (_, `Datetime _)) -> skip
-      Some [Day_start (y, m, d)]
+          | Some (`Dtend (_, `Date (year, month, day))) ->
-    | Some (`Dtend (_, `Date end_)) -> begin
+              begin match Timedesc.Date.Ymd.make ~year ~month ~day with
-      let start_dt = Ptime.of_date d |> Option.get in
+              | Error e -> invalid_date "DTEND" e
-      let end_dt = Ptime.of_date end_ |> Option.get in
+              | Ok day_end ->
-      if Ptime.diff end_dt start_dt = Ptime.Span.of_int_s 86400
+                  let day_end = Timedesc.Date.add ~days:(-1) day_end in
-      then
+                  if Timedesc.Date.diff_days day_end day_start = 0 then
-        let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
+                    Ok { rem with Remind.date = day_start; Remind.end_date = None }
-        Some [Day_start (y, m, d)]
+                  else Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
-      else None
               end
-    | _ -> None
+          | Some (`Duration (_, _duration)) -> skip
-    end
+          end)
-  | _ -> None
+  | `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) } in
 
-let all_day_event_multi ev : features list option =
+      match ev.dtend_or_duration with
-  (* P02 *)
+      | None -> Ok rem
-  let _, dtstart = ev.dtstart in
+      | Some (`Dtend (_, date_or_datetime)) ->
-  match dtstart with
+          begin match date_or_datetime with
-  | `Date d ->
+          | `Datetime datetime -> begin
-    begin match ev.dtend_or_duration with
+              let end_td = Utils.timedesc_of_timestamp datetime in
-    | None -> None
+              let duration =
-    | Some (`Dtend (_, `Date end_)) -> begin
+                Timedesc.Span.sub (Timedesc.to_timestamp_single end_td) (Timedesc.to_timestamp_single start_td)
-      let start_dt = Ptime.of_date d |> Option.get in
-      let end_dt = Ptime.of_date end_ |> Option.get in
-      if Ptime.diff end_dt start_dt > Ptime.Span.of_int_s 86400
-      then
-        (* Actually compute the number of days *)
-        let num_days = Ptime.diff end_dt start_dt |> Ptime.Span.to_int_s |> fun s -> Option.get s / 86400 in
-        let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
-        Some [Day_start (y, m, d); Multi_day num_days]
-      else None
-      end
-    | Some (`Duration (_, span)) -> begin
-      let days, _ps = Ptime.Span.to_d_ps span in
-      let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
-      Some [Day_start (y, m, d); Multi_day days]
-      end
-    | Some (`Dtend (_, `Datetime _)) -> None
-    end
-  | _ -> None
-
-let timed_event ev : features list option =
-  (* P03 and P04 *)
-  let _, dtstart = ev.dtstart in
-  let start_td = get_start ev in
-  let uid = get_uid ev in
-  match dtstart with
-  | `Datetime (`Local _) -> begin
-    Printf.printf "Local time event: %s\n" uid;
-    Printf.printf "  Timedesc: %s\n" (start_td |> Timedesc.to_rfc3339);
-    Some [Generic_feature_presence]
-    end
-  | `Datetime (`Utc ts) -> begin
-    Printf.printf "UTC time event: %s, time: %s\n" uid (Ptime.to_rfc3339 ts);
-    Printf.printf "  Timedesc: %s\n" (start_td |> Timedesc.to_rfc3339);
-    Some [Generic_feature_presence]
-    end
-  | `Datetime (`With_tzid (ts, (b, tz_name))) -> begin
-    Printf.printf "With TZID event: %s, TZID: (%b, %s), time: %s\n" uid b tz_name (Ptime.to_rfc3339 ts);
-    Printf.printf "  Timedesc: %s\n" (start_td |> Timedesc.to_rfc3339);
-    Some [Generic_feature_presence]
-    end
-  | `Date (y, m, d) -> begin
-    Printf.printf "All-day event (date): %s, date: %04d-%02d-%02d\n" uid y m d;
-    Printf.printf "  Timedesc: %s\n" (start_td |> Timedesc.to_rfc3339);
-    None
-    end
-
-let weekly_simple_recurrence ev : features list option =
-  (* P05 *)
-  let rrules = ev.rrule in
-  match rrules with
-  | None -> None
-  | Some (_, (`Weekly, _, _, _)) -> begin
-    Printf.printf "  Weekly simple recurrence event\n";
-    Some [Generic_feature_presence]
-    end
-  | _ -> None
-
-let daily_simple_recurrence ev : features list option =
-  (* P06 *)
-  let rrules = ev.rrule in
-  match rrules with
-  | None -> None
-  | Some (_, (`Daily, _, _, _)) -> begin
-    Printf.printf "  Daily simple recurrence event\n";
-    Some [Generic_feature_presence]
-    end
-  | _ -> None
-
-let exception_events ev : features list option =
-  (* P10 *)
-  let exdates = get_exdates ev in
-  let rdates = get_rdates ev in
-  if exdates <> [] || rdates <> []
-  then begin
-    Printf.printf "  Exception event: %s\n" (get_uid ev);
-    Some [Generic_feature_presence]
-  end
-  else None
-
-let override_events ev : features list option =
-  (* P11 *)
-  let props = ev.props in
-  let recur_date_or_datetime_opt =
-    List.find_map
-      (function
-        | `Recur_id (_, date_or_datetime) -> Some date_or_datetime
-        | _ -> None)
-      props
               in
-  let status_cancelled_opt =
+              let rem = { rem with Remind.duration = Some duration } in
-    List.find_map
+              Ok rem
-      (function
-        | `Status (_, `Cancelled) -> Some ()
-        | _ -> None)
-      props
-  in
-  match status_cancelled_opt with
-  | Some () -> begin
-    Printf.printf "  Override event (cancelled): %s\n" (get_uid ev);
-    Some [Generic_feature_presence]
             end
-  | None ->
+          | `Date (_year, _month, _day) -> skip
-    begin match recur_date_or_datetime_opt with
-    | Some _ -> begin
-      Printf.printf "  Override event (modified instance): %s\n" (get_uid ev);
-      Some [Generic_feature_presence]
           end
-    | None -> None
+      | 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 all_predicates : (predicate * event_description) list =
+let expand_recurrence rem ev : (Remind.rem, error) result =
+  if List.length rem.Remind.recurring > 0 then skip else Ok rem
+
+let simple_weekly_recurrence rem ev : (Remind.rem, error) result =
+  match ev.rrule with
+  (*
+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, [])
+RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 11:15:00 +00:00))), None, [`Weekday (`Monday)])
+RRULE: (`Daily, (Some `Until (`Utc (2026-02-04 13:30:00 +00:00))), (Some 1), [])
+RRULE: (`Weekly, (Some `Count (3)), None, [`Byday ([(0, `Wednesday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2009-07-31 18:00:00 +00:00))), None, [`Byday ([(0, `Tuesday); (0, `Friday)]); `Weekday (`Monday)])
+RRULE: (`Weekly, (Some `Until (`Utc (2013-04-18 17:30:00 +00:00))), None, [`Byday ([(0, `Monday); (0, `Thursday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2014-12-20 10:30:00 +00:00))), None, [`Byday ([(0, `Saturday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2020-09-16 21:59:59 +00:00))), None, [`Byday ([(0, `Thursday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2021-08-25 21:59:59 +00:00))), None, [`Byday ([(0, `Wednesday)]); `Weekday (`Monday)])
+RRULE: (`Weekly, (Some `Until (`Utc (2021-09-18 21:59:59 +00:00))), (Some 1), [`Byday ([(0, `Sunday)]); `Weekday (`Monday)])
+RRULE: (`Weekly, (Some `Until (`Utc (2024-06-12 08:00:00 +00:00))), (Some 4), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2025-02-04 22:59:59 +00:00))), (Some 1), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2025-06-22 21:59:59 +00:00))), (Some 1), [`Weekday (`Monday); `Byday ([(0, `Monday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2026-02-24 22:59:59 +00:00))), (Some 2), [`Weekday (`Monday); `Byday ([(0, `Tuesday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Weekday (`Monday); `Byday ([(0, `Wednesday)])])
+RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, [])
+RRULE: (`Yearly, None, None, [])
+
+Il file RRULE_all.txt contiene tutte le RRULE del mio dataset!
+
+*)
+  | Some (_, (freq, count_or_until, interval, recurs)) ->
+      let _recur = (freq, count_or_until, interval, recurs) in
+      let uid = Utils.get_uid ev in
+      Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence _recur) uid;
+      skip
+      (* TODO: implementare *)
+  | None -> Ok rem
+
+let all_collectors : (collector * event_description) list =
   [
-    (has_summary, `Has_summary);
+    (collect_uuid, `Collect_uuid);
-    (all_day_event_single, `All_day_event_single);
+    (collect_summary, `Has_summary);
-    (all_day_event_multi, `All_day_event_multi);
+    (collect_start_end_duration, `All_day_event);
-    (timed_event, `Timed_event);
+    (expand_recurrence, `Expand_recurrence);
-    (weekly_simple_recurrence, `Weekly_simple_recurrence);
+    (simple_weekly_recurrence, `Simple_weekly_recurrence);
-    (daily_simple_recurrence, `Daily_simple_recurrence);
-    (exception_events, `Exception_events);
-    (override_events, `Override_events);
   ]
+
+let remind_of_event (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.recurring = recurrence } in
+
+  ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error (pred, _desc) ->
+      match rem_or_error with
+      | Error e -> Error e
+      | Ok rem -> pred rem master)

bin/eventTransformer.ml

@@ -1,21 +0,0 @@
-let default_implementation = Remind.make_default_event "TODO: implement conversion"
-
-let remind_of_event (ev : Icalendar.event) : Remind.event =
-  let found =
-    ListLabels.fold_left ~init:[] EventPredicates.all_predicates ~f:(fun acc (pred, desc) ->
-        match pred ev with
-        | Some feats -> (desc, feats) :: acc
-        | None -> acc)
-    |> List.rev
-  in
-  if List.length found > 0
-  then begin
-    Printf.printf "  \u{f04d3} \u{21d2} matches these predicates:\n";
-    ListLabels.iter
-      ~f:(fun (desc, features) ->
-        Printf.printf "    - %s\n" (EventPredicates.show_event_description desc);
-        ListLabels.iter ~f:(fun feat -> Printf.printf "      - %s\n" (EventPredicates.show_features feat)) features)
-      found;
-    Printf.printf "\n"
-  end;
-  default_implementation

bin/main.ml

@@ -1,6 +1,6 @@
+open Remind_sync
 module Map = MoreLabels.Map.Make (String)
 
-type event = Icalendar.event list
 (*
   We use a list of events here because there can be multiple events with the same UID, and we want to preserve all of
   them. This is important for handling cases where there are multiple events with the same UID but different properties
@@ -15,9 +15,12 @@ let ical2rem ical_file =
   close_in ic;
   let cal_or_error = Icalendar.parse (Bytes.unsafe_to_string s) in
   match cal_or_error with
-  | Error e -> prerr_endline ("Error parsing iCalendar file: " ^ e)
+  | Error e ->
+      if e = ": not enough input" then
+        exit 0 (* This is a common error when the file is empty, so we treat it as a non-error case *)
+      else prerr_endline ("Error parsing iCalendar file: " ^ e)
   | Ok (_, components) -> begin
-    let events_map : event Map.t =
+      let events_map : Icalendar.event list Map.t =
         ListLabels.fold_left ~init:Map.empty components ~f:(fun acc comp ->
             match comp with
             | `Event ev ->
@@ -26,32 +29,16 @@ let ical2rem ical_file =
                 Map.add ~key:uid ~data:(ev :: event_list) acc
             | _ -> acc (* Ignore non-event components *))
       in
-
       (* Now revert all the lists *)
       let events_map = Map.map ~f:List.rev events_map in
+      (* Printf.printf "Events: %d\n\n" (Map.cardinal events_map); *)
 
-    (* let () = *)
+      Map.iter events_map ~f:(fun ~key:uid ~data:events ->
-    (*   Map.iter *)
+          let rem_or_error = EventPredicates.remind_of_event events in
-    (*     ~f:(fun ~key ~data -> *)
+          match rem_or_error with
-    (*       let uid = key in *)
+          | Ok rem -> begin Printf.printf "%s\n" (Remind.string_of_rem rem) end
-    (*       let evs = data in *)
+          | Error (EventPredicates.Invalid_date s) -> Printf.eprintf "UID: %s Invalid date: %s\n" uid s
-    (*       Printf.printf "󰧓 ⇒ UID: %s\n" uid; *)
+          | Error Skip -> Printf.eprintf "UID: %s Skipped\n" uid)
-    (*       List.iter (fun ev -> Printf.printf "%s\n" (Icalendar.show_component (`Event ev))) evs; *)
-    (*       Printf.printf "\n\n") *)
-    (*     events_map *)
-    (* in *)
-    Printf.printf "Events: %d\n\n" (Map.cardinal events_map);
-    let events =
-      List.filter_map
-        (function
-          | `Event ev -> Some ev
-          | _ -> None)
-        components
-    in
-
-    let _reminders = List.map EventTransformer.remind_of_event events in
-
-    ()
     end
 
 let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)

bin/remind.ml

@@ -1,519 +1,52 @@
-(*
+open Remind_sync
-  FILE INTERAMENTE GENERATO DA LLM, DA RIVEDERE COMPLETAMENTE
+open Utils
-*)
-
-(** Types for representing Remind events *)
-
-(** Weekday names in Remind format *)
-type weekday =
-  | Monday
-  | Tuesday
-  | Wednesday
-  | Thursday
-  | Friday
-  | Saturday
-  | Sunday
-[@@deriving show]
-
-(** Month names (Remind uses English month names) *)
-type month =
-  | January
-  | February
-  | March
-  | April
-  | May
-  | June
-  | July
-  | August
-  | September
-  | October
-  | November
-  | December
-[@@deriving show]
-
-type date_spec = {
-  day : int option;  (** Day of month (1-31) *)
-  month : month option;  (** Month *)
-  year : int option;  (** Year (1990-2075) *)
-  weekdays : weekday list;  (** List of weekdays for weekly recurrences *)
-}
-[@@deriving show]
-(** Date specification in Remind *)
-
-type simple_date = {
-  year : int;
-  month : int;
-  day : int;
-}
-[@@deriving show]
-(** Short-hand date format YYYY-MM-DD *)
-
-type time_spec = {
-  hour : int;  (** 0-23 for 24h format, 1-12 for am/pm *)
-  minute : int;  (** 0-59 *)
-}
-[@@deriving show]
-(** Time specification (24-hour format or with AM/PM) *)
-
-(** Delta specification for advance warning *)
-type delta =
-  | Plus of int  (** +n - respects OMIT *)
-  | PlusPlus of int  (** ++n - ignores OMIT *)
-[@@deriving show]
-
-(** Back specification for backward scanning *)
-type back =
-  | Minus of int  (** -n - respects OMIT *)
-  | MinusMinus of int  (** --n - ignores OMIT *)
-  | Tilde of int  (** ~n - "lastworkday" style *)
-  | TildeTilde of int  (** ~~n - "lastday" style *)
-[@@deriving show]
-
-type repeat = int (* n - repeat every n days *) [@@deriving show]
-(** Repeat specification for periodic reminders *)
-
-type tdelta = int [@@deriving show]
-(** Time delta for timed reminders (in minutes) *)
-
-type trepeat = int [@@deriving show]
-(** Time repeat for timed reminders (in minutes) *)
-
-(** Duration specification for timed events *)
-type duration =
-  | Minutes of int  (** Duration in minutes *)
-  | HoursMinutes of int * int  (** Duration as hours:minutes *)
-[@@deriving show]
-
-type priority = int [@@deriving show]
-(** Priority (0-9999, default 5000) *)
-
-type omit = weekday list [@@deriving show]
-(** OMIT specification - days to skip *)
-
-(** Special keywords *)
-type modifier =
-  | Once  (** ONCE - trigger only once per day *)
-  | Noqueue  (** NOQUEUE - don't queue timed reminders *)
-[@@deriving show]
-
-(** Action to take when reminder falls on an omitted day *)
-type omit_action =
-  | Skip  (** SKIP - skip the reminder completely *)
-  | Before  (** BEFORE - move reminder to before omitted days *)
-  | After  (** AFTER - move reminder to after omitted days *)
-[@@deriving show]
-
-type trigger = {
-  date : date_spec option;  (** Date specification *)
-  simple_date : simple_date option;  (** Alternative: YYYY-MM-DD format *)
-  back : back option;  (** Backward scanning *)
-  repeat : repeat option;  (** Periodic repetition *)
-  delta : delta option;  (** Advance warning *)
-  until : simple_date option;  (** UNTIL expiry date *)
-  through : simple_date option;  (** THROUGH (equivalent to *1 UNTIL) *)
-  from : simple_date option;  (** FROM starting date *)
-  scanfrom : simple_date option;  (** SCANFROM advanced starting date *)
-}
-[@@deriving show]
-(** Trigger specification combining various time-related elements *)
-
-type timed = {
-  time : time_spec;
-  tdelta : tdelta option;
-  trepeat : trepeat option;
-}
-[@@deriving show]
-(** Timed reminder specification *)
-
-type tag = string (* Up to 48 chars, no whitespace or comma *) [@@deriving show]
-(** TAG specification for categorizing reminders *)
-
-type info = {
-  header : string;  (** e.g., "Location", "Description", "Url" *)
-  value : string;
-}
-[@@deriving show]
-(** INFO specification for metadata *)
-
-(** Body specification *)
-type body =
-  | Msg of string  (** MSG - simple message *)
-  | Msf of string  (** MSF - formatted message *)
-  | Run of string  (** RUN - execute command *)
-  | Cal of string  (** CAL - calendar entry *)
-  | Satisfy of string  (** SATISFY - conditional trigger expression *)
-  | Ps of string  (** PS - PostScript *)
-  | Psfile of string  (** PSFILE - PostScript file *)
-  | Special of string * string  (** SPECIAL type body *)
-[@@deriving show]
 
 type rem = {
-  trigger : trigger;
+  original_uuid : string;  (** Original UID from the iCalendar event *)
-  timed : timed option;  (** AT specification *)
+  summary : string;  (** Summary or title of the reminder *)
-  priority : priority option;  (** PRIORITY *)
+  date : Timedesc.Date.t;  (** Date specification (day, month, year) *)
-  omit : omit option;  (** OMIT weekdays *)
+  end_date : Timedesc.Date.t option;  (** Optional end date for a date range *)
-  omitfunc : string option;  (** OMITFUNC function_name *)
+  time : Timedesc.Time.t option;  (** Optional time specification (hour, minute) *)
-  addomit : bool;  (** ADDOMIT flag *)
+  duration : Timedesc.Span.t option;  (** Optional duration for timed events *)
-  omit_action : omit_action option;  (** SKIP/BEFORE/AFTER *)
+  recurring : Icalendar.event list;
-  modifiers : modifier list;  (** ONCE, NOQUEUE, etc. *)
+      (** List of events that are part of the same recurring series: these are only the overrides, not the master event
-  tags : tag list;  (** TAG specifications *)
+      *)
-  infos : info list;  (** INFO specifications *)
-  duration : duration option;  (** DURATION for timed events *)
-  todo : bool;  (** TODO flag *)
-  complete_through : simple_date option;  (** COMPLETE-THROUGH date for TODOs *)
-  max_overdue : int option;  (** MAX-OVERDUE days for TODOs *)
-  warn : string option;  (** WARN function name for precise scheduling *)
-  sched : string option;  (** SCHED function name for timed reminders *)
-  tz : string option;  (** TZ timezone *)
-  maybe_uncomputable : bool;  (** MAYBE-UNCOMPUTABLE flag *)
-  body : body;  (** MSG/RUN/etc. *)
 }
 [@@deriving show]
 (** A complete REM command *)
 
-type event = rem
+let empty =
-(** Type alias for compatibility - a Remind event is a REM command *)
-
-(** Convenience constructors *)
-
-let make_simple_date year month day = { year; month; day }
-let make_time hour minute = { hour; minute }
-let make_date_spec ?day ?month ?year ?(weekdays = []) () = { day; month; year; weekdays }
-
-let make_trigger ?date ?simple_date ?back ?repeat ?delta ?until ?through ?from ?scanfrom () =
-  { date; simple_date; back; repeat; delta; until; through; from; scanfrom }
-
-let make_timed ?tdelta ?trepeat time = { time; tdelta; trepeat }
-let make_info header value = { header; value }
-
-let make_rem ?(timed = None) ?(priority = None) ?(omit = None) ?(omitfunc = None) ?(addomit = false)
-    ?(omit_action = None) ?(modifiers = []) ?(tags = []) ?(infos = []) ?(duration = None) ?(todo = false)
-    ?(complete_through = None) ?(max_overdue = None) ?(warn = None) ?(sched = None) ?(tz = None)
-    ?(maybe_uncomputable = false) trigger body =
   {
-    trigger;
+    original_uuid = "";
-    timed;
+    summary = "";
-    priority;
+    date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1;
-    omit;
+    end_date = None;
-    omitfunc;
+    time = None;
-    addomit;
+    duration = None;
-    omit_action;
+    recurring = [];
-    modifiers;
-    tags;
-    infos;
-    duration;
-    todo;
-    complete_through;
-    max_overdue;
-    warn;
-    sched;
-    tz;
-    maybe_uncomputable;
-    body;
   }
 
-(** Create a minimal default event - useful as a placeholder *)
+let string_of_rem rem =
-let make_default_event msg =
+  let b = Buffer.create 256 in
-  let trigger = make_trigger () in
+  Buffer.add_string b "REM ";
-  make_rem trigger (Msg msg)
+  Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid);
-
+  Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date);
-(** Helper to escape quotes in strings for INFO values *)
+  (match rem.time with
-let escape_quotes s =
+  | Some time ->
-  let buf = Buffer.create (String.length s) in
+      Buffer.add_string b " AT ";
-  String.iter (fun c -> if c = '"' then Buffer.add_string buf "\\\"" else Buffer.add_char buf c) s;
+      Buffer.add_string b (string_of_time time)
-  Buffer.contents buf
-
-(** Convert types to Remind syntax strings *)
-
-let weekday_to_string = function
-  | Monday -> "Mon"
-  | Tuesday -> "Tue"
-  | Wednesday -> "Wed"
-  | Thursday -> "Thu"
-  | Friday -> "Fri"
-  | Saturday -> "Sat"
-  | Sunday -> "Sun"
-
-let month_to_string = function
-  | January -> "Jan"
-  | February -> "Feb"
-  | March -> "Mar"
-  | April -> "Apr"
-  | May -> "May"
-  | June -> "Jun"
-  | July -> "Jul"
-  | August -> "Aug"
-  | September -> "Sep"
-  | October -> "Oct"
-  | November -> "Nov"
-  | December -> "Dec"
-
-let simple_date_to_string d = Printf.sprintf "%04d-%02d-%02d" d.year d.month d.day
-let time_to_string t = Printf.sprintf "%02d:%02d" t.hour t.minute
-
-let duration_to_string = function
-  | Minutes m -> string_of_int m
-  | HoursMinutes (h, m) -> Printf.sprintf "%d:%02d" h m
-
-let delta_to_string = function
-  | Plus n -> Printf.sprintf "+%d" n
-  | PlusPlus n -> Printf.sprintf "++%d" n
-
-let back_to_string = function
-  | Minus n -> Printf.sprintf "-%d" n
-  | MinusMinus n -> Printf.sprintf "--%d" n
-  | Tilde n -> Printf.sprintf "~%d" n
-  | TildeTilde n -> Printf.sprintf "~~%d" n
-
-let repeat_to_string r = Printf.sprintf "*%d" r
-
-let omit_action_to_string = function
-  | Skip -> "SKIP"
-  | Before -> "BEFORE"
-  | After -> "AFTER"
-
-(** Convert a REM to a string suitable for a .rem file *)
-let rem_to_string rem =
-  let buf = Buffer.create 256 in
-  Buffer.add_string buf "REM";
-
-  (* MAYBE-UNCOMPUTABLE *)
-  if rem.maybe_uncomputable then Buffer.add_string buf " MAYBE-UNCOMPUTABLE";
-
-  (* TODO *)
-  if rem.todo then Buffer.add_string buf " TODO";
-
-  (* Date/trigger specification *)
-  (match rem.trigger.simple_date with
-  | Some sd ->
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf (simple_date_to_string sd)
-  | None -> (
-    match rem.trigger.date with
-    | Some ds -> (
-      (* Weekdays *)
-      List.iter
-        (fun wd ->
-          Buffer.add_char buf ' ';
-          Buffer.add_string buf (weekday_to_string wd))
-        ds.weekdays;
-      (* Day *)
-      (match ds.day with
-      | Some d ->
-        Buffer.add_char buf ' ';
-        Buffer.add_string buf (string_of_int d)
   | None -> ());
-      (* Month *)
-      (match ds.month with
-      | Some m ->
-        Buffer.add_char buf ' ';
-        Buffer.add_string buf (month_to_string m)
-      | None -> ());
-      (* Year *)
-      match ds.year with
-      | Some y ->
-        Buffer.add_char buf ' ';
-        Buffer.add_string buf (string_of_int y)
-      | None -> ())
-    | None -> ()));
-
-  (* Back *)
-  (match rem.trigger.back with
-  | Some b ->
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf (back_to_string b)
-  | None -> ());
-
-  (* Repeat *)
-  (match rem.trigger.repeat with
-  | Some r ->
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf (repeat_to_string r)
-  | None -> ());
-
-  (* Delta *)
-  (match rem.trigger.delta with
-  | Some d ->
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf (delta_to_string d)
-  | None -> ());
-
-  (* FROM *)
-  (match rem.trigger.from with
-  | Some f ->
-    Buffer.add_string buf " FROM ";
-    Buffer.add_string buf (simple_date_to_string f)
-  | None -> ());
-
-  (* UNTIL *)
-  (match rem.trigger.until with
-  | Some u ->
-    Buffer.add_string buf " UNTIL ";
-    Buffer.add_string buf (simple_date_to_string u)
-  | None -> ());
-
-  (* THROUGH *)
-  (match rem.trigger.through with
-  | Some t ->
-    Buffer.add_string buf " THROUGH ";
-    Buffer.add_string buf (simple_date_to_string t)
-  | None -> ());
-
-  (* SCANFROM *)
-  (match rem.trigger.scanfrom with
-  | Some sf ->
-    Buffer.add_string buf " SCANFROM ";
-    Buffer.add_string buf (simple_date_to_string sf)
-  | None -> ());
-
-  (* AT (timed) *)
-  (match rem.timed with
-  | Some t -> (
-    Buffer.add_string buf " AT ";
-    Buffer.add_string buf (time_to_string t.time);
-    (match t.tdelta with
-    | Some td ->
-      Buffer.add_char buf ' ';
-      Buffer.add_char buf '+';
-      Buffer.add_string buf (string_of_int td)
-    | None -> ());
-    match t.trepeat with
-    | Some tr ->
-      Buffer.add_string buf " *";
-      Buffer.add_string buf (string_of_int tr)
-    | None -> ())
-  | None -> ());
-
-  (* SCHED *)
-  (match rem.sched with
-  | Some s ->
-    Buffer.add_string buf " SCHED ";
-    Buffer.add_string buf s
-  | None -> ());
-
-  (* WARN *)
-  (match rem.warn with
-  | Some w ->
-    Buffer.add_string buf " WARN ";
-    Buffer.add_string buf w
-  | None -> ());
-
-  (* OMIT *)
-  (match rem.omit with
-  | Some weekdays when weekdays <> [] ->
-    Buffer.add_string buf " OMIT";
-    List.iter
-      (fun wd ->
-        Buffer.add_char buf ' ';
-        Buffer.add_string buf (weekday_to_string wd))
-      weekdays
-  | _ -> ());
-
-  (* OMITFUNC *)
-  (match rem.omitfunc with
-  | Some func ->
-    Buffer.add_string buf " OMITFUNC ";
-    Buffer.add_string buf func
-  | None -> ());
-
-  (* SKIP/BEFORE/AFTER *)
-  (match rem.omit_action with
-  | Some action ->
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf (omit_action_to_string action)
-  | None -> ());
-
-  (* ADDOMIT *)
-  if rem.addomit then Buffer.add_string buf " ADDOMIT";
-
-  (* PRIORITY *)
-  (match rem.priority with
-  | Some p ->
-    Buffer.add_string buf " PRIORITY ";
-    Buffer.add_string buf (string_of_int p)
-  | None -> ());
-
-  (* Modifiers (ONCE, NOQUEUE) *)
-  List.iter
-    (fun modifier ->
-      match modifier with
-      | Once -> Buffer.add_string buf " ONCE"
-      | Noqueue -> Buffer.add_string buf " NOQUEUE")
-    rem.modifiers;
-
-  (* DURATION *)
   (match rem.duration with
-  | Some d ->
+  | Some duration ->
-    Buffer.add_string buf " DURATION ";
+      Buffer.add_string b " DURATION ";
-    Buffer.add_string buf (duration_to_string d)
+      Buffer.add_string b (string_of_span duration);
+      Buffer.add_string b ""
   | None -> ());
-
+  (match rem.end_date with
-  (* COMPLETE-THROUGH *)
+  | Some end_date ->
-  (match rem.complete_through with
+      Buffer.add_string b " THROUGH ";
-  | Some ct ->
+      Buffer.add_string b (Timedesc.Date.to_rfc3339 end_date)
-    Buffer.add_string buf " COMPLETE-THROUGH ";
-    Buffer.add_string buf (simple_date_to_string ct)
   | None -> ());
-
+  Buffer.add_string b " MSG ";
-  (* MAX-OVERDUE *)
+  Buffer.add_string b rem.summary;
-  (match rem.max_overdue with
+  Buffer.contents b
-  | Some mo ->
-    Buffer.add_string buf " MAX-OVERDUE ";
-    Buffer.add_string buf (string_of_int mo)
-  | None -> ());
-
-  (* TZ *)
-  (match rem.tz with
-  | Some tz ->
-    Buffer.add_string buf " TZ ";
-    Buffer.add_string buf tz
-  | None -> ());
-
-  (* TAGs *)
-  List.iter
-    (fun tag ->
-      Buffer.add_string buf " TAG ";
-      Buffer.add_string buf tag)
-    rem.tags;
-
-  (* INFOs - with proper escaping *)
-  List.iter
-    (fun info ->
-      Buffer.add_string buf " INFO \"";
-      Buffer.add_string buf (escape_quotes info.header);
-      Buffer.add_string buf ": ";
-      Buffer.add_string buf (escape_quotes info.value);
-      Buffer.add_char buf '"')
-    rem.infos;
-
-  (* Body *)
-  Buffer.add_char buf ' ';
-  (match rem.body with
-  | Msg msg ->
-    Buffer.add_string buf "MSG ";
-    Buffer.add_string buf msg
-  | Msf msf ->
-    Buffer.add_string buf "MSF ";
-    Buffer.add_string buf msf
-  | Run cmd ->
-    Buffer.add_string buf "RUN ";
-    Buffer.add_string buf cmd
-  | Cal cal ->
-    Buffer.add_string buf "CAL ";
-    Buffer.add_string buf cal
-  | Satisfy expr ->
-    Buffer.add_string buf "SATISFY ";
-    Buffer.add_string buf expr
-  | Ps ps ->
-    Buffer.add_string buf "PS ";
-    Buffer.add_string buf ps
-  | Psfile file ->
-    Buffer.add_string buf "PSFILE ";
-    Buffer.add_string buf file
-  | Special (typ, body) ->
-    Buffer.add_string buf "SPECIAL ";
-    Buffer.add_string buf typ;
-    Buffer.add_char buf ' ';
-    Buffer.add_string buf body);
-
-  Buffer.contents buf

bin/utils.ml

@@ -1,16 +1,62 @@
+open Remind_sync
 open Icalendar
 
+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) ->
-    (* TODO: this case is not present in my current dataset… *)
+      (* 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 ())
+      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. *)
@@ -24,14 +70,6 @@ let timedesc_of_date_or_datetime (t : date_or_datetime) : Timedesc.t =
   | `Date (year, month, day) ->
       Timedesc.make_exn ~year ~month ~day ~hour:0 ~minute:0 ~second:0 ~tz:(Timedesc.Time_zone.local_exn ()) ()
 
-let get_y_m_d_from_timedesc (t : Timedesc.t) : int * int * int =
-  let date = Timedesc.date t in
-  (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date)
-
-let get_start ev =
-  let _, start = ev.dtstart in
-  timedesc_of_date_or_datetime start
-
 let get_exdates ev =
   let event_props = ev.props in
   let dates_or_datetimes =
@@ -67,8 +105,32 @@ let get_rdates ev =
         | `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
         | `Dates date_list -> List.map (fun date -> `Date date) date_list
         | `Periods _ ->
-          (* TODO: Ignored for now, does not appear in my current dataset *)
+            (* 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)

dune

@@ -1 +1 @@
-(data_only_dirs contrib)
+(data_only_dirs contrib calendars)

lib/dune

@@ -1,2 +1,8 @@
 (library
- (name remind_sync))
+ (name remind_sync)
+ (modules remind_sync timedesc_augmented result_augmented utf8 icalendar_augmented ptime_augmented)
+ (preprocess
+  (pps ppx_deriving.show))
+ (libraries base logs timedesc uuseg uutf icalendar ptime))
+
+

lib/icalendar_augmented.ml

@@ -0,0 +1,316 @@
+module Params = struct
+  include Icalendar.Params
+
+  let pp ppf _m = Format.pp_print_string ppf "<params>"
+end
+
+type params = Params.t [@@deriving show]
+
+module Ptime = struct
+  include Ptime_augmented
+end
+
+(* TODO: tag these with `Utc | `Local *)
+type timestamp_utc = Ptime.t [@@deriving show]
+type timestamp_local = Ptime.t [@@deriving show]
+type utc_or_timestamp_local = [ `Utc of timestamp_utc | `Local of timestamp_local ] [@@deriving show]
+type timestamp = [ utc_or_timestamp_local | `With_tzid of timestamp_local * (bool * string) ] [@@deriving show]
+type date_or_datetime = [ `Datetime of timestamp | `Date of Ptime.date ] [@@deriving show]
+type weekday = [ `Friday | `Monday | `Saturday | `Sunday | `Thursday | `Tuesday | `Wednesday ] [@@deriving show]
+
+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]
+
+type valuetype =
+  [ `Binary
+  | `Boolean
+  | `Caladdress
+  | `Date
+  | `Datetime
+  | `Duration
+  | `Float
+  | `Integer
+  | `Period
+  | `Recur
+  | `Text
+  | `Time
+  | `Uri
+  | `Utcoffset
+  | `Xname of string * string
+  | `Ianatoken of string ]
+
+type cutype = [ `Group | `Individual | `Resource | `Room | `Unknown | `Ianatoken of string | `Xname of string * string ]
+[@@deriving show]
+
+type partstat =
+  [ `Accepted
+  | `Completed
+  | `Declined
+  | `Delegated
+  | `In_process
+  | `Needs_action
+  | `Tentative
+  | `Ianatoken of string
+  | `Xname of string * string ]
+[@@deriving show]
+
+type role =
+  [ `Chair | `Nonparticipant | `Optparticipant | `Reqparticipant | `Ianatoken of string | `Xname of string * string ]
+[@@deriving show]
+
+type relationship = [ `Parent | `Child | `Sibling | `Ianatoken of string | `Xname of string * string ] [@@deriving show]
+
+type fbtype = [ `Free | `Busy | `Busy_Unavailable | `Busy_Tentative | `Ianatoken of string | `Xname of string * string ]
+[@@deriving show]
+
+type param_value = [ `Quoted of string | `String of string ] [@@deriving show]
+
+type _ icalparameter =
+  | Altrep : Uri.t icalparameter
+  | Cn : param_value icalparameter
+  | Cutype : cutype icalparameter
+  | Delegated_from : Uri.t list icalparameter
+  | Delegated_to : Uri.t list icalparameter
+  | Dir : Uri.t icalparameter
+  | Encoding : [ `Base64 ] icalparameter
+  | Media_type : (string * string) icalparameter
+  | Fbtype : fbtype icalparameter
+  | Language : string icalparameter
+  | Member : Uri.t list icalparameter
+  | Partstat : partstat icalparameter
+  | Range : [ `Thisandfuture ] icalparameter
+  | Related : [ `Start | `End ] icalparameter
+  | Reltype : relationship icalparameter
+  | Role : role icalparameter
+  | Rsvp : bool icalparameter
+  | Sentby : Uri.t icalparameter
+  | Tzid : (bool * string) icalparameter
+  | Valuetype : valuetype icalparameter
+  | Iana_param : string -> param_value list icalparameter
+  | Xparam : (string * string) -> param_value list icalparameter
+[@@deriving show]
+
+type other_prop = [ `Iana_prop of string * params * string | `Xprop of (string * string) * params * string ]
+[@@deriving show]
+
+type cal_prop =
+  [ `Prodid of params * string
+  | `Version of params * string
+  | `Calscale of params * string
+  | `Method of params * string
+  | other_prop ]
+[@@deriving show]
+
+type class_ = [ `Public | `Private | `Confidential | `Ianatoken of string | `Xname of string * string ]
+[@@deriving show]
+
+type status =
+  [ `Draft
+  | `Final
+  | `Cancelled
+  | `Needs_action
+  | `Completed
+  | `In_process
+  | (* `Cancelled *)
+    `Tentative
+  | `Confirmed (* | `Cancelled *) ]
+[@@deriving show]
+
+type period = timestamp * Ptime.Span.t * bool [@@deriving show]
+type period_utc = timestamp_utc * Ptime.Span.t * bool [@@deriving show]
+type dates_or_datetimes = [ `Datetimes of timestamp list | `Dates of Ptime.date list ] [@@deriving show]
+type dates_or_datetimes_or_periods = [ dates_or_datetimes | `Periods of period list ] [@@deriving show]
+
+type general_prop =
+  [ `Dtstamp of params * timestamp_utc
+  | `Uid of params * string
+  | `Dtstart of params * date_or_datetime
+  | `Class of params * class_
+  | `Created of params * timestamp_utc
+  | `Description of params * string
+  | `Geo of params * (float * float)
+  | `Lastmod of params * timestamp_utc
+  | `Location of params * string
+  | `Organizer of params * Uri.t
+  | `Priority of params * int
+  | `Seq of params * int
+  | `Status of params * status
+  | `Summary of params * string
+  | `Url of params * Uri.t
+  | `Recur_id of params * date_or_datetime
+  | (* TODO: Furthermore, this property MUST be specified
+      as a date with local time if and only if the "DTSTART" property
+      contained within the recurring component is specified as a date
+      with local time. *)
+    `Rrule of params * recurrence
+  | `Duration of params * Ptime.Span.t
+  | `Attach of params * [ `Uri of Uri.t | `Binary of string ]
+  | `Attendee of params * Uri.t
+  | `Categories of params * string list
+  | `Comment of params * string
+  | `Contact of params * string
+  | `Exdate of params * dates_or_datetimes
+  | `Rstatus of params * ((int * int * int option) * string * string option)
+  | `Related of params * string
+  | `Resource of params * string list
+  | `Rdate of params * dates_or_datetimes_or_periods ]
+[@@deriving show]
+
+type event_prop =
+  [ general_prop
+  | `Transparency of params * [ `Transparent | `Opaque ]
+  | `Dtend of params * date_or_datetime
+  | (* TODO: valuetype same as DTSTART *)
+    other_prop ]
+[@@deriving show]
+
+type 'a alarm_struct = {
+  trigger : params * [ `Duration of Ptime.Span.t | `Datetime of timestamp_utc ];
+  duration_repeat : ((params * Ptime.Span.t) * (params * int)) option;
+  summary : (params * string) option;
+  other : other_prop list;
+  special : 'a;
+}
+[@@deriving show]
+
+type audio_struct = { attach : (params * [ `Uri of Uri.t | `Binary of string ]) option } [@@deriving show]
+type display_struct = { description : (params * string) option } [@@deriving show]
+
+type email_struct = {
+  description : params * string;
+  attendees : (params * Uri.t) list;
+  attach : (params * [ `Uri of Uri.t | `Binary of string ]) option;
+}
+[@@deriving show]
+
+type alarm =
+  [ `Audio of audio_struct alarm_struct
+  | `Display of display_struct alarm_struct
+  | `Email of email_struct alarm_struct
+  | `None of unit alarm_struct ]
+[@@deriving show]
+
+type tz_prop =
+  [ `Dtstart_local of params * timestamp_local
+  | `Tzoffset_to of params * Ptime.Span.t
+  | `Tzoffset_from of params * Ptime.Span.t
+  | `Rrule of params * recurrence
+  | `Comment of params * string
+  | `Rdate of params * dates_or_datetimes_or_periods
+  | `Tzname of params * string
+  | other_prop ]
+[@@deriving show]
+
+type timezone_prop =
+  [ `Timezone_id of params * (bool * string)
+  | `Lastmod of params * timestamp_utc
+  | `Tzurl of params * Uri.t
+  | `Standard of tz_prop list
+  | `Daylight of tz_prop list
+  | other_prop ]
+[@@deriving show]
+
+type todo_prop =
+  [ general_prop
+  | `Completed of params * timestamp_utc
+  | `Percent of params * int
+  | `Due of params * date_or_datetime
+  | other_prop ]
+[@@deriving show]
+
+type journal_prop = [ general_prop | other_prop ] [@@deriving show]
+
+type freebusy_prop =
+  [ `Dtstamp of params * timestamp_utc
+  | `Uid of params * string
+  | `Contact of params * string
+  | `Dtstart_utc of params * timestamp_utc
+  | `Dtend_utc of params * timestamp_utc
+  | `Organizer of params * Uri.t
+  | `Url of params * Uri.t
+  | `Attendee of params * Uri.t
+  | `Comment of params * string
+  | `Freebusy of params * period_utc list
+  | `Rstatus of params * ((int * int * int option) * string * string option)
+  | other_prop ]
+[@@deriving show]
+
+type event = {
+  dtstamp : params * timestamp_utc;
+  uid : params * string;
+  dtstart : params * date_or_datetime; (* NOTE: optional if METHOD present according to RFC 5545 *)
+  dtend_or_duration : [ `Duration of params * Ptime.Span.t | `Dtend of params * date_or_datetime ] option;
+  rrule : (params * recurrence) option; (* NOTE: RFC says SHOULD NOT occur more than once *)
+  props : event_prop list;
+  alarms : alarm list;
+}
+[@@deriving show]
+
+type timezone = timezone_prop list [@@deriving show]
+
+type component =
+  [ `Event of event
+  | `Todo of todo_prop list * alarm list
+  | `Journal of journal_prop list
+  | `Freebusy of freebusy_prop list
+  | `Timezone of timezone ]
+[@@deriving show]
+
+let conv_alarm_struct (f : 'a -> 'b) (s : 'a Icalendar.alarm_struct) : 'b alarm_struct =
+  {
+    trigger = s.trigger;
+    duration_repeat = s.duration_repeat;
+    summary = s.summary;
+    other = s.other;
+    special = f s.special;
+  }
+
+let conv_audio_struct (s : Icalendar.audio_struct) : audio_struct = { attach = s.attach }
+let conv_display_struct (s : Icalendar.display_struct) : display_struct = { description = s.description }
+
+let conv_email_struct (s : Icalendar.email_struct) : email_struct =
+  { description = s.description; attendees = s.attendees; attach = s.attach }
+
+let conv_alarm (a : Icalendar.alarm) : alarm =
+  match a with
+  | `Audio s -> `Audio (conv_alarm_struct conv_audio_struct s)
+  | `Display s -> `Display (conv_alarm_struct conv_display_struct s)
+  | `Email s -> `Email (conv_alarm_struct conv_email_struct s)
+  | `None s -> `None (conv_alarm_struct Fun.id s)
+
+let conv_event (e : Icalendar.event) : event =
+  {
+    dtstamp = e.dtstamp;
+    uid = e.uid;
+    dtstart = e.dtstart;
+    dtend_or_duration = e.dtend_or_duration;
+    rrule = e.rrule;
+    props = e.props;
+    alarms = List.map conv_alarm e.alarms;
+  }
+
+let conv_component (c : Icalendar.component) : component =
+  match c with
+  | `Event e -> `Event (conv_event e)
+  | `Todo (props, alms) -> `Todo (props, List.map conv_alarm alms)
+  | `Journal props -> `Journal props
+  | `Freebusy props -> `Freebusy props
+  | `Timezone tz -> `Timezone tz
+
+let parse s =
+  Result.map (fun (cal_props, components) -> (cal_props, List.map conv_component components)) (Icalendar.parse s)

lib/ptime_augmented.ml

@@ -0,0 +1,3 @@
+include Ptime
+
+type date = int * int * int [@@deriving show]

lib/remind_sync.ml

@@ -0,0 +1,5 @@
+module Icalendar = Icalendar_augmented
+module Ptime = Ptime_augmented
+module Result = Result_augmented
+module Timedesc = Timedesc_augmented
+module Utf8 = Utf8

lib/result_augmented.ml

@@ -0,0 +1,42 @@
+module Internal_result = struct
+  type ('a, 'b) t = ('a, 'b) result = Ok of 'a | Error of 'b
+
+  let return x = Ok x
+  let error e = Error e
+  let error_string s = Error (`Error_message s)
+  let bind = Stdlib.Result.bind
+  let ok = Result.ok
+
+  module List = struct
+    let map (xs : 'a list) ~(f : 'a -> ('b, 'c) t) : ('b list, 'c) t =
+      let rec loop ?(acc = []) xs =
+        match xs with
+        | [] -> return (List.rev acc)
+        | hd :: tl -> (
+            match f hd with
+            | Ok x -> loop ~acc:(x :: acc) tl
+            | Error e -> Error e)
+      in
+      loop xs
+
+    let iteri ?(start = 0) (xs : 'a list) ~(f : int -> 'a -> (unit, 'b) t) : (unit, 'b) t =
+      let rec loop ?(idx = start) xs =
+        match xs with
+        | [] -> return ()
+        | hd :: tl -> begin
+            let res = f idx hd in
+            match res with
+            | Ok () -> loop ~idx:(idx + 1) tl
+            | Error e -> Error e
+          end
+      in
+      loop xs
+  end
+
+  module Let_syntax = struct
+    let ( let* ) = Stdlib.Result.bind
+    let ( let+ ) x f = Stdlib.Result.map f x
+  end
+end
+
+include Internal_result

lib/timedesc_augmented.ml

@@ -0,0 +1,34 @@
+include Timedesc
+
+type t = Timedesc.t
+
+module Time = struct
+  include Timedesc.Time
+
+  let pp = Timedesc.Time.pp_rfc3339 ()
+end
+
+module Span = struct
+  include Timedesc.Span
+end
+
+module Date = struct
+  include Timedesc.Date
+
+  type t = Timedesc.Date.t
+
+  let pp = Timedesc.Date.pp_rfc3339
+
+  module Ymd = struct
+    include Timedesc.Date.Ymd
+
+    type error = [ `Does_not_exist | `Invalid_year of int | `Invalid_month of int | `Invalid_day of int ]
+    [@@deriving show]
+  end
+end
+
+module Timestamp = struct
+  type t = Timedesc.Timestamp.t
+
+  let pp = Timedesc.Timestamp.pp
+end

lib/utf8.ml

@@ -0,0 +1,202 @@
+let length = Uuseg_string.fold_utf_8 `Grapheme_cluster (fun x _ -> x + 1) 0
+
+let capitalize s =
+  let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
+
+  let rec split_loop ?(acc = []) () =
+    match Uutf.decode dec with
+    | `Await -> assert false
+    | `End -> List.rev acc
+    | `Malformed _ignored -> split_loop ~acc ()
+    | `Uchar c -> split_loop ~acc:(c :: acc) ()
+  in
+
+  let buf = Buffer.create 1024 in
+  let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
+  let rec capital_loop ?(last_was_upper = false) xs =
+    match xs with
+    | c :: tl ->
+      let last_was_upper =
+        if Uucp.Alpha.is_alphabetic c
+        then begin
+          let f = if last_was_upper = false then Uucp.Case.Map.to_upper else Uucp.Case.Map.to_lower in
+          match f c with
+          | `Self ->
+            let () = Uutf.encode enc (`Uchar c) |> ignore in
+            true
+          | `Uchars u_lst ->
+            List.iter (fun u -> Uutf.encode enc (`Uchar u) |> ignore) u_lst;
+            true
+        end
+        else
+          let () = Uutf.encode enc (`Uchar c) |> ignore in
+          false
+      in
+      capital_loop ~last_was_upper tl
+    | [] ->
+      let () = Uutf.encode enc `End |> ignore in
+      Buffer.contents buf
+  in
+  split_loop () |> capital_loop
+
+let lowercase s =
+  let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
+
+  let rec split_loop ?(acc = []) () =
+    match Uutf.decode dec with
+    | `Await -> assert false
+    | `End -> List.rev acc
+    | `Malformed _ignored -> split_loop ~acc ()
+    | `Uchar c -> split_loop ~acc:(c :: acc) ()
+  in
+
+  let buf = Buffer.create 1024 in
+  let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
+  let rec to_lower xs =
+    match xs with
+    | c :: tl ->
+      if Uucp.Alpha.is_alphabetic c
+      then begin
+        match Uucp.Case.Map.to_lower c with
+        | `Self ->
+          let () = Uutf.encode enc (`Uchar c) |> ignore in
+          to_lower tl
+        | `Uchars u_lst ->
+          List.iter (fun u -> Uutf.encode enc (`Uchar u) |> ignore) u_lst;
+          to_lower tl
+      end
+      else
+        let () = Uutf.encode enc (`Uchar c) |> ignore in
+        to_lower tl
+    | [] ->
+      let () = Uutf.encode enc `End |> ignore in
+      Buffer.contents buf
+  in
+  split_loop () |> to_lower
+
+let remove_non_alphabetic s =
+  let dec = Uutf.decoder ~encoding:`UTF_8 (`String s) in
+
+  let rec split_loop ?(acc = []) () =
+    match Uutf.decode dec with
+    | `Await -> assert false
+    | `End -> List.rev acc
+    | `Malformed _ignored -> split_loop ~acc ()
+    | `Uchar c -> split_loop ~acc:(c :: acc) ()
+  in
+
+  let buf = Buffer.create 1024 in
+  let enc = Uutf.encoder `UTF_8 (`Buffer buf) in
+  let rec filter_loop xs =
+    match xs with
+    | c :: tl ->
+      if Uucp.Alpha.is_alphabetic c
+      then begin
+        let () = Uutf.encode enc (`Uchar c) |> ignore in
+        filter_loop tl
+      end
+      else filter_loop tl
+    | [] ->
+      let () = Uutf.encode enc `End |> ignore in
+      Buffer.contents buf
+  in
+  split_loop () |> filter_loop
+
+let split_in_chunks_of n s =
+  let last, chunks =
+    Uuseg_string.fold_utf_8
+      `Grapheme_cluster
+      (fun (last, chunks) grapheme ->
+        let l = List.length last in
+        if l < n
+        then (grapheme :: last, chunks)
+        else if l = n
+        then ([grapheme], (List.rev last |> StringLabels.concat ~sep:"") :: chunks)
+        else assert false)
+      ([], [])
+      s
+  in
+  (List.rev last |> StringLabels.concat ~sep:"") :: chunks |> List.rev
+
+let utf8_clamp_at n s =
+  let first =
+    Uuseg_string.fold_utf_8
+      `Grapheme_cluster
+      (fun acc grapheme -> if List.length acc < n then grapheme :: acc else acc)
+      []
+      s
+  in
+  let first = String.concat "" (List.rev first) in
+  let l = String.length first in
+  let rest = String.sub s l (String.length s - l) in
+  (first, rest)
+
+let clamp_at_space_up_to n s =
+  let module S = StringLabels in
+  let module L = ListLabels in
+  let words = S.split_on_char ~sep:' ' s |> L.map ~f:S.trim |> L.filter ~f:(( <> ) "") in
+
+  let words =
+    match words with
+    | first :: rest ->
+      let l_fst = length first in
+      if l_fst <= n
+      then first :: rest
+      else
+        (* Prima parola troppo lunga, forza lo split anche se non è sullo spazio *)
+        let fst, snd = utf8_clamp_at n first in
+        fst :: snd :: rest
+    | [] -> []
+  in
+
+  let rec loop acc words =
+    match words with
+    | hd :: tl ->
+      let l = length hd in
+      if l <= n
+      then loop (hd :: acc) tl
+      else
+        let words' = split_in_chunks_of n hd in
+        loop (L.rev words' @ acc) tl
+    | [] -> L.rev acc
+  in
+  let words = loop [] words in
+
+  let rec loop ?(ok = []) ?(total_chars = 0) ?(total_words = 0) words =
+    match words with
+    | hd :: tl ->
+      let l = length hd in
+      if total_chars + total_words + l > n
+      then (L.rev ok |> S.concat ~sep:" ", S.concat ~sep:" " words)
+      else loop ~ok:(hd :: ok) ~total_chars:(total_chars + l) ~total_words:(total_words + 1) tl
+    | [] -> (L.rev ok |> S.concat ~sep:" ", "")
+  in
+  loop words
+
+let split_at_space_up_to n s =
+  let rec loop ?(acc = []) s =
+    let s', rest = clamp_at_space_up_to n s in
+    let acc = s' :: acc in
+    if rest = "" then List.rev acc else loop ~acc rest
+  in
+  loop s
+
+let recode_string ?(encoding = `UTF_8) src =
+  let dst = Buffer.create 4 in
+  let rec loop d e =
+    match Uutf.decode d with
+    | `Uchar _ as u ->
+      let (_ : [`Ok | `Partial]) = Uutf.encode e u in
+      loop d e
+    | `End ->
+      let (_ : [`Ok | `Partial]) = Uutf.encode e `End in
+      ()
+    | `Malformed _ ->
+      let (_ : [`Ok | `Partial]) = Uutf.encode e (`Uchar Uutf.u_rep) in
+      loop d e
+    | `Await -> assert false
+  in
+  let d = Uutf.decoder ~nln:(`NLF (Uchar.of_int 10)) ~encoding (`String src) in
+  let e = Uutf.encoder `UTF_8 (`Buffer dst) in
+  let () = loop d e in
+  Buffer.contents dst