Paolo Donadeo
c78d94e004
- 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
317 lines
10 KiB
OCaml
317 lines
10 KiB
OCaml
module Params = struct
|
|
include Icalendar.Params
|
|
|
|
let pp ppf _m = Format.pp_print_string ppf "<params>"
|
|
end
|
|
|
|
type params = Params.t [@@deriving show]
|
|
|
|
module Ptime = struct
|
|
include Ptime_augmented
|
|
end
|
|
|
|
(* TODO: tag these with `Utc | `Local *)
|
|
type timestamp_utc = Ptime.t [@@deriving show]
|
|
type timestamp_local = Ptime.t [@@deriving show]
|
|
type utc_or_timestamp_local = [ `Utc of timestamp_utc | `Local of timestamp_local ] [@@deriving show]
|
|
type timestamp = [ utc_or_timestamp_local | `With_tzid of timestamp_local * (bool * string) ] [@@deriving show]
|
|
type date_or_datetime = [ `Datetime of timestamp | `Date of Ptime.date ] [@@deriving show]
|
|
type weekday = [ `Friday | `Monday | `Saturday | `Sunday | `Thursday | `Tuesday | `Wednesday ] [@@deriving show]
|
|
|
|
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]
|
|
|
|
type valuetype =
|
|
[ `Binary
|
|
| `Boolean
|
|
| `Caladdress
|
|
| `Date
|
|
| `Datetime
|
|
| `Duration
|
|
| `Float
|
|
| `Integer
|
|
| `Period
|
|
| `Recur
|
|
| `Text
|
|
| `Time
|
|
| `Uri
|
|
| `Utcoffset
|
|
| `Xname of string * string
|
|
| `Ianatoken of string ]
|
|
|
|
type cutype = [ `Group | `Individual | `Resource | `Room | `Unknown | `Ianatoken of string | `Xname of string * string ]
|
|
[@@deriving show]
|
|
|
|
type partstat =
|
|
[ `Accepted
|
|
| `Completed
|
|
| `Declined
|
|
| `Delegated
|
|
| `In_process
|
|
| `Needs_action
|
|
| `Tentative
|
|
| `Ianatoken of string
|
|
| `Xname of string * string ]
|
|
[@@deriving show]
|
|
|
|
type role =
|
|
[ `Chair | `Nonparticipant | `Optparticipant | `Reqparticipant | `Ianatoken of string | `Xname of string * string ]
|
|
[@@deriving show]
|
|
|
|
type relationship = [ `Parent | `Child | `Sibling | `Ianatoken of string | `Xname of string * string ] [@@deriving show]
|
|
|
|
type fbtype = [ `Free | `Busy | `Busy_Unavailable | `Busy_Tentative | `Ianatoken of string | `Xname of string * string ]
|
|
[@@deriving show]
|
|
|
|
type param_value = [ `Quoted of string | `String of string ] [@@deriving show]
|
|
|
|
type _ icalparameter =
|
|
| Altrep : Uri.t icalparameter
|
|
| Cn : param_value icalparameter
|
|
| Cutype : cutype icalparameter
|
|
| Delegated_from : Uri.t list icalparameter
|
|
| Delegated_to : Uri.t list icalparameter
|
|
| Dir : Uri.t icalparameter
|
|
| Encoding : [ `Base64 ] icalparameter
|
|
| Media_type : (string * string) icalparameter
|
|
| Fbtype : fbtype icalparameter
|
|
| Language : string icalparameter
|
|
| Member : Uri.t list icalparameter
|
|
| Partstat : partstat icalparameter
|
|
| Range : [ `Thisandfuture ] icalparameter
|
|
| Related : [ `Start | `End ] icalparameter
|
|
| Reltype : relationship icalparameter
|
|
| Role : role icalparameter
|
|
| Rsvp : bool icalparameter
|
|
| Sentby : Uri.t icalparameter
|
|
| Tzid : (bool * string) icalparameter
|
|
| Valuetype : valuetype icalparameter
|
|
| Iana_param : string -> param_value list icalparameter
|
|
| Xparam : (string * string) -> param_value list icalparameter
|
|
[@@deriving show]
|
|
|
|
type other_prop = [ `Iana_prop of string * params * string | `Xprop of (string * string) * params * string ]
|
|
[@@deriving show]
|
|
|
|
type cal_prop =
|
|
[ `Prodid of params * string
|
|
| `Version of params * string
|
|
| `Calscale of params * string
|
|
| `Method of params * string
|
|
| other_prop ]
|
|
[@@deriving show]
|
|
|
|
type class_ = [ `Public | `Private | `Confidential | `Ianatoken of string | `Xname of string * string ]
|
|
[@@deriving show]
|
|
|
|
type status =
|
|
[ `Draft
|
|
| `Final
|
|
| `Cancelled
|
|
| `Needs_action
|
|
| `Completed
|
|
| `In_process
|
|
| (* `Cancelled *)
|
|
`Tentative
|
|
| `Confirmed (* | `Cancelled *) ]
|
|
[@@deriving show]
|
|
|
|
type period = timestamp * Ptime.Span.t * bool [@@deriving show]
|
|
type period_utc = timestamp_utc * Ptime.Span.t * bool [@@deriving show]
|
|
type dates_or_datetimes = [ `Datetimes of timestamp list | `Dates of Ptime.date list ] [@@deriving show]
|
|
type dates_or_datetimes_or_periods = [ dates_or_datetimes | `Periods of period list ] [@@deriving show]
|
|
|
|
type general_prop =
|
|
[ `Dtstamp of params * timestamp_utc
|
|
| `Uid of params * string
|
|
| `Dtstart of params * date_or_datetime
|
|
| `Class of params * class_
|
|
| `Created of params * timestamp_utc
|
|
| `Description of params * string
|
|
| `Geo of params * (float * float)
|
|
| `Lastmod of params * timestamp_utc
|
|
| `Location of params * string
|
|
| `Organizer of params * Uri.t
|
|
| `Priority of params * int
|
|
| `Seq of params * int
|
|
| `Status of params * status
|
|
| `Summary of params * string
|
|
| `Url of params * Uri.t
|
|
| `Recur_id of params * date_or_datetime
|
|
| (* TODO: Furthermore, this property MUST be specified
|
|
as a date with local time if and only if the "DTSTART" property
|
|
contained within the recurring component is specified as a date
|
|
with local time. *)
|
|
`Rrule of params * recurrence
|
|
| `Duration of params * Ptime.Span.t
|
|
| `Attach of params * [ `Uri of Uri.t | `Binary of string ]
|
|
| `Attendee of params * Uri.t
|
|
| `Categories of params * string list
|
|
| `Comment of params * string
|
|
| `Contact of params * string
|
|
| `Exdate of params * dates_or_datetimes
|
|
| `Rstatus of params * ((int * int * int option) * string * string option)
|
|
| `Related of params * string
|
|
| `Resource of params * string list
|
|
| `Rdate of params * dates_or_datetimes_or_periods ]
|
|
[@@deriving show]
|
|
|
|
type event_prop =
|
|
[ general_prop
|
|
| `Transparency of params * [ `Transparent | `Opaque ]
|
|
| `Dtend of params * date_or_datetime
|
|
| (* TODO: valuetype same as DTSTART *)
|
|
other_prop ]
|
|
[@@deriving show]
|
|
|
|
type 'a alarm_struct = {
|
|
trigger : params * [ `Duration of Ptime.Span.t | `Datetime of timestamp_utc ];
|
|
duration_repeat : ((params * Ptime.Span.t) * (params * int)) option;
|
|
summary : (params * string) option;
|
|
other : other_prop list;
|
|
special : 'a;
|
|
}
|
|
[@@deriving show]
|
|
|
|
type audio_struct = { attach : (params * [ `Uri of Uri.t | `Binary of string ]) option } [@@deriving show]
|
|
type display_struct = { description : (params * string) option } [@@deriving show]
|
|
|
|
type email_struct = {
|
|
description : params * string;
|
|
attendees : (params * Uri.t) list;
|
|
attach : (params * [ `Uri of Uri.t | `Binary of string ]) option;
|
|
}
|
|
[@@deriving show]
|
|
|
|
type alarm =
|
|
[ `Audio of audio_struct alarm_struct
|
|
| `Display of display_struct alarm_struct
|
|
| `Email of email_struct alarm_struct
|
|
| `None of unit alarm_struct ]
|
|
[@@deriving show]
|
|
|
|
type tz_prop =
|
|
[ `Dtstart_local of params * timestamp_local
|
|
| `Tzoffset_to of params * Ptime.Span.t
|
|
| `Tzoffset_from of params * Ptime.Span.t
|
|
| `Rrule of params * recurrence
|
|
| `Comment of params * string
|
|
| `Rdate of params * dates_or_datetimes_or_periods
|
|
| `Tzname of params * string
|
|
| other_prop ]
|
|
[@@deriving show]
|
|
|
|
type timezone_prop =
|
|
[ `Timezone_id of params * (bool * string)
|
|
| `Lastmod of params * timestamp_utc
|
|
| `Tzurl of params * Uri.t
|
|
| `Standard of tz_prop list
|
|
| `Daylight of tz_prop list
|
|
| other_prop ]
|
|
[@@deriving show]
|
|
|
|
type todo_prop =
|
|
[ general_prop
|
|
| `Completed of params * timestamp_utc
|
|
| `Percent of params * int
|
|
| `Due of params * date_or_datetime
|
|
| other_prop ]
|
|
[@@deriving show]
|
|
|
|
type journal_prop = [ general_prop | other_prop ] [@@deriving show]
|
|
|
|
type freebusy_prop =
|
|
[ `Dtstamp of params * timestamp_utc
|
|
| `Uid of params * string
|
|
| `Contact of params * string
|
|
| `Dtstart_utc of params * timestamp_utc
|
|
| `Dtend_utc of params * timestamp_utc
|
|
| `Organizer of params * Uri.t
|
|
| `Url of params * Uri.t
|
|
| `Attendee of params * Uri.t
|
|
| `Comment of params * string
|
|
| `Freebusy of params * period_utc list
|
|
| `Rstatus of params * ((int * int * int option) * string * string option)
|
|
| other_prop ]
|
|
[@@deriving show]
|
|
|
|
type event = {
|
|
dtstamp : params * timestamp_utc;
|
|
uid : params * string;
|
|
dtstart : params * date_or_datetime; (* NOTE: optional if METHOD present according to RFC 5545 *)
|
|
dtend_or_duration : [ `Duration of params * Ptime.Span.t | `Dtend of params * date_or_datetime ] option;
|
|
rrule : (params * recurrence) option; (* NOTE: RFC says SHOULD NOT occur more than once *)
|
|
props : event_prop list;
|
|
alarms : alarm list;
|
|
}
|
|
[@@deriving show]
|
|
|
|
type timezone = timezone_prop list [@@deriving show]
|
|
|
|
type component =
|
|
[ `Event of event
|
|
| `Todo of todo_prop list * alarm list
|
|
| `Journal of journal_prop list
|
|
| `Freebusy of freebusy_prop list
|
|
| `Timezone of timezone ]
|
|
[@@deriving show]
|
|
|
|
let conv_alarm_struct (f : 'a -> 'b) (s : 'a Icalendar.alarm_struct) : 'b alarm_struct =
|
|
{
|
|
trigger = s.trigger;
|
|
duration_repeat = s.duration_repeat;
|
|
summary = s.summary;
|
|
other = s.other;
|
|
special = f s.special;
|
|
}
|
|
|
|
let conv_audio_struct (s : Icalendar.audio_struct) : audio_struct = { attach = s.attach }
|
|
let conv_display_struct (s : Icalendar.display_struct) : display_struct = { description = s.description }
|
|
|
|
let conv_email_struct (s : Icalendar.email_struct) : email_struct =
|
|
{ description = s.description; attendees = s.attendees; attach = s.attach }
|
|
|
|
let conv_alarm (a : Icalendar.alarm) : alarm =
|
|
match a with
|
|
| `Audio s -> `Audio (conv_alarm_struct conv_audio_struct s)
|
|
| `Display s -> `Display (conv_alarm_struct conv_display_struct s)
|
|
| `Email s -> `Email (conv_alarm_struct conv_email_struct s)
|
|
| `None s -> `None (conv_alarm_struct Fun.id s)
|
|
|
|
let conv_event (e : Icalendar.event) : event =
|
|
{
|
|
dtstamp = e.dtstamp;
|
|
uid = e.uid;
|
|
dtstart = e.dtstart;
|
|
dtend_or_duration = e.dtend_or_duration;
|
|
rrule = e.rrule;
|
|
props = e.props;
|
|
alarms = List.map conv_alarm e.alarms;
|
|
}
|
|
|
|
let conv_component (c : Icalendar.component) : component =
|
|
match c with
|
|
| `Event e -> `Event (conv_event e)
|
|
| `Todo (props, alms) -> `Todo (props, List.map conv_alarm alms)
|
|
| `Journal props -> `Journal props
|
|
| `Freebusy props -> `Freebusy props
|
|
| `Timezone tz -> `Timezone tz
|
|
|
|
let parse s =
|
|
Result.map (fun (cal_props, components) -> (cal_props, List.map conv_component components)) (Icalendar.parse s)
|