Command-line and Emacs Calendar Client
ryan.freumh.org
1open Icalendar
2
3type instance = { event : Event.t; start : Ptime.t; end_ : Ptime.t option }
4
5module Instance = struct
6 type t = instance
7 type comparator = t -> t -> int
8
9 let by_start i1 i2 = Ptime.compare i1.start i2.start
10
11 let by_end i1 i2 =
12 match (i1.end_, i2.end_) with
13 | Some t1, Some t2 -> Ptime.compare t1 t2
14 | Some _, None -> 1
15 | None, Some _ -> -1
16 | None, None -> 0
17
18 let by_event event_comp i1 i2 = event_comp i1.event i2.event
19 let descending comp i1 i2 = -1 * comp i1 i2
20
21 let chain comp1 comp2 i1 i2 =
22 let result = comp1 i1 i2 in
23 if result <> 0 then result else comp2 i1 i2
24end
25
26let clone_with_time original start =
27 let duration = Event.get_duration original in
28 let end_ =
29 match duration with Some span -> Ptime.add_span start span | None -> None
30 in
31 { event = original; start; end_ }
32
33let expand_event event ~from ~to_ =
34 let rule = Event.get_recurrence event in
35 match rule with
36 (* If there's no recurrence we just return the original event. *)
37 | None ->
38 (* Include the original event instance only if it falls within the query range. *)
39 let start = Event.get_start event in
40 let end_ = match Event.get_end event with None -> start | Some e -> e in
41 if
42 Ptime.compare start to_ < 0
43 &&
44 (* end_ > f, meaning we don't include events that end at the exact start of our range.
45 This is handy to exclude date events that end at 00:00 the next day. *)
46 match from with Some f -> Ptime.compare end_ f > 0 | None -> true
47 then [ clone_with_time event start ]
48 else []
49 (* We return all instances within the range, regardless of whether the original
50 event instance was included. This ensures recurring events that start before
51 the query range but have instances within it are properly included. *)
52 | Some rule ->
53 let rec collect generator acc =
54 match generator () with
55 | None -> List.rev acc
56 | Some date ->
57 if Ptime.compare date to_ > 0 then List.rev acc
58 else if
59 match from with
60 | Some f -> Ptime.compare date f < 0
61 | None -> false
62 then collect generator acc
63 else collect generator (clone_with_time event date :: acc)
64 in
65 let start_date = Event.get_start event in
66 let generator = recur_dates start_date rule in
67 collect generator []
68
69let combine_results (results : ('a, 'b) result list) : ('a list, 'b) result =
70 let rec aux acc = function
71 | [] -> Ok (List.rev acc)
72 | Ok v :: rest -> aux (v :: acc) rest
73 | Error e :: _ -> Error e
74 in
75 aux [] results
76
77let parse_recurrence recur =
78 let ( let* ) = Result.bind in
79 let parts = String.split_on_char ';' recur in
80 let freq = ref None in
81 let count = ref None in
82 let until = ref None in
83 let interval = ref None in
84 let by_parts = ref [] in
85 let results =
86 List.map
87 (fun part ->
88 let kv = String.split_on_char '=' part in
89 match kv with
90 | [ "FREQ"; value ] -> (
91 match String.uppercase_ascii value with
92 | "DAILY" ->
93 freq := Some `Daily;
94 Ok ()
95 | "WEEKLY" ->
96 freq := Some `Weekly;
97 Ok ()
98 | "MONTHLY" ->
99 freq := Some `Monthly;
100 Ok ()
101 | "YEARLY" ->
102 freq := Some `Yearly;
103 Ok ()
104 | _ -> Error (`Msg ("Unsupported frequency: " ^ value)))
105 | [ "COUNT"; value ] ->
106 if !until <> None then
107 Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")
108 else (
109 count := Some (`Count (int_of_string value));
110 Ok ())
111 | [ "UNTIL"; value ] -> (
112 if !count <> None then
113 Error (`Msg "Cannot use both COUNT and UNTIL in the same rule")
114 else
115 let* v =
116 match parse_datetime value with
117 | Ok v -> Ok v
118 | Error e -> Error (`Msg e)
119 in
120 match v with
121 | `With_tzid _ -> Error (`Msg "Until can't be in a timezone")
122 | `Utc u ->
123 until := Some (`Until (`Utc u));
124 Ok ()
125 | `Local l ->
126 until := Some (`Until (`Local l));
127 Ok ())
128 | [ "INTERVAL"; value ] ->
129 interval := Some (int_of_string value);
130 Ok ()
131 | [ "BYDAY"; value ] ->
132 (* Parse day specifications like MO,WE,FR or 1MO,-1FR *)
133 let days = String.split_on_char ',' value in
134 let parse_day day =
135 (* Extract ordinal if present (like 1MO or -1FR) *)
136 let ordinal, day_code =
137 if
138 String.length day >= 3
139 && (String.get day 0 = '+'
140 || String.get day 0 = '-'
141 || (String.get day 0 >= '0' && String.get day 0 <= '9'))
142 then (
143 let idx = ref 0 in
144 while
145 !idx < String.length day
146 && (String.get day !idx = '+'
147 || String.get day !idx = '-'
148 || String.get day !idx >= '0'
149 && String.get day !idx <= '9')
150 do
151 incr idx
152 done;
153 let ord_str = String.sub day 0 !idx in
154 let day_str =
155 String.sub day !idx (String.length day - !idx)
156 in
157 (int_of_string ord_str, day_str))
158 else (0, day)
159 in
160 let* weekday =
161 match day_code with
162 | "MO" -> Ok `Monday
163 | "TU" -> Ok `Tuesday
164 | "WE" -> Ok `Wednesday
165 | "TH" -> Ok `Thursday
166 | "FR" -> Ok `Friday
167 | "SA" -> Ok `Saturday
168 | "SU" -> Ok `Sunday
169 | _ -> Error (`Msg ("Invalid weekday: " ^ day_code))
170 in
171 Ok (ordinal, weekday)
172 in
173 let* day_specs = combine_results (List.map parse_day days) in
174 by_parts := `Byday day_specs :: !by_parts;
175 Ok ()
176 | [ "BYMONTHDAY"; value ] ->
177 let days = String.split_on_char ',' value in
178 let month_days = List.map int_of_string days in
179 by_parts := `Bymonthday month_days :: !by_parts;
180 Ok ()
181 | [ "BYMONTH"; value ] ->
182 let months = String.split_on_char ',' value in
183 let month_nums = List.map int_of_string months in
184 by_parts := `Bymonth month_nums :: !by_parts;
185 Ok ()
186 | _ -> Ok ())
187 parts
188 in
189 let* _ = combine_results results in
190 match !freq with
191 | Some f ->
192 let limit =
193 match (!count, !until) with
194 | Some c, None -> Some c
195 | None, Some u -> Some u
196 | _ -> None
197 in
198 let recurrence = (f, limit, !interval, !by_parts) in
199 Ok recurrence
200 | None -> Error (`Msg "FREQ is required in recurrence rule")