Command-line and Emacs Calendar Client
ryan.freumh.org
1open Icalendar
2
3type event_id = string
4
5type t = {
6 collection : Collection.t;
7 file_name : string;
8 event : event;
9 calendar : calendar;
10}
11
12type date_error = [ `Msg of string ]
13
14let generate_uuid () =
15 let uuid = Uuidm.v4_gen (Random.State.make_self_init ()) () in
16 Uuidm.to_string uuid
17
18let default_prodid = `Prodid (Params.empty, "-//Freumh//Caledonia//EN")
19
20let create ~summary ~start ?end_ ?location ?description ?recurrence collection =
21 let uuid = generate_uuid () in
22 let uid = (Params.empty, uuid) in
23 let file_name = uuid ^ ".ics" in
24 let dtstart = (Params.empty, start) in
25 let dtend_or_duration = end_ in
26 let rrule = Option.map (fun r -> (Params.empty, r)) recurrence in
27 let now = Ptime_clock.now () in
28 let props = [ `Summary (Params.empty, summary) ] in
29 let props =
30 match location with
31 | Some loc -> `Location (Params.empty, loc) :: props
32 | None -> props
33 in
34 let props =
35 match description with
36 | Some desc -> `Description (Params.empty, desc) :: props
37 | None -> props
38 in
39 let event =
40 {
41 dtstamp = (Params.empty, now);
42 uid;
43 dtstart;
44 dtend_or_duration;
45 rrule;
46 props;
47 alarms = [];
48 }
49 in
50 let calendar =
51 let props = [ default_prodid ] in
52 let components = [ `Event event ] in
53 (props, components)
54 in
55 { collection; file_name; event; calendar }
56
57let edit ?summary ?start ?end_ ?location ?description ?recurrence t =
58 let now = Ptime_clock.now () in
59 let uid = t.event.uid in
60 let dtstart =
61 match start with None -> t.event.dtstart | Some s -> (Params.empty, s)
62 in
63 let dtend_or_duration =
64 match end_ with None -> t.event.dtend_or_duration | Some _ -> end_
65 in
66 let rrule =
67 match recurrence with
68 | None -> t.event.rrule
69 | Some r -> Some (Params.empty, r)
70 in
71 let props =
72 List.filter
73 (function
74 | `Summary _ -> ( match summary with None -> true | Some _ -> false)
75 | `Location _ -> ( match location with None -> true | Some _ -> false)
76 | `Description _ -> (
77 match description with None -> true | Some _ -> false)
78 | _ -> true)
79 t.event.props
80 in
81 let props =
82 match summary with
83 | Some summary -> `Summary (Params.empty, summary) :: props
84 | None -> props
85 in
86 let props =
87 match location with
88 | Some loc -> `Location (Params.empty, loc) :: props
89 | None -> props
90 in
91 let props =
92 match description with
93 | Some desc -> `Description (Params.empty, desc) :: props
94 | None -> props
95 in
96 let alarms = t.event.alarms in
97 let event =
98 {
99 dtstamp = (Params.empty, now);
100 uid;
101 dtstart;
102 dtend_or_duration;
103 rrule;
104 props;
105 alarms;
106 }
107 in
108 let collection = t.collection in
109 let file_name = t.file_name in
110 let calendar = t.calendar in
111 { collection; file_name; event; calendar }
112
113let events_of_icalendar collection ~file_name calendar =
114 List.filter_map
115 (function
116 | `Event event -> Some { collection; file_name; event; calendar }
117 | _ -> None)
118 (snd calendar)
119
120let to_ical_event t = t.event
121let to_ical_calendar t = t.calendar
122let get_id t = snd t.event.uid
123
124let get_summary t =
125 match
126 List.filter_map
127 (function `Summary (_, s) when s <> "" -> Some s | _ -> None)
128 t.event.props
129 with
130 | s :: _ -> Some s
131 | _ -> None
132
133let get_ical_start event =
134 Date.ptime_of_ical (snd event.dtstart)
135
136let get_start t = get_ical_start t.event
137
138let get_ical_end event =
139 match event.dtend_or_duration with
140 | Some (`Dtend (_, d)) -> Some (Date.ptime_of_ical d)
141 | Some (`Duration (_, span)) -> (
142 let start = get_ical_start event in
143 match Ptime.add_span start span with
144 | Some t -> Some t
145 | None ->
146 failwith
147 (Printf.sprintf "Invalid duration calculation: %s + %s"
148 (Ptime.to_rfc3339 start)
149 (Printf.sprintf "%.2fs" (Ptime.Span.to_float_s span))))
150 | None -> None
151
152let get_end t = get_ical_end t.event
153
154let get_start_timezone t =
155 match t.event.dtstart with
156 | _, `Datetime (`With_tzid (_, (_, tzid))) -> Some tzid
157 | _ -> None
158
159let get_end_timezone t =
160 match t.event.dtend_or_duration with
161 | Some (`Dtend (_, `Datetime (`With_tzid (_, (_, tzid))))) -> Some tzid
162 | _ -> None
163
164let get_duration t =
165 match t.event.dtend_or_duration with
166 | Some (`Duration (_, span)) -> Some span
167 | Some (`Dtend (_, e)) ->
168 let span = Ptime.diff (Date.ptime_of_ical e) (get_start t) in
169 Some span
170 | None -> None
171
172let is_date t =
173 match (t.event.dtstart, t.event.dtend_or_duration) with
174 | (_, `Date _), _ -> true
175 | _, Some (`Dtend (_, `Date _)) -> true
176 | _ -> false
177
178let get_location t =
179 match
180 List.filter_map
181 (function `Location (_, s) when s <> "" -> Some s | _ -> None)
182 t.event.props
183 with
184 | s :: _ -> Some s
185 | _ -> None
186
187let get_description t =
188 match
189 List.filter_map
190 (function `Description (_, s) when s <> "" -> Some s | _ -> None)
191 t.event.props
192 with
193 | s :: _ -> Some s
194 | _ -> None
195
196let get_recurrence t = Option.map (fun r -> snd r) t.event.rrule
197let get_collection t = t.collection
198
199let get_file_path ~fs ~calendar_dir_path t =
200 Eio.Path.(
201 fs / calendar_dir_path
202 / (match t.collection with Col s -> s)
203 / t.file_name)
204
205let get_recurrence_ids t =
206 let _, recurrence_ids =
207 match
208 List.partition (function `Event _ -> true | _ -> false) (snd t.calendar)
209 with
210 | `Event hd :: tl, _ ->
211 (hd, List.map (function `Event e -> e | _ -> assert false) tl)
212 | _ -> assert false
213 in
214 recurrence_ids
215
216type comparator = t -> t -> int
217
218let by_start e1 e2 =
219 let t1 = get_start e1 in
220 let t2 = get_start e2 in
221 Ptime.compare t1 t2
222
223let by_end e1 e2 =
224 match (get_end e1, get_end e2) with
225 | Some t1, Some t2 -> Ptime.compare t1 t2
226 | Some _, None -> 1
227 | None, Some _ -> -1
228 | None, None -> 0
229
230let by_summary e1 e2 =
231 match (get_summary e1, get_summary e2) with
232 | Some s1, Some s2 -> String.compare s1 s2
233 | Some _, None -> 1
234 | None, Some _ -> -1
235 | None, None -> 0
236
237let by_location e1 e2 =
238 match (get_location e1, get_location e2) with
239 | Some l1, Some l2 -> String.compare l1 l2
240 | Some _, None -> 1
241 | None, Some _ -> -1
242 | None, None -> 0
243
244let by_collection e1 e2 =
245 match (get_collection e1, get_collection e2) with
246 | Collection.Col c1, Collection.Col c2 -> String.compare c1 c2
247
248let descending comp e1 e2 = -1 * comp e1 e2
249
250let chain comp1 comp2 e1 e2 =
251 let result = comp1 e1 e2 in
252 if result <> 0 then result else comp2 e1 e2
253
254let clone_with_event t event =
255 let collection = t.collection in
256 let file_name = t.file_name in
257 let calendar = t.calendar in
258 { collection; file_name; event; calendar }
259
260let expand_recurrences ~from ~to_ event =
261 let rule = get_recurrence event in
262 match rule with
263 (* If there's no recurrence we just return the original event. *)
264 | None ->
265 (* Include the original event instance only if it falls within the query range. *)
266 let start = get_start event in
267 let end_ = match get_end event with None -> start | Some e -> e in
268 if
269 Ptime.compare start to_ < 0
270 &&
271 (* end_ > f, meaning we don't include events that end at the exact start of our range.
272 This is handy to exclude date events that end at 00:00 the next day. *)
273 match from with Some f -> Ptime.compare end_ f > 0 | None -> true
274 then [ event ]
275 else []
276 | Some _ ->
277 let rec collect generator acc =
278 match generator () with
279 | None -> List.rev acc
280 | Some recur ->
281 let start = get_ical_start recur in
282 let end_ = match get_ical_end recur with None -> start | Some e -> e in
283 (* if start >= to then we're outside our (exclusive) date range and we terminate *)
284 if Ptime.compare start to_ >= 0 then List.rev acc
285 (* if end > from then, *)
286 else if
287 match from with
288 | Some f -> Ptime.compare end_ f > 0
289 | None -> true
290 (* we include the event *)
291 then collect generator (clone_with_event event recur :: acc)
292 (* otherwise we iterate till the event is in range *)
293 else collect generator acc
294 in
295 let generator =
296 let ical_event = to_ical_event event in
297 let recurrence_ids = get_recurrence_ids event in
298 recur_events ~recurrence_ids ical_event
299 in
300 collect generator []