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