My agentic slop goes here. Not intended for anyone else!
anil.recoil.org
1(** Email keywords and flags system implementation.
2
3 This module implements the JMAP email keywords system with efficient
4 storage and manipulation operations as specified in RFC 8621.
5
6 @see <https://www.rfc-editor.org/rfc/rfc8621.html#section-4.1.1> RFC 8621, Section 4.1.1
7*)
8
9type keyword =
10 | Draft
11 | Seen
12 | Flagged
13 | Answered
14 | Forwarded
15 | Phishing
16 | Junk
17 | NotJunk
18 | Notify
19 | Muted
20 | Followed
21 | Memo
22 | HasMemo
23 | Autosent
24 | Unsubscribed
25 | CanUnsubscribe
26 | Imported
27 | IsTrusted
28 | MaskedEmail
29 | New
30 | MailFlagBit0
31 | MailFlagBit1
32 | MailFlagBit2
33 | Custom of string
34
35(* Internal representation using a set-like structure for efficiency *)
36type t = {
37 keywords : keyword list; (* We keep it simple with a list for now *)
38}
39
40let empty () = { keywords = [] }
41
42
43let has_keyword t keyword = List.mem keyword t.keywords
44
45let is_draft t = has_keyword t Draft
46let is_seen t = has_keyword t Seen
47let is_unread t = not (is_seen t) && not (is_draft t)
48let is_flagged t = has_keyword t Flagged
49let is_answered t = has_keyword t Answered
50let is_forwarded t = has_keyword t Forwarded
51let is_phishing t = has_keyword t Phishing
52let is_junk t = has_keyword t Junk
53let is_not_junk t = has_keyword t NotJunk
54
55let has_custom_keyword t custom_keyword =
56 List.exists (function Custom k -> k = custom_keyword | _ -> false) t.keywords
57
58let custom_keywords t =
59 List.filter_map (function Custom k -> Some k | _ -> None) t.keywords
60
61let add t keyword =
62 if has_keyword t keyword then t
63 else { keywords = keyword :: t.keywords }
64
65let remove t keyword =
66 { keywords = List.filter (fun k -> k <> keyword) t.keywords }
67
68let add_custom t custom_keyword =
69 add t (Custom custom_keyword)
70
71let remove_custom t custom_keyword =
72 remove t (Custom custom_keyword)
73
74let keyword_to_string = function
75 | Draft -> "$draft"
76 | Seen -> "$seen"
77 | Flagged -> "$flagged"
78 | Answered -> "$answered"
79 | Forwarded -> "$forwarded"
80 | Phishing -> "$phishing"
81 | Junk -> "$junk"
82 | NotJunk -> "$notjunk"
83 | Notify -> "$notify"
84 | Muted -> "$muted"
85 | Followed -> "$followed"
86 | Memo -> "$memo"
87 | HasMemo -> "$hasmemo"
88 | Autosent -> "$autosent"
89 | Unsubscribed -> "$unsubscribed"
90 | CanUnsubscribe -> "$canunsubscribe"
91 | Imported -> "$imported"
92 | IsTrusted -> "$istrusted"
93 | MaskedEmail -> "$maskedemail"
94 | New -> "$new"
95 | MailFlagBit0 -> "$MailFlagBit0"
96 | MailFlagBit1 -> "$MailFlagBit1"
97 | MailFlagBit2 -> "$MailFlagBit2"
98 | Custom s -> s
99
100let keyword_of_string = function
101 | "$draft" -> Draft
102 | "$seen" -> Seen
103 | "$flagged" -> Flagged
104 | "$answered" -> Answered
105 | "$forwarded" -> Forwarded
106 | "$phishing" -> Phishing
107 | "$junk" -> Junk
108 | "$notjunk" -> NotJunk
109 | "$notify" -> Notify
110 | "$muted" -> Muted
111 | "$followed" -> Followed
112 | "$memo" -> Memo
113 | "$hasmemo" -> HasMemo
114 | "$autosent" -> Autosent
115 | "$unsubscribed" -> Unsubscribed
116 | "$canunsubscribe" -> CanUnsubscribe
117 | "$imported" -> Imported
118 | "$istrusted" -> IsTrusted
119 | "$maskedemail" -> MaskedEmail
120 | "$new" -> New
121 | "$MailFlagBit0" -> MailFlagBit0
122 | "$MailFlagBit1" -> MailFlagBit1
123 | "$MailFlagBit2" -> MailFlagBit2
124 | s -> Custom s
125
126let to_map t =
127 let map = Hashtbl.create (List.length t.keywords) in
128 List.iter (fun kw -> Hashtbl.add map (keyword_to_string kw) true) t.keywords;
129 map
130
131let to_json t =
132 let map_json = to_map t in
133 let assoc_list = Hashtbl.fold (fun k v acc -> (k, `Bool v) :: acc) map_json [] in
134 `Assoc assoc_list
135
136let of_json = function
137 | `Assoc fields ->
138 let parse_keywords acc_result (key, value) =
139 match acc_result with
140 | Error _ as err -> err
141 | Ok acc_keywords ->
142 (match value with
143 | `Bool true -> Ok ((keyword_of_string key) :: acc_keywords)
144 | `Bool false -> Ok acc_keywords (* Keywords with false value are not present *)
145 | _ -> Error ("Invalid keyword value for " ^ key ^ ": expected boolean"))
146 in
147 (match List.fold_left parse_keywords (Ok []) fields with
148 | Ok keywords -> Ok { keywords = List.rev keywords }
149 | Error msg -> Error msg)
150 | _ -> Error "Keywords must be a JSON object"
151
152(* Pretty-printing functions for PRINTABLE interface *)
153let pp ppf t =
154 let keyword_strings = List.map keyword_to_string t.keywords in
155 Format.fprintf ppf "{%s}" (String.concat ", " keyword_strings)
156
157let pp_hum = pp
158
159(* Collection interface functions for COLLECTION interface *)
160let items t = t.keywords
161
162let total t = Some (List.length t.keywords)
163
164let create ~items ?total () =
165 let _ = total in (* Acknowledge unused parameter *)
166 { keywords = items }
167
168let map f t = { keywords = List.map f t.keywords }
169
170let filter f t = { keywords = List.filter f t.keywords }