pdonadeo/ical2rem
1
0
Fork 0
Code Issues Pull Requests Actions Projects Releases 1 Activity

refactor: replace predicate-based event matching with collector pipeline

Browse Source 
- 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
This commit is contained in:
Paolo Donadeo
2026-05-14 23:13:33 +02:00
parent fce66c5c78
commit c78d94e004
15 changed files with 894 additions and 763 deletions
Download Patch File Download Diff File Expand all files Collapse all files

294
bin/eventPredicates.ml
View File

@@ -1,3 +1,4 @@
open Remind_sync
open Icalendar
open Utils
@@ -172,186 +173,159 @@ open Utils
*)
type event_description =
[ `Has_summary (* P00 *)
| `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 *) ]
[ `Collect_uuid | `Has_summary | `All_day_event | `Expand_recurrence | `Simple_weekly_recurrence ]
[@@deriving show]
type features =
| 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 error = Invalid_date of string | Skip [@@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 =
(* P00 *)
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 [Summary s]
| `Summary (_, s) -> Some s
| _ -> None)
ev.props
in
match summary_opt with
| Some s -> Some s
| None -> None
| Some s -> Ok { rem with Remind.summary = s }
| None -> Ok { rem with Remind.summary = "" }
let all_day_event_single ev : features list option =
(* P01 *)
let collect_start_end_duration rem ev : (Remind.rem, error) result =
let _, dtstart = ev.dtstart in
match dtstart with
| `Date d ->
begin match ev.dtend_or_duration with
| None ->
let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
Some [Day_start (y, m, d)]
| Some (`Dtend (_, `Date end_)) -> begin
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
let y, m, d = get_y_m_d_from_timedesc (get_start ev) in
Some [Day_start (y, m, d)]
else None
end
| _ -> None
end
| _ -> None
| `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
| 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 = Timedesc.Date.add ~days:(-1) 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)) -> skip
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) } in
let all_day_event_multi ev : features list option =
(* P02 *)
let _, dtstart = ev.dtstart in
match dtstart with
| `Date d ->
begin match ev.dtend_or_duration with
| None -> None
| Some (`Dtend (_, `Date end_)) -> begin
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
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) -> 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 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 expand_recurrence rem ev : (Remind.rem, error) result =
if List.length rem.Remind.recurring > 0 then skip else Ok rem
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 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]
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
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]
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 =
List.find_map
(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 ->
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
end
QUESTE SONO **TUTTE** LE RRULE NEL MIO DATASET
let all_predicates : (predicate * event_description) list =
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);
(all_day_event_single, `All_day_event_single);
(all_day_event_multi, `All_day_event_multi);
(timed_event, `Timed_event);
(weekly_simple_recurrence, `Weekly_simple_recurrence);
(daily_simple_recurrence, `Daily_simple_recurrence);
(exception_events, `Exception_events);
(override_events, `Override_events);
(collect_uuid, `Collect_uuid);
(collect_summary, `Has_summary);
(collect_start_end_duration, `All_day_event);
(expand_recurrence, `Expand_recurrence);
(simple_weekly_recurrence, `Simple_weekly_recurrence);
]
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)