Command-line and Emacs Calendar Client
ryan.freumh.org
1open Icalendar
2
3module CalendarMap = Map.Make (struct
4 type t = string
5
6 let compare a b = String.compare a b
7end)
8
9type t = { path : string; mutable calendar_names : Event.t list CalendarMap.t }
10
11let get_calendar_path ~fs calendar_dir calendar_name_name =
12 Eio.Path.(fs / calendar_dir.path / calendar_name_name)
13
14let ensure_dir path =
15 try
16 Eio.Path.mkdirs ~exists_ok:true ~perm:0o755 path;
17 Ok ()
18 with Eio.Exn.Io _ as exn ->
19 Error
20 (`Msg
21 (Fmt.str "Failed to create directory %s: %a" (snd path) Eio.Exn.pp exn))
22
23let create ~fs path =
24 match ensure_dir Eio.Path.(fs / path) with
25 | Ok () -> Ok { path; calendar_names = CalendarMap.empty }
26 | Error e -> Error e
27
28let list_calendar_names ~fs calendar_dir =
29 try
30 let dir = Eio.Path.(fs / calendar_dir.path) in
31 let calendar_names =
32 Eio.Path.read_dir dir
33 |> List.filter_map (fun file ->
34 if Eio.Path.is_directory Eio.Path.(dir / file) then Some file
35 else None)
36 |> List.sort (fun a b -> String.compare a b)
37 in
38 Ok calendar_names
39 with Eio.Exn.Io _ as exn ->
40 Error
41 (`Msg
42 (Fmt.str "Failed to list calendar directory %s: %a" calendar_dir.path
43 Eio.Exn.pp exn))
44
45let rec load_events_recursive calendar_name dir_path =
46 try
47 Eio.Path.read_dir dir_path
48 |> List.fold_left
49 (fun acc name ->
50 let path = Eio.Path.(dir_path / name) in
51 if Eio.Path.is_directory path then
52 acc @ load_events_recursive calendar_name path
53 else if Filename.check_suffix name ".ics" then (
54 try
55 let content = Eio.Path.load path in
56 match parse content with
57 | Ok calendar ->
58 acc
59 @ Event.events_of_icalendar ~file:path calendar_name calendar
60 | Error err ->
61 Printf.eprintf "Failed to parse %s: %s\n%!" (snd path) err;
62 acc
63 with Eio.Exn.Io _ as exn ->
64 Fmt.epr "Failed to read file %s: %a\n%!" (snd path) Eio.Exn.pp
65 exn;
66 acc)
67 else acc)
68 []
69 with Eio.Exn.Io _ as exn ->
70 Fmt.epr "Failed to read directory %s: %a\n%!" (snd dir_path) Eio.Exn.pp exn;
71 []
72
73let get_calendar_events ~fs calendar_dir calendar_name =
74 match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with
75 | Some events -> Ok events
76 | None -> (
77 let calendar_name_path =
78 get_calendar_path ~fs calendar_dir calendar_name
79 in
80 if not (Eio.Path.is_directory calendar_name_path) then Error `Not_found
81 else
82 try
83 let events = load_events_recursive calendar_name calendar_name_path in
84 calendar_dir.calendar_names <-
85 CalendarMap.add calendar_name events calendar_dir.calendar_names;
86 Ok events
87 with e ->
88 Error
89 (`Msg
90 (Printf.sprintf "Exception processing directory %s: %s"
91 (snd calendar_name_path) (Printexc.to_string e))))
92
93let ( let* ) = Result.bind
94
95let get_events ~fs calendar_dir =
96 match list_calendar_names ~fs calendar_dir with
97 | Error e -> Error e
98 | Ok ids -> (
99 try
100 let rec process_ids acc = function
101 | [] -> Ok (List.rev acc)
102 | id :: rest -> (
103 match get_calendar_events ~fs calendar_dir id with
104 | Ok cal -> process_ids (cal :: acc) rest
105 | Error `Not_found -> process_ids acc rest
106 | Error (`Msg e) -> Error (`Msg e))
107 in
108 let* calendar_names = process_ids [] ids in
109 Ok (List.flatten calendar_names)
110 with exn ->
111 Error
112 (`Msg
113 (Printf.sprintf "Error getting calendar_names: %s"
114 (Printexc.to_string exn))))
115
116let add_event ~fs calendar_dir event =
117 let calendar_name = Event.get_calendar_name event in
118 let file = Event.get_file event in
119 let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in
120 let* () = ensure_dir calendar_name_path in
121 let calendar = Event.to_ical_calendar event in
122 let content = Icalendar.to_ics ~cr:true calendar in
123 let* _ =
124 try
125 Eio.Path.save ~create:(`Or_truncate 0o644) file content;
126 Ok ()
127 with Eio.Exn.Io _ as exn ->
128 Error
129 (`Msg
130 (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))
131 in
132 calendar_dir.calendar_names <-
133 CalendarMap.add calendar_name
134 (event
135 ::
136 (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with
137 | Some lst -> lst
138 | None -> []))
139 calendar_dir.calendar_names;
140 Ok ()
141
142let edit_event ~fs calendar_dir event =
143 let calendar_name = Event.get_calendar_name event in
144 let event_id = Event.get_id event in
145 let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in
146 let* () = ensure_dir calendar_name_path in
147 let ical_event = Event.to_ical_event event in
148 let file = Event.get_file event in
149 let existing_props, existing_components = Event.to_ical_calendar event in
150 let calendar =
151 (* Replace the event with our updated version *)
152 let filtered_components =
153 List.filter
154 (function
155 | `Event e ->
156 (* Filter out the old event *)
157 let uid = e.Icalendar.uid in
158 snd uid <> event_id
159 | _ -> true)
160 existing_components
161 in
162 (existing_props, `Event ical_event :: filtered_components)
163 in
164 let content = Icalendar.to_ics ~cr:true calendar in
165 let* _ =
166 try
167 Eio.Path.save ~create:(`Or_truncate 0o644) file content;
168 Ok ()
169 with Eio.Exn.Io _ as exn ->
170 Error
171 (`Msg
172 (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))
173 in
174 calendar_dir.calendar_names <-
175 CalendarMap.add calendar_name
176 (event
177 ::
178 (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with
179 (* filter old version *)
180 | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst
181 | None -> []))
182 calendar_dir.calendar_names;
183 Ok ()
184
185let delete_event ~fs calendar_dir event =
186 let calendar_name = Event.get_calendar_name event in
187 let event_id = Event.get_id event in
188 let calendar_name_path = get_calendar_path ~fs calendar_dir calendar_name in
189 let* () = ensure_dir calendar_name_path in
190 let file = Event.get_file event in
191 let existing_props, existing_components = Event.to_ical_calendar event in
192 let other_events = ref false in
193 let calendar =
194 (* Replace the event with our updated version *)
195 let filtered_components =
196 List.filter
197 (function
198 | `Event e ->
199 (* Filter out the old event *)
200 let uid = e.Icalendar.uid in
201 if snd uid = event_id then false
202 else (
203 other_events := true;
204 true)
205 | _ -> true)
206 existing_components
207 in
208 (existing_props, filtered_components)
209 in
210 let content = Icalendar.to_ics ~cr:true calendar in
211 let* _ =
212 try
213 (match !other_events with
214 | true -> Eio.Path.save ~create:(`Or_truncate 0o644) file content
215 | false -> Eio.Path.unlink file);
216 Ok ()
217 with Eio.Exn.Io _ as exn ->
218 Error
219 (`Msg
220 (Fmt.str "Failed to write file %s: %a\n%!" (snd file) Eio.Exn.pp exn))
221 in
222 calendar_dir.calendar_names <-
223 CalendarMap.add calendar_name
224 (match CalendarMap.find_opt calendar_name calendar_dir.calendar_names with
225 (* filter old version *)
226 | Some lst -> List.filter (fun e -> Event.get_id e = event_id) lst
227 | None -> [])
228 calendar_dir.calendar_names;
229 Ok ()
230
231let get_path t = t.path