350 lines
15 KiB
OCaml
350 lines
15 KiB
OCaml
open Remind_sync
|
||
open Icalendar
|
||
open Utils
|
||
|
||
(* CASE ANALYSIS PREDICATES
|
||
- id: P00
|
||
pattern: Ha un SUMMARY?
|
||
ics: "SUMMARY:…"
|
||
remind_support: nativo
|
||
strategia: "REM <data> MSG <summary>"
|
||
snippet: 'REM 2025-12-25 MSG Natale'
|
||
priorita: Subito
|
||
|
||
- id: P01
|
||
pattern: All-day singolo
|
||
ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
|
||
remind_support: nativo
|
||
strategia: "REM <data> MSG <summary>"
|
||
snippet: 'REM 2025-12-25 MSG Natale'
|
||
priorita: Subito
|
||
|
||
- id: P02
|
||
pattern: All-day multi-giorno
|
||
ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "espandi in eventi giornalieri; stesso SUMMARY"
|
||
snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno'
|
||
priorita: Subito
|
||
|
||
- id: P03
|
||
pattern: Evento a orario locale
|
||
ics: "DTSTART;TZID=… + DTEND oppure DURATION"
|
||
remind_support: nativo
|
||
strategia: "REM <data> AT <hh:mm> [DURATION] MSG …"
|
||
snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
|
||
priorita: Subito
|
||
|
||
- id: P04
|
||
pattern: Evento a orario in UTC
|
||
ics: "DTSTART/DTEND con suffisso Z"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "converti a fuso locale prima di emettere AT"
|
||
snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
|
||
priorita: Subito
|
||
|
||
- id: P05
|
||
pattern: Ricorrenza settimanale semplice
|
||
ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
|
||
remind_support: nativo
|
||
strategia: "REM <giorni> FROM <start> [UNTIL <end>] AT <hh:mm> MSG …"
|
||
snippet: 'REM Mon Wed FROM 2025-09-01 UNTIL 2025-10-31 AT 09:00 MSG Standup'
|
||
priorita: Subito
|
||
|
||
- id: P06
|
||
pattern: Ricorrenza giornaliera semplice
|
||
ics: "RRULE:FREQ=DAILY;[UNTIL|COUNT]"
|
||
remind_support: nativo
|
||
strategia: "REM FROM <start> UNTIL <end> AT <hh:mm> EVERY 1 MSG …"
|
||
snippet: 'REM FROM 2025-10-01 UNTIL 2025-10-10 AT 08:30 MSG Daily'
|
||
priorita: Subito
|
||
|
||
- id: P07
|
||
pattern: Ricorrenza mensile per giorno fisso
|
||
ics: "RRULE:FREQ=MONTHLY;BYMONTHDAY=…"
|
||
remind_support: nativo
|
||
strategia: "REM <giorno-num> AT <hh:mm> FROM/UNTIL"
|
||
snippet: 'REM 15 AT 10:00 FROM 2025-01-01 MSG Fatture'
|
||
priorita: Dopo
|
||
|
||
- id: P08
|
||
pattern: Ricorrenza “n-esimo weekday” del mese
|
||
ics: "RRULE:FREQ=MONTHLY;BYDAY=MO;BYSETPOS=3"
|
||
remind_support: espansione
|
||
strategia: "materializza occorrenze in singoli REM o calcola in codice"
|
||
snippet: '# genera REM per ciascuna data calcolata'
|
||
priorita: Dopo
|
||
|
||
- id: P09
|
||
pattern: Ricorrenza annuale semplice
|
||
ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
|
||
remind_support: nativo
|
||
strategia: "REM <data ricorrente> MSG …"
|
||
snippet: 'REM Jul 29 MSG Compleanno'
|
||
priorita: Dopo
|
||
|
||
- id: P10
|
||
pattern: Eccezioni
|
||
ics: "EXDATE (una o più), RDATE aggiuntive"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "usa OMIT per rimuovere date; aggiungi REM singoli per RDATE"
|
||
snippet: 'REM Mon AT 09:00 FROM 2025-09-01 UNTIL 2025-10-31 MSG Standup\nOMIT 2025-10-13'
|
||
priorita: Subito
|
||
|
||
- id: P11
|
||
pattern: Override/cancellazioni per istanza
|
||
ics: "RECURRENCE-ID con contenuto modificato o STATUS:CANCELLED"
|
||
remind_support: espansione
|
||
strategia: "OMIT la data dalla serie; aggiungi REM singolo con i campi override"
|
||
snippet: '# serie + REM specifico per l’istanza'
|
||
priorita: Subito
|
||
|
||
- id: P12
|
||
pattern: DURATION al posto di DTEND
|
||
ics: "DURATION:PT…"
|
||
remind_support: nativo
|
||
strategia: "mappa su DURATION <h:mm> in REM"
|
||
snippet: 'REM 2025-10-05 AT 14:00 DURATION 2:30 MSG Workshop'
|
||
priorita: Subito
|
||
|
||
- id: P13
|
||
pattern: Allarmi
|
||
ics: "VALARM DISPLAY/AUDIO/EMAIL; TRIGGER relativo"
|
||
remind_support: parziale
|
||
strategia: "mappa 1 allarme principale su WARN; multipli opzionali come REM duplicati HIDE"
|
||
snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
|
||
priorita: Dopo
|
||
|
||
- id: P14
|
||
pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
|
||
ics: "VTIMEZONE + DTSTART;TZID=…"
|
||
remind_support: nativo+accorgimenti
|
||
strategia: "normalizza tutto al fuso locale del sistema prima dell’output"
|
||
snippet: '# conversione in pre-processing'
|
||
priorita: Subito
|
||
|
||
- id: P15
|
||
pattern: Partecipanti/organizzatore
|
||
ics: "ORGANIZER, ATTENDEE*, PARTSTAT…"
|
||
remind_support: non previsto
|
||
strategia: "appendi a DESCRIPTION/MSG come testo"
|
||
snippet: '# nessuna semantica in Remind'
|
||
priorita: Quando serve
|
||
|
||
- id: P16
|
||
pattern: Allegati/URL esterni
|
||
ics: "ATTACH, URL"
|
||
remind_support: non previsto
|
||
strategia: "conserva URL in coda al MSG"
|
||
snippet: '# link nel testo'
|
||
priorita: Quando serve
|
||
|
||
- id: P17
|
||
pattern: Meeting online (Google/Teams metadati)
|
||
ics: "X-GOOGLE-CONFERENCE, X-MICROSOFT-*"
|
||
remind_support: non previsto
|
||
strategia: "estrai solo URL di join nel MSG"
|
||
snippet: '# riduci al link'
|
||
priorita: Quando serve
|
||
|
||
- id: P18
|
||
pattern: Visibilità/trasparenza
|
||
ics: "CLASS, TRANSP"
|
||
remind_support: non previsto
|
||
strategia: "ignora o aggiungi prefisso [FREE]/[BUSY] nel MSG"
|
||
snippet: '# opzionale'
|
||
priorita: Ignora
|
||
|
||
- id: P19
|
||
pattern: Stato/versioning
|
||
ics: "STATUS, SEQUENCE, CREATED, LAST-MODIFIED"
|
||
remind_support: non previsto
|
||
strategia: "ignora; usa solo STATUS:CANCELLED per soppressioni"
|
||
snippet: '# già coperto in P11'
|
||
priorita: Ignora
|
||
|
||
- id: P20
|
||
pattern: Categorie/etichette
|
||
ics: "CATEGORIES:…"
|
||
remind_support: parziale
|
||
strategia: "prefisso nel MSG o uso TAG se ti serve filtrare"
|
||
snippet: 'REM 2025-10-05 AT 09:00 TAG Work MSG [Work] Riunione'
|
||
priorita: Dopo
|
||
*)
|
||
|
||
type event_description =
|
||
[ `Collect_uuid
|
||
| `Has_summary
|
||
| `All_day_event
|
||
| `Expand_recurrence
|
||
| `Yearly_simple_date
|
||
| `Simple_weekly_recurrence ]
|
||
[@@deriving show]
|
||
|
||
type error = Invalid_date of string | Skip [@@deriving show]
|
||
|
||
let invalid_date s e =
|
||
Error (Invalid_date (spf "Invalid date: %s, error: %s" s (Remind_sync.Timedesc.Date.Ymd.show_error e)))
|
||
|
||
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 s
|
||
| _ -> None)
|
||
ev.props
|
||
in
|
||
match summary_opt with
|
||
| Some s -> Ok { rem with Remind.summary = s }
|
||
| None -> Ok { rem with Remind.summary = "" }
|
||
|
||
let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
||
let _, dtstart = ev.dtstart in
|
||
match dtstart with
|
||
| `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
|
||
|
||
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 expand_recurrence rem ev : (Remind.rem, error) result =
|
||
if List.length rem.Remind.recurring > 0 then skip else Ok rem
|
||
|
||
let yearly_simple_date rem ev : (Remind.rem, error) result =
|
||
match ev.rrule with
|
||
| Some (_, (`Yearly, None, None, [])) ->
|
||
let month, day = (Timedesc.Date.month rem.Remind.date, Timedesc.Date.day rem.Remind.date) in
|
||
Ok { rem with Remind.simple_yearly = Some (month, day) }
|
||
| Some _ -> Ok rem
|
||
| None -> Ok rem
|
||
|
||
let simple_weekly_recurrence rem ev : (Remind.rem, error) result =
|
||
(*
|
||
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, []) UID: 0b48208b22php2mv6r157rk23v@google.com
|
||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0cb95edhq1d00bd3gcpomb9mcg@google.com
|
||
RRULE: (`Daily, (Some `Count (11)), None, []) UID: 0kbt3i5d6dpq6uncmhlcr335vq@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 11:15:00 +00:00))), None, [`Weekday (`Monday)]) UID: dmkfr0h3p1fq6p6v8i62vm1n4k@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2008-05-11 15:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: bh5mhev3uq6p5casisrqufksd8@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-24 22:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: tsdjd2jlcsgi0c0ei1celg41v4@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2014-12-25 10:00:00 +00:00))), None, [`Weekday (`Monday)]) UID: ha0rjkp62uqh3boc9n6k4f6cuo@google.com
|
||
RRULE: (`Daily, (Some `Until (`Utc (2025-05-22 07:00:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E008000000008FD3AF9B24B9DB01000000000000000010000000A152B8147DB736439366702297C68F98
|
||
RRULE: (`Daily, (Some `Until (`Utc (2026-02-04 13:30:00 +00:00))), (Some 1), []) UID: 040000008200E00074C5B7101A82E00800000000CEF108493A94DC010000000000000000100000005D7F32754B6575419990179984830EFC
|
||
RRULE: (`Weekly, (Some `Count (3)), None, [`Byday ([(0, `Wednesday)])]) UID: 605de987-4600-419f-a40a-eb585b7e1ba2
|
||
RRULE: (`Weekly, (Some `Count (7)), (Some 2), [`Byday ([(0, `Tuesday)])]) UID: 13C-6A06C880-D-48221A00
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2009-07-31 18:00:00 +00:00))), None, [`Byday ([(0, `Tuesday); (0, `Friday)]); `Weekday (`Monday)]) UID: hrpg4ovdou2ae57pqb9niobb3c@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2013-04-18 17:30:00 +00:00))), None, [`Byday ([(0, `Monday); (0, `Thursday)])]) UID: ool8g85jgfd5db57mdqbkt52nk@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2014-12-20 10:30:00 +00:00))), None, [`Byday ([(0, `Saturday)])]) UID: rr96e7fr98g8j9vner8mmdtfls@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2020-09-16 21:59:59 +00:00))), None, [`Byday ([(0, `Thursday)])]) UID: 5n174r33j7ep7t5eete9307949@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2021-08-25 21:59:59 +00:00))), None, [`Byday ([(0, `Wednesday)]); `Weekday (`Monday)]) UID: 20kb6se0oog5e9hi5l7uu6jiq6@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2021-09-18 21:59:59 +00:00))), (Some 1), [`Byday ([(0, `Sunday)]); `Weekday (`Monday)]) UID: 6sp30e9oc4sjebb264o3gb9kcos3ab9pccoj2b9j6kom2chjcco6ad9nck@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2024-06-12 08:00:00 +00:00))), (Some 4), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: 040000008200E00074C5B7101A82E00800000000DD1EB23CE8ACDA01000000000000000010000000FED71D085A97144F8C716EC999301E3A
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2025-02-04 22:59:59 +00:00))), (Some 1), [`Weekday (`Sunday); `Byday ([(0, `Wednesday)])]) UID: _60q30c1g60o30e1i60o4ac1g60rj8gpl88rj2c1h84s34h9g60s30c1g60o30c1g85248hhg6kq30hhn6ork8ghg64o30c1g60o30c1g60o30c1g60o32c1g60o30c1g6kqj4g9g89234chl852kadpk890j2h9m6op44dpn6t238h1k8ks0_R20250129T080000@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2025-06-22 21:59:59 +00:00))), (Some 1), [`Weekday (`Monday); `Byday ([(0, `Monday)])]) UID: 040000008200E00074C5B7101A82E00800000000AE5AF0ED6ADCDB0100000000000000001000000040E4ACABB0843749950BEB4B273F862E
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2026-02-24 22:59:59 +00:00))), (Some 2), [`Weekday (`Monday); `Byday ([(0, `Tuesday)])]) UID: fjlqvi1ekuefpa8rb65meoklct@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Weekday (`Monday); `Byday ([(0, `Wednesday)])]) UID: 1iue0uq2l3imtfdsff785o9u35@google.com
|
||
RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) UID: 4479f7fd-7be9-470f-bc10-5ed61636547b
|
||
*)
|
||
match ev.rrule with
|
||
| Some (_, (`Yearly, None, None, [])) -> Ok rem
|
||
| 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 =
|
||
[
|
||
(collect_uuid, `Collect_uuid);
|
||
(collect_summary, `Has_summary);
|
||
(collect_start_end_duration, `All_day_event);
|
||
(expand_recurrence, `Expand_recurrence);
|
||
(yearly_simple_date, `Yearly_simple_date);
|
||
(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)
|