Command-line and Emacs Calendar Client
ryan.freumh.org
1open Eio
2open Cmdliner
3open Caledonia_lib
4open Caledonia_lib.Sexp
5
6let run ~stdin ~stdout ~fs calendar_dir () =
7 let reader = Buf_read.of_flow stdin ~max_size:1_000_000 in
8 let ( let* ) = Result.bind in
9
10 (* Initialize mutable events variable - will be updated on refresh *)
11 let mutable_events = ref (Calendar_dir.get_events ~fs calendar_dir) in
12
13 try
14 while true do
15 let line = Buf_read.line reader in
16 let response =
17 try
18 let sexp = Sexplib.Sexp.of_string line in
19 let request = Sexp.request_of_sexp sexp in
20 match request with
21 | ListCalendars ->
22 let* names = Calendar_dir.list_calendar_names ~fs calendar_dir in
23 Ok (sexp_of_response (Ok (Calendars names)))
24 | Refresh ->
25 (* Reload events from disk *)
26 mutable_events := Calendar_dir.get_events ~fs calendar_dir;
27 (* Return an empty response *)
28 Ok (sexp_of_response (Ok Empty))
29 | Query query_req ->
30 let* filter, from, to_, limit, _tz =
31 generate_query_params query_req
32 in
33 let* events = !mutable_events in
34 let events = Event.query events ~filter ~from ~to_ ?limit () in
35 Ok (sexp_of_response (Ok (Events events)))
36 with
37 | Sexplib.Conv.Of_sexp_error (_exn, bad_sexp) ->
38 let msg =
39 Printf.sprintf "Invalid request format for '%s': %s" line
40 (to_string bad_sexp)
41 in
42 Ok (sexp_of_response (Error msg))
43 | Failure msg ->
44 Ok (sexp_of_response (Error ("Processing failed: " ^ msg)))
45 | exn ->
46 let msg =
47 Printf.sprintf "Unexpected error: %s" (Printexc.to_string exn)
48 in
49 Ok (sexp_of_response (Error msg))
50 in
51 let response_line =
52 to_string
53 (match response with
54 | Ok r -> r
55 | Error (`Msg msg) -> Sexp.sexp_of_response (Error msg))
56 in
57 Flow.copy_string (response_line ^ "\n") stdout
58 done
59 with End_of_file -> ()
60
61let cmd ~stdin ~stdout ~fs calendar_dir =
62 let run () =
63 let _ = run ~stdin ~stdout ~fs calendar_dir () in
64 0
65 in
66 let term = Term.(const run) in
67
68 let doc = "Process single-line S-expression requests from stdin to stdout." in
69 let man =
70 [
71 `S Manpage.s_description;
72 `P
73 "$(mname) $(tname) reads S-expression requests (one per line) from \
74 stdin, processes them, and writes S-expression responses (one per \
75 line) to stdout.";
76 `P "Example request: '(Query (()))'";
77 `P
78 "Example response: '(Ok (Events ((id ...) (summary ...) ...)))' or \
79 '(Error \"...\")'";
80 `S Manpage.s_examples;
81 `Pre "echo '(Query ((text \\\"meeting\\\")))' | $(mname) $(tname)";
82 ]
83 in
84 let info = Cmd.info "server" ~doc ~man in
85 Cmd.v info term