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

Initial commit

Browse Source
This commit is contained in:
Paolo Donadeo
2025-09-01 00:00:00 +02:00
commit cace23d3f1
21 changed files with 6678 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

17
bin/commandLine.ml Normal file
View File

@@ -0,0 +1,17 @@
open Cmdliner
open Cmdliner.Term.Syntax
let ical_file =
let doc = "TODO" in
let docv = "ICAL" in
Arg.(required & pos ~rev:true 0 (some string) None & info [] ~docv ~doc)
let main_command f =
let doc = "Convert iCalendar files to remind format" in
let man = [] in
Cmd.make (Cmd.info "ical2rem" ~version:"%%VERSION%%" ~doc ~man)
@@
let+ ical_file = ical_file in
f ical_file
let main f = Cmd.eval @@ main_command f

13
bin/dune Normal file
View File

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

349
bin/eventPredicates.ml Normal file
View File

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

44
bin/main.ml Normal file
View File

@@ -0,0 +1,44 @@
open Remind_sync
module Map = MoreLabels.Map.Make (String)
(*
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
(e.g., due to updates or recurring events or cancellations).
*)
let ical2rem ical_file =
let ic = open_in ical_file in
let n = in_channel_length ic in
let s = Bytes.create n in
really_input ic s 0 n;
close_in ic;
let cal_or_error = Icalendar.parse (Bytes.unsafe_to_string s) in
match cal_or_error with
| 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 : Icalendar.event list Map.t =
ListLabels.fold_left ~init:Map.empty components ~f:(fun acc comp ->
match comp with
| `Event ev ->
let uid = Utils.get_uid ev in
let event_list = Map.find_opt uid acc |> Option.value ~default:[] in
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); *)
Map.iter events_map ~f:(fun ~key:uid ~data:events ->
let rem_or_error = EventPredicates.remind_of_event events in
match rem_or_error with
| Ok rem -> begin Printf.printf "%s\n" (Remind.string_of_rem rem) end
| Error (EventPredicates.Invalid_date s) -> Printf.eprintf "UID: %s Invalid date: %s\n" uid s
| Error Skip -> Printf.eprintf "UID: %s Skipped\n" uid)
end
let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)

62
bin/remind.ml Normal file
View File

@@ -0,0 +1,62 @@
open Remind_sync
open Utils
type rem = {
original_uuid : string; (** Original UID from the iCalendar event *)
summary : string; (** Summary or title of the reminder *)
date : Timedesc.Date.t; (** Date specification (day, month, year) *)
end_date : Timedesc.Date.t option; (** Optional end date for a date range *)
time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *)
duration : Timedesc.Span.t option; (** Optional duration for timed events *)
simple_yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *)
recurring : Icalendar.event list;
(** List of events that are part of the same recurring series: these are only the overrides, not the master event
*)
}
[@@deriving show]
(** A complete REM command *)
let empty =
{
original_uuid = "";
summary = "";
date = Timedesc.Date.Ymd.make_exn ~year:1970 ~month:1 ~day:1;
end_date = None;
time = None;
duration = None;
simple_yearly = None;
recurring = [];
}
let render_simple_yearly month day summary =
let month_str = month_of_int month |> string_of_month in
spf "REM %s %d MSG %s" month_str day summary
let string_of_rem rem =
match rem.simple_yearly with
| Some (month, day) -> render_simple_yearly month day rem.summary
| None -> begin
let b = Buffer.create 256 in
Buffer.add_string b "REM ";
Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid);
Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date);
(match rem.time with
| Some time ->
Buffer.add_string b " AT ";
Buffer.add_string b (string_of_time time)
| None -> ());
(match rem.duration with
| Some duration ->
Buffer.add_string b " DURATION ";
Buffer.add_string b (string_of_span duration);
Buffer.add_string b ""
| None -> ());
(match rem.end_date with
| Some end_date ->
Buffer.add_string b " THROUGH ";
Buffer.add_string b (Timedesc.Date.to_rfc3339 end_date)
| None -> ());
Buffer.add_string b " MSG ";
Buffer.add_string b rem.summary;
Buffer.contents b
end

167
bin/utils.ml Normal file
View File

@@ -0,0 +1,167 @@
open Remind_sync
open Icalendar
type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
let month_of_int = function
| 1 -> Jan
| 2 -> Feb
| 3 -> Mar
| 4 -> Apr
| 5 -> May
| 6 -> Jun
| 7 -> Jul
| 8 -> Aug
| 9 -> Sep
| 10 -> Oct
| 11 -> Nov
| 12 -> Dec
| _ -> failwith "Invalid month number"
let string_of_month = function
| Jan -> "Jan"
| Feb -> "Feb"
| Mar -> "Mar"
| Apr -> "Apr"
| May -> "May"
| Jun -> "Jun"
| Jul -> "Jul"
| Aug -> "Aug"
| Sep -> "Sep"
| Oct -> "Oct"
| Nov -> "Nov"
| Dec -> "Dec"
let spf = Printf.sprintf
let get_uid ev =
let _, uid = ev.uid in
uid
(* Questa funzione serve solo da esempio per copia e incolla *)
let unpack_date_or_datetime (d_or_dt : Icalendar.date_or_datetime) =
match d_or_dt with
| `Datetime (`Local _ptime_ts) -> ()
| `Datetime (`Utc _ts) -> ()
| `Datetime (`With_tzid (_ts, (_b, _tz_name))) -> ()
| `Date (_year, _month, _day) -> ()
(* Questa funzione serve solo da esempio per copia e incolla *)
let unpack_dtend_or_duration dtend_or_dur =
match dtend_or_dur with
| None -> ()
| Some (`Dtend (_, date_or_datetime)) -> unpack_date_or_datetime date_or_datetime
| Some (`Duration (_, _duration)) -> ()
let string_of_time (t : Timedesc.Time.t) : string =
let view = Timedesc.Time.view t in
let hour, minute = (view.Timedesc.Time.hour, view.Timedesc.Time.minute) in
spf "%02d:%02d" hour minute
let string_of_span (sp : Timedesc.Span.t) : string =
let view = Timedesc.Span.For_human.view sp in
let hours, minutes = (view.Timedesc.Span.For_human.hours, view.Timedesc.Span.For_human.minutes) in
spf "%02d:%02d" hours minutes
let timedesc_of_timestamp (ts : timestamp) : Timedesc.t =
let local_tz = Timedesc.Time_zone.local_exn () in
match ts with
| `Local t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz
(* this case is not present in my current dataset… *)
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz
| `With_tzid (ts, (_b, tz_name)) ->
(* Qui il timestamp è SCRITTO come se fosse UTC (+00:00) ma in realtà va interpretato con
il fuso orario indicato da tz_name. *)
let tz = Timedesc.Time_zone.make_exn tz_name in
let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in
let date = Timedesc.date (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
let year, month, day = (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date) in
let time = Timedesc.time_view (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in
Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz ()
let timedesc_of_date_or_datetime (t : date_or_datetime) : Timedesc.t =
match t with
| `Datetime (`Local _ptime_ts) ->
(* this case is not present in my current dataset… *)
failwith "Unhandled case: `Local datetime"
| `Datetime (`Utc ts) ->
Timedesc.Utils.timestamp_of_ptime ts
|> Timedesc.of_timestamp_exn ~tz_of_date_time:(Timedesc.Time_zone.local_exn ())
| `Datetime (`With_tzid (ts, (_b, tz_name))) ->
(* Qui il timestamp è SCRITTO come se fosse UTC (+00:00) ma in realtà va interpretato con
il fuso orario indicato da tz_name. *)
let tz = Timedesc.Time_zone.make_exn tz_name in
let wrong_ts = Timedesc.Utils.timestamp_of_ptime ts in
let date = Timedesc.date (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
let year, month, day = (Timedesc.Date.year date, Timedesc.Date.month date, Timedesc.Date.day date) in
let time = Timedesc.time_view (Timedesc.of_timestamp_exn ~tz_of_date_time:Timedesc.Time_zone.utc wrong_ts) in
let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) in
Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz ()
| `Date (year, month, day) ->
Timedesc.make_exn ~year ~month ~day ~hour:0 ~minute:0 ~second:0 ~tz:(Timedesc.Time_zone.local_exn ()) ()
let get_exdates ev =
let event_props = ev.props in
let dates_or_datetimes =
List.filter_map
(fun prop ->
match prop with
| `Exdate (_, dates) -> Some dates
| _ -> None)
event_props
in
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
let added =
match dates with
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
| `Dates date_list -> List.map (fun date -> `Date date) date_list
in
added @ acc)
|> List.map timedesc_of_date_or_datetime
let get_rdates ev =
let event_props = ev.props in
let dates_or_datetimes =
List.filter_map
(fun prop ->
match prop with
| `Rdate (_, dates) -> Some dates
| _ -> None)
event_props
in
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
let added =
match dates with
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
| `Dates date_list -> List.map (fun date -> `Date date) date_list
| `Periods _ ->
(* Ignored for now, does not appear in my current dataset *)
failwith "Unhandled case: `Periods in RDATE"
in
added @ acc)
|> List.map timedesc_of_date_or_datetime
let get_recurrence_id ev =
List.find_map
(fun prop ->
match prop with
| `Recur_id (_, date_or_datetime) -> Some date_or_datetime
| _ -> None)
ev.props
let separate_master_and_recurrence (events : Icalendar.event list) : Icalendar.event * Icalendar.event list =
(* List.iteri (fun i e -> Printf.eprintf "%02d: %s\n" (i + 1) (Icalendar.show_component (`Event e))) events; *)
let recur_ids = List.map (fun ev -> (ev, get_recurrence_id ev)) events in
let master_and_recurrences =
List.partition_map
(fun (ev, recur_id_opt) ->
match recur_id_opt with
| None -> Right ev
| Some _ -> Left ev)
recur_ids
in
match master_and_recurrences with
| [], _ -> failwith "No master event found"
| master :: _, recurrences -> (master, recurrences)