Command-line and Emacs Calendar Client
ryan.freumh.org
1open Sexplib.Std
2
3type search_field = Summary | Description | Location [@@deriving sexp]
4
5type query_request = {
6 from : string option; [@sexp.option]
7 to_ : string; (* Required field, not optional *)
8 timezone : string option; [@sexp.option]
9 calendars : string list; [@default []]
10 text : string option; [@sexp.option]
11 search_in : search_field list; [@default []]
12 id : string option; [@sexp.option]
13 recurring : bool option; [@sexp.option]
14 limit : int option; [@sexp.option]
15}
16[@@deriving sexp]
17
18(* workaround https://github.com/janestreet/ppx_sexp_conv/issues/18#issuecomment-2792574295 *)
19let query_request_of_sexp sexp =
20 let open Sexplib.Sexp in
21 let sexp = match sexp with
22 | List ss ->
23 List (List.map (function List (Atom "to" :: v) -> List (Atom "to_" :: v) | v -> v) ss)
24 | v -> v
25 in
26 query_request_of_sexp sexp
27
28let sexp_of_query_request q =
29 let open Sexplib.Sexp in
30 let sexp = sexp_of_query_request q in
31 let sexp = match sexp with
32 | List ss ->
33 List (List.map (function List (Atom "to_" :: v) -> List (Atom "to" :: v) | v -> v) ss)
34 | v -> v
35 in
36 sexp
37
38type request = ListCalendars | Query of query_request | Refresh [@@deriving sexp]
39
40type response_payload = Calendars of string list | Events of Event.t list | Empty
41[@@deriving sexp_of]
42
43type response = Ok of response_payload | Error of string [@@deriving sexp_of]
44
45let filter_func_of_search_field text = function
46 | Summary -> Event.summary_contains text
47 | Description -> Event.description_contains text
48 | Location -> Event.location_contains text
49
50let parse_timezone ~timezone =
51 match timezone with
52 | Some tzid -> (
53 match Timedesc.Time_zone.make tzid with
54 | Some tz -> tz
55 | None -> failwith ("Invalid timezone: " ^ tzid))
56 | None -> !Date.default_timezone ()
57
58let generate_query_params (req : query_request) =
59 let ( let* ) = Result.bind in
60 let tz = parse_timezone ~timezone:req.timezone in
61 let* from =
62 match req.from with
63 | None -> Ok None
64 | Some s -> Result.map Option.some (Date.parse_date ~tz s `From)
65 in
66 let* to_ =
67 let* to_date = Date.parse_date ~tz req.to_ `To in
68 Ok (Date.to_end_of_day to_date)
69 in
70 let filters = ref [] in
71 (match req.calendars with
72 | [] -> ()
73 | cals -> filters := Event.in_calendars cals :: !filters);
74 (match req.text with
75 | Some text ->
76 let search_fields =
77 match req.search_in with
78 | [] -> [ Summary; Description; Location ]
79 | fields -> fields
80 in
81 let text_filters =
82 List.map (filter_func_of_search_field text) search_fields
83 in
84 filters := Event.or_filter text_filters :: !filters
85 | None -> ());
86 (match req.id with
87 | Some id -> filters := Event.with_id id :: !filters
88 | None -> ());
89 (match req.recurring with
90 | Some true -> filters := Event.recurring_only () :: !filters
91 | Some false -> filters := Event.non_recurring_only () :: !filters
92 | _ -> ());
93 let final_filter = Event.and_filter !filters in
94 let limit = req.limit in
95 Ok (final_filter, from, to_, limit, tz)
96
97let is_whitespace = function ' ' | '\t' | '\n' | '\r' -> true | _ -> false
98
99let needs_quotes s =
100 String.exists
101 (fun c -> is_whitespace c || c = '(' || c = ')' || c = '"' || c = '\'')
102 s
103
104let escape s =
105 let buf = Buffer.create (String.length s) in
106 String.iter
107 (function
108 | '"' -> Buffer.add_string buf "\\\""
109 | '\\' -> Buffer.add_string buf "\\\\"
110 | '\n' -> Buffer.add_string buf "\\n"
111 | '\r' -> Buffer.add_string buf "\\r"
112 | '\t' -> Buffer.add_string buf "\\t"
113 | c -> Buffer.add_char buf c)
114 s;
115 "\"" ^ Buffer.contents buf ^ "\""
116
117let rec to_string = function
118 | Sexplib.Sexp.Atom str -> if needs_quotes str then escape str else str
119 | Sexplib.Sexp.List lst ->
120 "(" ^ String.concat " " (List.map to_string lst) ^ ")"