Paolo Donadeo
fce66c5c78
- Change predicate return type from `bool` to `features list option` to carry extracted event data (Summary, Day_start, Multi_day) alongside match results - Add `features` type with Generic_feature_presence, Summary, Day_start, Multi_day variants - Add P00 (has_summary) and P11 (override_events) predicates - Remove large commented-out icalendar/ptime type definitions - Refactor main.ml to group events by UID using a Map - Add get_y_m_d_from_timedesc helper to Utils
358 lines
11 KiB
OCaml
358 lines
11 KiB
OCaml
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 =
|
||
[ `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 *) ]
|
||
[@@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 predicate = Icalendar.event -> features list option
|
||
|
||
let has_summary ev : features list option =
|
||
(* P00 *)
|
||
let summary_opt =
|
||
List.find_map
|
||
(function
|
||
| `Summary (_, s) -> Some [Summary s]
|
||
| _ -> None)
|
||
ev.props
|
||
in
|
||
match summary_opt with
|
||
| Some s -> Some s
|
||
| None -> None
|
||
|
||
let all_day_event_single ev : features list option =
|
||
(* P01 *)
|
||
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
|
||
|
||
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
|
||
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 =
|
||
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
|
||
|
||
let all_predicates : (predicate * 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);
|
||
]
|