feat: implement simple weekly recurrence rendering
- Add `simple_weekly` type and `weekly` field to `rem` record
- Add `exdate` field to `rem` for excluded dates
- Add `collect_exdates` collector to pipeline
- implement weekly `RRULE` handling with `BYDAY`, `INTERVAL`,
`COUNT`/`UNTIL`
- Add `render_weekly` to emit one `REM` per weekday with `UNTIL`/`*N`
- Replace `timedesc_of_date_or_datetime` with
`timedesc_of_utc_or_timestamp_local` in utils
- Refactor `get_exdates`/`get_rdates` to separate dates, datetimes and
periods; add debug logging per UID
- Wrap reminder output in try/catch in main; drop trailing newline
duplication
- Mark implemented predicates (P00–P05, P09, P12, P14) with ✅;
remove P18–P20 (ignored/deferred)
This commit is contained in:
@@ -3,7 +3,7 @@ open Icalendar
|
|||||||
open Utils
|
open Utils
|
||||||
|
|
||||||
(* CASE ANALYSIS PREDICATES
|
(* CASE ANALYSIS PREDICATES
|
||||||
- id: P00
|
- id: P00 ✅
|
||||||
pattern: Ha un SUMMARY?
|
pattern: Ha un SUMMARY?
|
||||||
ics: "SUMMARY:…"
|
ics: "SUMMARY:…"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -11,7 +11,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-12-25 MSG Natale'
|
snippet: 'REM 2025-12-25 MSG Natale'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P01
|
- id: P01 ✅
|
||||||
pattern: All-day singolo
|
pattern: All-day singolo
|
||||||
ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
|
ics: "DTSTART;VALUE=DATE, opzionale DTEND=giorno+1"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -19,7 +19,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-12-25 MSG Natale'
|
snippet: 'REM 2025-12-25 MSG Natale'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P02
|
- id: P02 ✅
|
||||||
pattern: All-day multi-giorno
|
pattern: All-day multi-giorno
|
||||||
ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
|
ics: "DTSTART;VALUE=DATE + DTEND;VALUE=DATE esclusivo"
|
||||||
remind_support: nativo+accorgimenti
|
remind_support: nativo+accorgimenti
|
||||||
@@ -27,7 +27,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno'
|
snippet: 'REM 2025-08-10 THROUGH 2025-08-15 MSG Ferie # oppure espansione per-giorno'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P03
|
- id: P03 ✅
|
||||||
pattern: Evento a orario locale
|
pattern: Evento a orario locale
|
||||||
ics: "DTSTART;TZID=… + DTEND oppure DURATION"
|
ics: "DTSTART;TZID=… + DTEND oppure DURATION"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -35,7 +35,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
|
snippet: 'REM 2025-10-05 AT 09:00 DURATION 1:00 MSG Riunione'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P04
|
- id: P04 ✅
|
||||||
pattern: Evento a orario in UTC
|
pattern: Evento a orario in UTC
|
||||||
ics: "DTSTART/DTEND con suffisso Z"
|
ics: "DTSTART/DTEND con suffisso Z"
|
||||||
remind_support: nativo+accorgimenti
|
remind_support: nativo+accorgimenti
|
||||||
@@ -43,7 +43,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
|
snippet: 'REM 2025-09-03 AT 06:45 MSG Treno'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P05
|
- id: P05 ✅
|
||||||
pattern: Ricorrenza settimanale semplice
|
pattern: Ricorrenza settimanale semplice
|
||||||
ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
|
ics: "RRULE:FREQ=WEEKLY;BYDAY=…;[UNTIL|COUNT]"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -75,7 +75,7 @@ open Utils
|
|||||||
snippet: '# genera REM per ciascuna data calcolata'
|
snippet: '# genera REM per ciascuna data calcolata'
|
||||||
priorita: Dopo
|
priorita: Dopo
|
||||||
|
|
||||||
- id: P09
|
- id: P09 ✅
|
||||||
pattern: Ricorrenza annuale semplice
|
pattern: Ricorrenza annuale semplice
|
||||||
ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
|
ics: "RRULE:FREQ=YEARLY;[BYMONTH][BYMONTHDAY]"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -99,7 +99,7 @@ open Utils
|
|||||||
snippet: '# serie + REM specifico per l’istanza'
|
snippet: '# serie + REM specifico per l’istanza'
|
||||||
priorita: Subito
|
priorita: Subito
|
||||||
|
|
||||||
- id: P12
|
- id: P12 ✅
|
||||||
pattern: DURATION al posto di DTEND
|
pattern: DURATION al posto di DTEND
|
||||||
ics: "DURATION:PT…"
|
ics: "DURATION:PT…"
|
||||||
remind_support: nativo
|
remind_support: nativo
|
||||||
@@ -115,7 +115,7 @@ open Utils
|
|||||||
snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
|
snippet: 'REM 2025-10-05 AT 09:00 WARN 15 MSG Riunione'
|
||||||
priorita: Dopo
|
priorita: Dopo
|
||||||
|
|
||||||
- id: P14
|
- id: P14 ✅
|
||||||
pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
|
pattern: Fusi orari dichiarati (VTIMEZONE, TZID diversi)
|
||||||
ics: "VTIMEZONE + DTSTART;TZID=…"
|
ics: "VTIMEZONE + DTSTART;TZID=…"
|
||||||
remind_support: nativo+accorgimenti
|
remind_support: nativo+accorgimenti
|
||||||
@@ -146,41 +146,8 @@ open Utils
|
|||||||
strategia: "estrai solo URL di join nel MSG"
|
strategia: "estrai solo URL di join nel MSG"
|
||||||
snippet: '# riduci al link'
|
snippet: '# riduci al link'
|
||||||
priorita: Quando serve
|
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]
|
type error = Invalid_date of string | Skip [@@deriving show]
|
||||||
|
|
||||||
let invalid_date s e =
|
let invalid_date s e =
|
||||||
@@ -215,17 +182,22 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
|||||||
| Ok day_start ->
|
| Ok day_start ->
|
||||||
begin match ev.dtend_or_duration with
|
begin match ev.dtend_or_duration with
|
||||||
| None -> { rem with Remind.date = day_start } |> Result.ok
|
| None -> { rem with Remind.date = day_start } |> Result.ok
|
||||||
| Some (`Dtend (_, `Datetime _)) -> skip
|
| Some (`Dtend (_, `Datetime _)) ->
|
||||||
|
skip (* Start is a date, end is a datetime: invalid case for all-day event *)
|
||||||
| Some (`Dtend (_, `Date (year, month, day))) ->
|
| Some (`Dtend (_, `Date (year, month, day))) ->
|
||||||
begin match Timedesc.Date.Ymd.make ~year ~month ~day with
|
begin match Timedesc.Date.Ymd.make ~year ~month ~day with
|
||||||
| Error e -> invalid_date "DTEND" e
|
| Error e -> invalid_date "DTEND" e
|
||||||
| Ok day_end ->
|
| Ok day_end ->
|
||||||
let day_end = Timedesc.Date.add ~days:(-1) day_end in
|
let day_end =
|
||||||
|
if Timedesc.Date.lt day_start day_end then Timedesc.Date.add ~days:(-1) day_end else day_end
|
||||||
|
in
|
||||||
if Timedesc.Date.diff_days day_end day_start = 0 then
|
if Timedesc.Date.diff_days day_end day_start = 0 then
|
||||||
Ok { rem with Remind.date = day_start; Remind.end_date = None }
|
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 }
|
else Ok { rem with Remind.date = day_start; Remind.end_date = Some day_end }
|
||||||
end
|
end
|
||||||
| Some (`Duration (_, _duration)) -> skip
|
| Some (`Duration (_, _duration)) ->
|
||||||
|
(* Start is a date, duration is not supported: invalid case for all-day event *)
|
||||||
|
skip
|
||||||
end)
|
end)
|
||||||
| `Datetime datetime -> begin
|
| `Datetime datetime -> begin
|
||||||
let start_td = Utils.timedesc_of_timestamp datetime in
|
let start_td = Utils.timedesc_of_timestamp datetime in
|
||||||
@@ -243,7 +215,9 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
|||||||
let rem = { rem with Remind.duration = Some duration } in
|
let rem = { rem with Remind.duration = Some duration } in
|
||||||
Ok rem
|
Ok rem
|
||||||
end
|
end
|
||||||
| `Date (_year, _month, _day) -> skip
|
| `Date (_year, _month, _day) ->
|
||||||
|
(* Start is a datetime, end is a date: invalid case for timed event *)
|
||||||
|
skip
|
||||||
end
|
end
|
||||||
| Some (`Duration (_, duration)) ->
|
| Some (`Duration (_, duration)) ->
|
||||||
let span = Timedesc.Utils.span_of_ptime_span duration in
|
let span = Timedesc.Utils.span_of_ptime_span duration in
|
||||||
@@ -251,18 +225,29 @@ let collect_start_end_duration rem ev : (Remind.rem, error) result =
|
|||||||
Ok rem
|
Ok rem
|
||||||
end
|
end
|
||||||
|
|
||||||
let expand_recurrence rem ev : (Remind.rem, error) result =
|
let collect_exdates rem ev : (Remind.rem, error) result =
|
||||||
|
let exdates = Utils.get_exdates ev in
|
||||||
|
Ok { rem with Remind.exdate = exdates }
|
||||||
|
|
||||||
|
let expand_recurrence rem _ev : (Remind.rem, error) result =
|
||||||
if List.length rem.Remind.recurring > 0 then skip else Ok rem
|
if List.length rem.Remind.recurring > 0 then skip else Ok rem
|
||||||
|
|
||||||
let yearly_simple_date rem ev : (Remind.rem, error) result =
|
let yearly_simple_date rem ev : (Remind.rem, error) result =
|
||||||
match ev.rrule with
|
match ev.rrule with
|
||||||
| Some (_, (`Yearly, None, None, [])) ->
|
| Some (_, (`Yearly, None, None, [])) ->
|
||||||
let month, day = (Timedesc.Date.month rem.Remind.date, Timedesc.Date.day rem.Remind.date) in
|
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) }
|
Ok { rem with Remind.yearly = Some (month, day) }
|
||||||
| Some _ -> Ok rem
|
| Some _ -> Ok rem
|
||||||
| None -> Ok rem
|
| None -> Ok rem
|
||||||
|
|
||||||
let simple_weekly_recurrence rem ev : (Remind.rem, error) result =
|
let debug_print_of_recurrence_and_skip ev recurs =
|
||||||
|
let uid = Utils.get_uid ev in
|
||||||
|
Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence recurs) uid;
|
||||||
|
skip
|
||||||
|
|
||||||
|
let simple_recurrence rem ev : (Remind.rem, error) result =
|
||||||
|
(* Here we want to handle simple recurrences, both weekly and daily, but without RDATE or EXDATE or overrides *)
|
||||||
|
|
||||||
(*
|
(*
|
||||||
type recur =
|
type recur =
|
||||||
[ `Byminute of int list
|
[ `Byminute of int list
|
||||||
@@ -309,23 +294,39 @@ RRULE: (`Weekly, (Some `Until (`Utc (2026-03-25 00:00:00 +00:00))), None, [`Week
|
|||||||
RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) UID: 4479f7fd-7be9-470f-bc10-5ed61636547b
|
RRULE: (`Weekly, (Some `Until (`Utc (2026-07-01 09:00:00 +00:00))), None, []) UID: 4479f7fd-7be9-470f-bc10-5ed61636547b
|
||||||
*)
|
*)
|
||||||
match ev.rrule with
|
match ev.rrule with
|
||||||
| Some (_, (`Yearly, None, None, [])) -> Ok rem
|
| Some (_, (`Yearly, None, None, [])) -> Ok rem (* handled in yearly_simple_date *)
|
||||||
| Some (_, (freq, count_or_until, interval, recurs)) ->
|
| Some (_, (`Weekly, count_or_until, interval, recurs)) ->
|
||||||
let _recur = (freq, count_or_until, interval, recurs) in
|
begin if List.length rem.recurring > 0 || List.length rem.exdate > 0 then (
|
||||||
let uid = Utils.get_uid ev in
|
Printf.eprintf "Warning: skipping complex recurrence with EXDATE/RDATE/overrides, not supported\t\t\tUID: %s\n"
|
||||||
Printf.eprintf "RRULE: %s\t\t\tUID: %s\n" (Icalendar.show_recurrence _recur) uid;
|
(Utils.get_uid ev);
|
||||||
skip
|
debug_print_of_recurrence_and_skip ev (`Weekly, count_or_until, interval, recurs))
|
||||||
(* TODO: implementare *)
|
else
|
||||||
|
let days =
|
||||||
|
ListLabels.filter_map recurs ~f:(function
|
||||||
|
| `Byday days -> begin List.map (fun (_n, weekday) -> weekday) days |> Option.some end
|
||||||
|
| _ -> None)
|
||||||
|
|> List.flatten
|
||||||
|
in
|
||||||
|
let week_start =
|
||||||
|
ListLabels.find_map recurs ~f:(function
|
||||||
|
| `Weekday `Sunday -> Some `Sunday
|
||||||
|
| `Weekday `Monday -> Some `Monday
|
||||||
|
| _ -> None)
|
||||||
|
in
|
||||||
|
Ok { rem with Remind.weekly = Some { count_or_until; interval; byday = days; week_start } }
|
||||||
|
end
|
||||||
|
| Some (_, recurs) -> debug_print_of_recurrence_and_skip ev recurs
|
||||||
| None -> Ok rem
|
| None -> Ok rem
|
||||||
|
|
||||||
let all_collectors : (collector * event_description) list =
|
let all_collectors : collector list =
|
||||||
[
|
[
|
||||||
(collect_uuid, `Collect_uuid);
|
collect_uuid;
|
||||||
(collect_summary, `Has_summary);
|
collect_summary;
|
||||||
(collect_start_end_duration, `All_day_event);
|
collect_start_end_duration;
|
||||||
(expand_recurrence, `Expand_recurrence);
|
collect_exdates;
|
||||||
(yearly_simple_date, `Yearly_simple_date);
|
expand_recurrence;
|
||||||
(simple_weekly_recurrence, `Simple_weekly_recurrence);
|
yearly_simple_date;
|
||||||
|
simple_recurrence;
|
||||||
]
|
]
|
||||||
|
|
||||||
let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
|
let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
|
||||||
@@ -343,7 +344,7 @@ let remind_of_event (ev : Icalendar.event list) : (Remind.rem, error) result =
|
|||||||
|
|
||||||
let rem = { Remind.empty with Remind.recurring = recurrence } 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) ->
|
ListLabels.fold_left ~init:(Ok rem) all_collectors ~f:(fun rem_or_error pred ->
|
||||||
match rem_or_error with
|
match rem_or_error with
|
||||||
| Error e -> Error e
|
| Error e -> Error e
|
||||||
| Ok rem -> pred rem master)
|
| Ok rem -> pred rem master)
|
||||||
|
|||||||
@@ -58,6 +58,9 @@ let ical2rem ical_files =
|
|||||||
good_rems_acc)
|
good_rems_acc)
|
||||||
in
|
in
|
||||||
|
|
||||||
ListLabels.iter good_rems ~f:(fun rem -> Printf.printf "%s\n" (Remind.string_of_rem rem))
|
try ListLabels.iter good_rems ~f:(fun rem -> Printf.printf "%s" (Remind.string_of_rem rem))
|
||||||
|
with e ->
|
||||||
|
Printf.eprintf "Error processing reminders: %s\n" (Printexc.to_string e);
|
||||||
|
exit 1
|
||||||
|
|
||||||
let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)
|
let () = if !Sys.interactive then () else exit (CommandLine.main ical2rem)
|
||||||
|
|||||||
@@ -1,6 +1,17 @@
|
|||||||
open Remind_sync
|
open Remind_sync
|
||||||
open Utils
|
open Utils
|
||||||
|
|
||||||
|
type week_first_day = [ `Sunday | `Monday ] [@@deriving show]
|
||||||
|
|
||||||
|
type simple_weekly = {
|
||||||
|
count_or_until : Icalendar.count_or_until option;
|
||||||
|
interval : int option; (** Optional interval for weekly recurrence, default is 1 *)
|
||||||
|
byday : Icalendar.weekday list;
|
||||||
|
week_start : week_first_day option; (** First day of the week for weekly recurrence *)
|
||||||
|
}
|
||||||
|
[@@deriving show]
|
||||||
|
(** A simple weekly REM command *)
|
||||||
|
|
||||||
type rem = {
|
type rem = {
|
||||||
original_uuid : string; (** Original UID from the iCalendar event *)
|
original_uuid : string; (** Original UID from the iCalendar event *)
|
||||||
summary : string; (** Summary or title of the reminder *)
|
summary : string; (** Summary or title of the reminder *)
|
||||||
@@ -8,10 +19,12 @@ type rem = {
|
|||||||
end_date : Timedesc.Date.t option; (** Optional end date for a date range *)
|
end_date : Timedesc.Date.t option; (** Optional end date for a date range *)
|
||||||
time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *)
|
time : Timedesc.Time.t option; (** Optional time specification (hour, minute) *)
|
||||||
duration : Timedesc.Span.t option; (** Optional duration for timed events *)
|
duration : Timedesc.Span.t option; (** Optional duration for timed events *)
|
||||||
simple_yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *)
|
yearly : (int * int) option; (** Optional simple yearly recurrence (month, day) *)
|
||||||
|
weekly : simple_weekly option; (** Optional simple weekly recurrence *)
|
||||||
recurring : Icalendar.event list;
|
recurring : Icalendar.event list;
|
||||||
(** List of events that are part of the same recurring series: these are only the overrides, not the master event
|
(** List of events that are part of the same recurring series: these are only the overrides, not the master event
|
||||||
*)
|
*)
|
||||||
|
exdate : Icalendar.date_or_datetime list; (** List of excluded dates for recurring events *)
|
||||||
}
|
}
|
||||||
[@@deriving show]
|
[@@deriving show]
|
||||||
(** A complete REM command *)
|
(** A complete REM command *)
|
||||||
@@ -24,17 +37,80 @@ let empty =
|
|||||||
end_date = None;
|
end_date = None;
|
||||||
time = None;
|
time = None;
|
||||||
duration = None;
|
duration = None;
|
||||||
simple_yearly = None;
|
yearly = None;
|
||||||
|
weekly = None;
|
||||||
recurring = [];
|
recurring = [];
|
||||||
|
exdate = [];
|
||||||
}
|
}
|
||||||
|
|
||||||
let render_simple_yearly month day summary =
|
let render_yearly month day summary =
|
||||||
let month_str = month_of_int month |> string_of_month in
|
let month_str = month_of_int month |> string_of_month in
|
||||||
spf "REM %s %d MSG %s" month_str day summary
|
spf "REM %s %d MSG %s\n" month_str day summary
|
||||||
|
|
||||||
|
let render_weekly rem weekly =
|
||||||
|
let b = Buffer.create 256 in
|
||||||
|
List.iter
|
||||||
|
begin fun weekday ->
|
||||||
|
Buffer.add_string b "REM ";
|
||||||
|
Buffer.add_string b (spf "INFO \"UID: %s\" " rem.original_uuid);
|
||||||
|
Buffer.add_string b (spf "%s " (string_of_weekday weekday));
|
||||||
|
Buffer.add_string b (Timedesc.Date.to_rfc3339 rem.date);
|
||||||
|
Buffer.add_string b " ";
|
||||||
|
(match weekly.interval with
|
||||||
|
| Some interval -> Buffer.add_string b (spf "*%d " (interval * 7))
|
||||||
|
| None -> Buffer.add_string b "*7 ");
|
||||||
|
|
||||||
|
(match weekly.count_or_until with
|
||||||
|
| Some (`Count count) -> begin
|
||||||
|
(* We must compute the until date based on the count and the interval *)
|
||||||
|
let wd = Timedesc.Date.weekday rem.date in
|
||||||
|
let wd_int = Timedesc.Utils.tm_int_of_weekday wd in
|
||||||
|
let day_to_subtract =
|
||||||
|
match weekly.week_start with
|
||||||
|
| Some `Sunday -> wd_int
|
||||||
|
| Some `Monday -> wd_int - 1
|
||||||
|
| None -> wd_int (* Default to Sunday if not specified *)
|
||||||
|
in
|
||||||
|
let interval = Option.value ~default:1 weekly.interval in
|
||||||
|
let until_date = Timedesc.Date.add ~days:((count * 7 * interval) - day_to_subtract) rem.date in
|
||||||
|
Buffer.add_string b "UNTIL ";
|
||||||
|
Buffer.add_string b (Timedesc.Date.to_rfc3339 until_date);
|
||||||
|
Buffer.add_string b " "
|
||||||
|
end
|
||||||
|
| Some (`Until until_date) -> begin
|
||||||
|
Buffer.add_string b "UNTIL ";
|
||||||
|
let ts = timedesc_of_utc_or_timestamp_local until_date in
|
||||||
|
Buffer.add_string b (Timedesc.Date.to_rfc3339 (Timedesc.date ts));
|
||||||
|
Buffer.add_string b " "
|
||||||
|
end
|
||||||
|
| None -> ());
|
||||||
|
|
||||||
|
(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 -> ());
|
||||||
|
|
||||||
|
Buffer.add_string b " MSG ";
|
||||||
|
Buffer.add_string b rem.summary;
|
||||||
|
Buffer.add_string b "\n"
|
||||||
|
end
|
||||||
|
weekly.byday;
|
||||||
|
Buffer.contents b
|
||||||
|
|
||||||
let string_of_rem rem =
|
let string_of_rem rem =
|
||||||
match rem.simple_yearly with
|
match rem.weekly with
|
||||||
| Some (month, day) -> render_simple_yearly month day rem.summary
|
| Some weekly -> render_weekly rem weekly
|
||||||
|
| None ->
|
||||||
|
begin match rem.yearly with
|
||||||
|
| Some (month, day) -> render_yearly month day rem.summary
|
||||||
| None -> begin
|
| None -> begin
|
||||||
let b = Buffer.create 256 in
|
let b = Buffer.create 256 in
|
||||||
Buffer.add_string b "REM ";
|
Buffer.add_string b "REM ";
|
||||||
@@ -58,5 +134,7 @@ let string_of_rem rem =
|
|||||||
| None -> ());
|
| None -> ());
|
||||||
Buffer.add_string b " MSG ";
|
Buffer.add_string b " MSG ";
|
||||||
Buffer.add_string b rem.summary;
|
Buffer.add_string b rem.summary;
|
||||||
|
Buffer.add_string b "\n";
|
||||||
Buffer.contents b
|
Buffer.contents b
|
||||||
end
|
end
|
||||||
|
end
|
||||||
|
|||||||
79
bin/utils.ml
79
bin/utils.ml
@@ -3,6 +3,15 @@ open Icalendar
|
|||||||
|
|
||||||
type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
|
type months = Jan | Feb | Mar | Apr | May | Jun | Jul | Aug | Sep | Oct | Nov | Dec
|
||||||
|
|
||||||
|
let string_of_weekday = function
|
||||||
|
| `Monday -> "Mon"
|
||||||
|
| `Tuesday -> "Tue"
|
||||||
|
| `Wednesday -> "Wed"
|
||||||
|
| `Thursday -> "Thu"
|
||||||
|
| `Friday -> "Fri"
|
||||||
|
| `Saturday -> "Sat"
|
||||||
|
| `Sunday -> "Sun"
|
||||||
|
|
||||||
let month_of_int = function
|
let month_of_int = function
|
||||||
| 1 -> Jan
|
| 1 -> Jan
|
||||||
| 2 -> Feb
|
| 2 -> Feb
|
||||||
@@ -80,28 +89,15 @@ let timedesc_of_timestamp (ts : timestamp) : Timedesc.t =
|
|||||||
let hour, minute, second = (time.Timedesc.Time.hour, time.Timedesc.Time.minute, time.Timedesc.Time.second) 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 ()
|
Timedesc.make_exn ~year ~month ~day ~hour ~minute ~second ~tz ()
|
||||||
|
|
||||||
let timedesc_of_date_or_datetime (t : date_or_datetime) : Timedesc.t =
|
let timedesc_of_utc_or_timestamp_local (ts : utc_or_timestamp_local) : Timedesc.t =
|
||||||
match t with
|
let local_tz = Timedesc.Time_zone.local_exn () in
|
||||||
| `Datetime (`Local _ptime_ts) ->
|
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… *)
|
(* this case is not present in my current dataset… *)
|
||||||
failwith "Unhandled case: `Local datetime"
|
| `Utc t -> t |> Timedesc.Utils.timestamp_of_ptime |> Timedesc.of_timestamp_exn ~tz_of_date_time:local_tz
|
||||||
| `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 get_exdates ev =
|
||||||
|
let uid = get_uid ev in
|
||||||
let event_props = ev.props in
|
let event_props = ev.props in
|
||||||
let dates_or_datetimes =
|
let dates_or_datetimes =
|
||||||
List.filter_map
|
List.filter_map
|
||||||
@@ -111,36 +107,47 @@ let get_exdates ev =
|
|||||||
| _ -> None)
|
| _ -> None)
|
||||||
event_props
|
event_props
|
||||||
in
|
in
|
||||||
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
|
|
||||||
let added =
|
let datetimes, dates =
|
||||||
|
ListLabels.fold_left ~init:([], []) dates_or_datetimes ~f:(fun (acc_datetimes, acc_dates) dates ->
|
||||||
match dates with
|
match dates with
|
||||||
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
|
| `Dates date_list -> (acc_datetimes, acc_dates @ date_list)
|
||||||
| `Dates date_list -> List.map (fun date -> `Date date) date_list
|
| `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates))
|
||||||
in
|
in
|
||||||
added @ acc)
|
|
||||||
|> List.map timedesc_of_date_or_datetime
|
if List.length dates > 0 then Printf.eprintf "Found EXDATE with dates: %d entries; UID: %s\n" (List.length dates) uid;
|
||||||
|
if List.length datetimes > 0 then
|
||||||
|
Printf.eprintf "Found EXDATE with datetimes: %d entries; UID: %s\n" (List.length datetimes) uid;
|
||||||
|
|
||||||
|
List.map (fun d -> `Date d) dates @ List.map (fun dt -> `Datetime dt) datetimes
|
||||||
|
|
||||||
let get_rdates ev =
|
let get_rdates ev =
|
||||||
|
let uid = get_uid ev in
|
||||||
let event_props = ev.props in
|
let event_props = ev.props in
|
||||||
let dates_or_datetimes =
|
let dates_or_datetimes_or_periods =
|
||||||
List.filter_map
|
List.filter_map
|
||||||
(fun prop ->
|
(fun prop ->
|
||||||
match prop with
|
match prop with
|
||||||
| `Rdate (_, dates) -> Some dates
|
| `Rdate (_, x) -> Some x
|
||||||
| _ -> None)
|
| _ -> None)
|
||||||
event_props
|
event_props
|
||||||
in
|
in
|
||||||
ListLabels.fold_left ~init:[] dates_or_datetimes ~f:(fun acc dates ->
|
|
||||||
let added =
|
let datetimes, dates, periods =
|
||||||
|
ListLabels.fold_left ~init:([], [], []) dates_or_datetimes_or_periods
|
||||||
|
~f:(fun (acc_datetimes, acc_dates, acc_periods) dates ->
|
||||||
match dates with
|
match dates with
|
||||||
| `Datetimes ts_list -> List.map (fun ts -> `Datetime ts) ts_list
|
| `Dates date_list -> (acc_datetimes, acc_dates @ date_list, acc_periods)
|
||||||
| `Dates date_list -> List.map (fun date -> `Date date) date_list
|
| `Datetimes ts_list -> (acc_datetimes @ ts_list, acc_dates, acc_periods)
|
||||||
| `Periods _ ->
|
| `Periods period_list -> (acc_datetimes, acc_dates, acc_periods @ period_list))
|
||||||
(* Ignored for now, does not appear in my current dataset *)
|
|
||||||
failwith "Unhandled case: `Periods in RDATE"
|
|
||||||
in
|
in
|
||||||
added @ acc)
|
|
||||||
|> List.map timedesc_of_date_or_datetime
|
if List.length dates > 0 then Printf.eprintf "Found RDATE with dates: %d entries; UID: %s\n" (List.length dates) uid;
|
||||||
|
if List.length datetimes > 0 then
|
||||||
|
Printf.eprintf "Found RDATE with datetimes: %d entries; UID: %s\n" (List.length datetimes) uid;
|
||||||
|
if List.length periods > 0 then
|
||||||
|
Printf.eprintf "Found RDATE with periods: %d entries; UID: %s\n" (List.length periods) uid;
|
||||||
|
[]
|
||||||
|
|
||||||
let get_recurrence_id ev =
|
let get_recurrence_id ev =
|
||||||
List.find_map
|
List.find_map
|
||||||
|
|||||||
Reference in New Issue
Block a user