My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** High-level Email query implementation *)
2
3type property = Property.t
4
5
6
7module Sort = struct
8 type t = Jmap.Methods.Comparator.t
9
10 let by_date_desc = Jmap.Methods.Comparator.v ~property:"receivedAt" ~is_ascending:false ()
11 let by_date_asc = Jmap.Methods.Comparator.v ~property:"receivedAt" ~is_ascending:true ()
12 let by_size_desc = Jmap.Methods.Comparator.v ~property:"size" ~is_ascending:false ()
13 let by_from = Jmap.Methods.Comparator.v ~property:"from" ~is_ascending:true ()
14 let by_subject = Jmap.Methods.Comparator.v ~property:"subject" ~is_ascending:true ()
15
16 let custom ~property ~is_ascending =
17 Jmap.Methods.Comparator.v ~property ~is_ascending ()
18
19 let combine sorts = sorts
20end
21
22module Filter = struct
23 type t = Jmap.Methods.Filter.t
24
25 open Jmap.Methods.Filter
26
27 (* Email-specific filter constructors using core utilities *)
28 let in_mailbox (mailbox_id : Jmap.Id.t) =
29 condition (`Assoc [("inMailbox", `String (Jmap.Id.to_string mailbox_id))])
30
31 let in_mailbox_role role =
32 condition (`Assoc [("inMailboxOtherThan", `List [`String role])])
33
34 let unread =
35 not_ (condition (`Assoc [("hasKeyword", `String "$seen")]))
36
37 let flagged =
38 condition (`Assoc [("hasKeyword", `String "$flagged")])
39
40 let has_attachment =
41 property_equals "hasAttachment" (`Bool true)
42
43 let from email =
44 property_equals "from" (`String email)
45
46 let to_ email =
47 property_equals "to" (`String email)
48
49 let subject_contains text =
50 text_contains "subject" text
51
52 let body_contains text =
53 text_contains "text" text
54
55 let after date =
56 property_gt "after" (`String (Jmap.Date.to_rfc3339 date))
57
58 let before date =
59 property_lt "before" (`String (Jmap.Date.to_rfc3339 date))
60
61 let between start end_ =
62 and_ [after start; before end_]
63
64 let min_size bytes =
65 property_ge "minSize" (`Int bytes)
66
67 let max_size bytes =
68 property_le "maxSize" (`Int bytes)
69
70 (* Re-export core filter functions for convenience *)
71 let and_ = and_
72 let or_ = or_
73 let not_ = not_
74 let to_json = to_json
75end
76
77type query_builder = {
78 account_id : string option;
79 filter : Filter.t option;
80 sort : Sort.t list;
81 limit_count : Jmap.UInt.t option;
82 position : int option;
83 properties : property list;
84 collapse_threads : bool;
85 calculate_total : bool;
86}
87
88let query () = {
89 account_id = None;
90 filter = None;
91 sort = [Sort.by_date_desc];
92 limit_count = None;
93 position = None;
94 properties = Property.common_list_properties;
95 collapse_threads = false;
96 calculate_total = false;
97}
98
99let with_account account_id builder =
100 { builder with account_id = Some (Jmap.Id.to_string account_id) }
101
102let where filter builder =
103 { builder with filter = Some filter }
104
105let order_by sort builder =
106 { builder with sort = [sort] }
107
108let limit n builder =
109 match Jmap.UInt.of_int n with
110 | Ok uint -> { builder with limit_count = Some uint }
111 | Error _ -> failwith ("Invalid limit value: " ^ string_of_int n)
112
113let offset n builder =
114 { builder with position = Some n }
115
116let select properties builder =
117 { builder with properties }
118
119let select_preset preset builder =
120 let properties = match preset with
121 | `ListV -> Property.common_list_properties
122 | `Preview -> Property.for_preview ()
123 | `Full -> Property.for_reading ()
124 | `Threading -> Property.minimal_for_query ()
125 in
126 { builder with properties }
127
128let collapse_threads value builder =
129 { builder with collapse_threads = value }
130
131let calculate_total value builder =
132 { builder with calculate_total = value }
133
134type query_result = {
135 ids : Jmap.Id.t list;
136 total : int option;
137 position : int;
138 can_calculate_changes : bool;
139}
140
141type 'email fetch_result = {
142 emails : 'email list;
143 total : int option;
144}
145
146(* JSON generation functions for jmap-unix layer *)
147
148let to_core_query_args builder =
149 let account_id = match builder.account_id with
150 | Some id -> id
151 | None -> failwith "Account ID must be set before building query"
152 in
153 Jmap.Methods.Query_args.v
154 ~account_id
155 ?filter:builder.filter
156 ~sort:builder.sort
157 ?position:builder.position
158 ?limit:(Option.map Jmap.UInt.to_int builder.limit_count)
159 ?calculate_total:(Some builder.calculate_total)
160 ?collapse_threads:(Some builder.collapse_threads)
161 ()
162
163let build_email_query builder =
164 let args = to_core_query_args builder in
165 Jmap.Methods.Query_args.to_json args
166
167let property_preset_to_strings = function
168 | `ListV -> Property.to_string_list Property.common_list_properties
169 | `Preview -> Property.to_string_list (Property.for_preview ())
170 | `Full -> Property.to_string_list (Property.for_reading ())
171 | `Threading -> Property.to_string_list (Property.minimal_for_query ())
172
173let build_email_get_with_ref ~account_id ~properties ~result_of =
174 let property_strings = Property.to_string_list properties in
175 `Assoc [
176 ("accountId", `String (Jmap.Id.to_string account_id));
177 ("properties", `List (List.map (fun s -> `String s) property_strings));
178 ("#ids", `Assoc [
179 ("resultOf", `String result_of);
180 ("name", `String "Email/query");
181 ("path", `String "/ids")
182 ])
183 ]
184
185let properties_to_strings properties =
186 Property.to_string_list properties
187
188
189(* Common query builders *)
190let inbox ?limit:lim () =
191 let q = query () |> where (Filter.in_mailbox_role "inbox") in
192 match lim with
193 | Some n -> limit n q
194 | None -> q
195
196let unread ?limit:lim () =
197 let q = query () |> where Filter.unread in
198 match lim with
199 | Some n -> limit n q
200 | None -> q
201
202let recent ?limit:lim () =
203 let yesterday = Jmap.Date.of_timestamp (Unix.time () -. 86400.) in
204 let q = query () |> where (Filter.after yesterday) in
205 match lim with
206 | Some n -> limit n q
207 | None -> q
208
209let from_sender sender ?limit:lim () =
210 let q = query () |> where (Filter.from sender) in
211 match lim with
212 | Some n -> limit n q
213 | None -> q
214
215let search text ?limit:lim () =
216 let q = query () |> where (Filter.or_
217 [Filter.subject_contains text;
218 Filter.body_contains text]) in
219 match lim with
220 | Some n -> limit n q
221 | None -> q
222
223let flagged ?limit:lim () =
224 let q = query () |> where Filter.flagged in
225 match lim with
226 | Some n -> limit n q
227 | None -> q
228
229let with_attachments ?limit:lim () =
230 let q = query () |> where Filter.has_attachment in
231 match lim with
232 | Some n -> limit n q
233 | None -> q
234
235(* Pretty printing - generic functions that need specific email extractors *)
236let pp_email ppf _email =
237 (* This function is generic and needs to be specialized at call site *)
238 Format.fprintf ppf "Email (generic printer)"
239
240let pp_email_list ppf emails =
241 Format.fprintf ppf "@[<v>%a@]"
242 (Format.pp_print_list ~pp_sep:Format.pp_print_cut pp_email) emails