My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Implementation of JMAP Email/parse method (RFC 8621 Section 4.9) *)
2
3(** {1 Email/parse Arguments} *)
4
5module Parse_args = struct
6 type t = {
7 account_id : string;
8 blob_ids : Jmap.Id.t list;
9 properties : string list option;
10 body_properties : string list option;
11 fetch_text_body_values : bool;
12 fetch_html_body_values : bool;
13 fetch_all_body_values : bool;
14 max_body_value_bytes : int;
15 }
16
17 let create ~account_id ~blob_ids ?properties ?body_properties
18 ?(fetch_text_body_values=false) ?(fetch_html_body_values=false)
19 ?(fetch_all_body_values=false) ?(max_body_value_bytes=0) () = {
20 account_id;
21 blob_ids;
22 properties;
23 body_properties;
24 fetch_text_body_values;
25 fetch_html_body_values;
26 fetch_all_body_values;
27 max_body_value_bytes;
28 }
29
30 let account_id t = t.account_id
31 let blob_ids t = t.blob_ids
32 let properties t = t.properties
33 let body_properties t = t.body_properties
34 let fetch_text_body_values t = t.fetch_text_body_values
35 let fetch_html_body_values t = t.fetch_html_body_values
36 let fetch_all_body_values t = t.fetch_all_body_values
37 let max_body_value_bytes t = t.max_body_value_bytes
38
39 let to_json t =
40 let json_fields = [
41 ("accountId", `String t.account_id);
42 ("blobIds", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.blob_ids));
43 ("fetchTextBodyValues", `Bool t.fetch_text_body_values);
44 ("fetchHTMLBodyValues", `Bool t.fetch_html_body_values);
45 ("fetchAllBodyValues", `Bool t.fetch_all_body_values);
46 ("maxBodyValueBytes", `Int t.max_body_value_bytes);
47 ] in
48 let json_fields = match t.properties with
49 | Some props -> ("properties", `List (List.map (fun p -> `String p) props)) :: json_fields
50 | None -> json_fields
51 in
52 let json_fields = match t.body_properties with
53 | Some props -> ("bodyProperties", `List (List.map (fun p -> `String p) props)) :: json_fields
54 | None -> json_fields
55 in
56 `Assoc (List.rev json_fields)
57
58 let of_json json =
59 try
60 let open Yojson.Safe.Util in
61 let account_id = json |> member "accountId" |> to_string in
62 let blob_ids_json = json |> member "blobIds" |> to_list in
63 let blob_ids = List.map (fun id_json ->
64 let id_str = to_string id_json in
65 match Jmap.Id.of_string id_str with
66 | Ok id -> id
67 | Error _ -> failwith ("Invalid blob ID: " ^ id_str)
68 ) blob_ids_json in
69 let properties = match json |> member "properties" with
70 | `Null -> None
71 | props_json -> Some (List.map to_string (to_list props_json))
72 in
73 let body_properties = match json |> member "bodyProperties" with
74 | `Null -> None
75 | props_json -> Some (List.map to_string (to_list props_json))
76 in
77 let fetch_text_body_values = json |> member "fetchTextBodyValues" |> to_bool_option |> Option.value ~default:false in
78 let fetch_html_body_values = json |> member "fetchHTMLBodyValues" |> to_bool_option |> Option.value ~default:false in
79 let fetch_all_body_values = json |> member "fetchAllBodyValues" |> to_bool_option |> Option.value ~default:false in
80 let max_body_value_bytes = json |> member "maxBodyValueBytes" |> to_int_option |> Option.value ~default:0 in
81 Ok (create ~account_id ~blob_ids ?properties ?body_properties
82 ~fetch_text_body_values ~fetch_html_body_values
83 ~fetch_all_body_values ~max_body_value_bytes ())
84 with
85 | exn -> Error ("Failed to parse Email/parse args: " ^ Printexc.to_string exn)
86end
87
88(** {1 Email/parse Response} *)
89
90module Parse_response = struct
91 type response = {
92 account_id : string;
93 parsed : (Jmap.Id.t * Yojson.Safe.t) list; (* Map of blob IDs to Email objects *)
94 not_parsable : Jmap.Id.t list;
95 not_found : Jmap.Id.t list;
96 }
97
98 let create ~account_id ?(parsed=[]) ?(not_parsable=[]) ?(not_found=[]) () = {
99 account_id;
100 parsed;
101 not_parsable;
102 not_found;
103 }
104
105 let account_id t = t.account_id
106 let parsed t = t.parsed
107 let not_parsable t = t.not_parsable
108 let not_found t = t.not_found
109
110 let to_json t =
111 let json_fields = [
112 ("accountId", `String t.account_id);
113 ] in
114 let json_fields = if t.parsed = [] then
115 ("parsed", `Null) :: json_fields
116 else
117 ("parsed", `Assoc (List.map (fun (id, email) -> (Jmap.Id.to_string id, email)) t.parsed)) :: json_fields
118 in
119 let json_fields = if t.not_parsable = [] then
120 ("notParsable", `Null) :: json_fields
121 else
122 ("notParsable", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_parsable)) :: json_fields
123 in
124 let json_fields = if t.not_found = [] then
125 ("notFound", `Null) :: json_fields
126 else
127 ("notFound", `List (List.map (fun id -> `String (Jmap.Id.to_string id)) t.not_found)) :: json_fields
128 in
129 `Assoc (List.rev json_fields)
130
131 let of_json json =
132 try
133 let open Yojson.Safe.Util in
134 let account_id = json |> member "accountId" |> to_string in
135 let parsed = match json |> member "parsed" with
136 | `Null -> []
137 | parsed_json -> List.map (fun (blob_id_str, email_json) ->
138 let blob_id = match Jmap.Id.of_string blob_id_str with
139 | Ok id -> id
140 | Error _ -> failwith ("Invalid blob ID in parsed: " ^ blob_id_str)
141 in
142 (blob_id, email_json)
143 ) (to_assoc parsed_json)
144 in
145 let not_parsable = match json |> member "notParsable" with
146 | `Null -> []
147 | ids_json -> List.map (fun id_json ->
148 let id_str = to_string id_json in
149 match Jmap.Id.of_string id_str with
150 | Ok id -> id
151 | Error _ -> failwith ("Invalid blob ID in notParsable: " ^ id_str)
152 ) (to_list ids_json)
153 in
154 let not_found = match json |> member "notFound" with
155 | `Null -> []
156 | ids_json -> List.map (fun id_json ->
157 let id_str = to_string id_json in
158 match Jmap.Id.of_string id_str with
159 | Ok id -> id
160 | Error _ -> failwith ("Invalid blob ID in notFound: " ^ id_str)
161 ) (to_list ids_json)
162 in
163 Ok (create ~account_id ~parsed ~not_parsable ~not_found ())
164 with
165 | exn -> Error ("Failed to parse Email/parse response: " ^ Printexc.to_string exn)
166end