anil.recoil.org
OCaml HTML5 parser/serialiser based on Python's JustHTML
Merge commit '3a7e59efa3b5dedd0d12212b73395e1f36d0695d' as 'ocaml-mail-flag'
+2001
+17
ocaml-mail-flag/.gitignore
+17
ocaml-mail-flag/.gitignore
+1
ocaml-mail-flag/.ocamlformat
+1
ocaml-mail-flag/.ocamlformat
···
···
1
+
version=0.28.1
+53
ocaml-mail-flag/.tangled/workflows/build.yml
+53
ocaml-mail-flag/.tangled/workflows/build.yml
···
···
1
+
when:
2
+
- event: ["push", "pull_request"]
3
+
branch: ["main"]
4
+
5
+
engine: nixery
6
+
7
+
dependencies:
8
+
nixpkgs:
9
+
- shell
10
+
- stdenv
11
+
- findutils
12
+
- binutils
13
+
- libunwind
14
+
- ncurses
15
+
- opam
16
+
- git
17
+
- gawk
18
+
- gnupatch
19
+
- gnum4
20
+
- gnumake
21
+
- gnutar
22
+
- gnused
23
+
- gnugrep
24
+
- diffutils
25
+
- gzip
26
+
- bzip2
27
+
- gcc
28
+
- ocaml
29
+
- pkg-config
30
+
31
+
steps:
32
+
- name: opam
33
+
command: |
34
+
opam init --disable-sandboxing -a -y
35
+
- name: repo
36
+
command: |
37
+
opam repo add aoah https://tangled.org/anil.recoil.org/aoah-opam-repo.git
38
+
- name: switch
39
+
command: |
40
+
opam install . --confirm-level=unsafe-yes --deps-only
41
+
- name: build
42
+
command: |
43
+
opam exec -- dune build
44
+
- name: switch-test
45
+
command: |
46
+
opam install . --confirm-level=unsafe-yes --deps-only --with-test
47
+
- name: test
48
+
command: |
49
+
opam exec -- dune runtest --verbose
50
+
- name: doc
51
+
command: |
52
+
opam install -y odoc
53
+
opam exec -- dune build @doc
+15
ocaml-mail-flag/LICENSE.md
+15
ocaml-mail-flag/LICENSE.md
···
···
1
+
ISC License
2
+
3
+
Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>
4
+
5
+
Permission to use, copy, modify, and distribute this software for any
6
+
purpose with or without fee is hereby granted, provided that the above
7
+
copyright notice and this permission notice appear in all copies.
8
+
9
+
THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10
+
WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11
+
MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12
+
ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13
+
WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14
+
ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15
+
OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
+62
ocaml-mail-flag/README.md
+62
ocaml-mail-flag/README.md
···
···
1
+
# mail-flag - Unified Message Flags for IMAP and JMAP
2
+
3
+
Type-safe message keywords, system flags, and mailbox attributes for email protocols.
4
+
5
+
## Key Features
6
+
7
+
- **Unified keyword types**: Standard, spam, extended, and Apple Mail flag color keywords
8
+
- **Protocol conversion**: Seamless mapping between IMAP system flags and JMAP keywords
9
+
- **Mailbox attributes**: LIST attributes and special-use roles (RFC 6154)
10
+
- **Apple Mail colors**: 3-bit flag color encoding/decoding
11
+
12
+
## Supported Standards
13
+
14
+
- [RFC 9051](https://www.rfc-editor.org/rfc/rfc9051) - IMAP4rev2
15
+
- [RFC 8621](https://www.rfc-editor.org/rfc/rfc8621) - JMAP for Mail
16
+
- [RFC 6154](https://www.rfc-editor.org/rfc/rfc6154) - IMAP Special-Use Mailboxes
17
+
- [draft-ietf-mailmaint](https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute) - Extended keywords and attributes
18
+
19
+
## Usage
20
+
21
+
```ocaml
22
+
open Mail_flag
23
+
24
+
(* Parse keywords from IMAP or JMAP format *)
25
+
let seen = Keyword.of_string "\\Seen" (* IMAP system flag *)
26
+
let junk = Keyword.of_string "$junk" (* JMAP keyword *)
27
+
28
+
(* Convert between formats *)
29
+
let imap_str = Keyword.to_imap_string seen (* "\\Seen" *)
30
+
let jmap_str = Keyword.to_string seen (* "$seen" *)
31
+
32
+
(* Check keyword properties *)
33
+
let is_system = Keyword.is_standard seen (* true *)
34
+
let exclusive = Keyword.is_mutually_exclusive `Junk `NotJunk (* true *)
35
+
36
+
(* Work with mailbox attributes *)
37
+
let drafts = Mailbox_attr.of_string "\\Drafts"
38
+
let role = Mailbox_attr.to_jmap_role drafts (* Some "drafts" *)
39
+
40
+
(* Apple Mail flag colors *)
41
+
let color = Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit2]
42
+
(* color = Some `Purple *)
43
+
```
44
+
45
+
## Installation
46
+
47
+
```
48
+
opam install mail-flag
49
+
```
50
+
51
+
## Documentation
52
+
53
+
API documentation is available via:
54
+
55
+
```
56
+
opam install mail-flag
57
+
odig doc mail-flag
58
+
```
59
+
60
+
## License
61
+
62
+
ISC
+4
ocaml-mail-flag/dune
+4
ocaml-mail-flag/dune
+23
ocaml-mail-flag/dune-project
+23
ocaml-mail-flag/dune-project
···
···
1
+
(lang dune 3.20)
2
+
3
+
(name mail-flag)
4
+
5
+
(generate_opam_files true)
6
+
7
+
(license ISC)
8
+
(authors "Anil Madhavapeddy")
9
+
(homepage "https://tangled.org/@anil.recoil.org/ocaml-mail-flag")
10
+
(maintainers "Anil Madhavapeddy <anil@recoil.org>")
11
+
(bug_reports "https://tangled.org/@anil.recoil.org/ocaml-mail-flag/issues")
12
+
(maintenance_intent "(latest)")
13
+
14
+
(package
15
+
(name mail-flag)
16
+
(synopsis "Unified message flags and mailbox attributes for IMAP/JMAP")
17
+
(description
18
+
"Type-safe message keywords, system flags, and mailbox attributes for email protocols. Supports RFC 9051 (IMAP4rev2), RFC 8621 (JMAP Mail), RFC 6154 (Special-Use), and draft-ietf-mailmaint extensions.")
19
+
(depends
20
+
(ocaml (>= 5.1.0))
21
+
(fmt (>= 0.9))
22
+
(odoc :with-doc)
23
+
(alcotest (and :with-test (>= 1.7.0)))))
+4
ocaml-mail-flag/lib/dune
+4
ocaml-mail-flag/lib/dune
+102
ocaml-mail-flag/lib/flag_color.ml
+102
ocaml-mail-flag/lib/flag_color.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Apple Mail flag colors.
7
+
8
+
See {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3}
9
+
draft-ietf-mailmaint-messageflag-mailboxattribute Section 3}.
10
+
11
+
The Apple Mail flag color encoding uses three keywords to represent
12
+
colors as a 3-bit pattern:
13
+
- [$MailFlagBit0]: bit 0
14
+
- [$MailFlagBit1]: bit 1
15
+
- [$MailFlagBit2]: bit 2
16
+
17
+
Bit patterns (bit0, bit1, bit2):
18
+
- Red: (false, false, false) = 000
19
+
- Orange: (true, false, false) = 100
20
+
- Yellow: (false, true, false) = 010
21
+
- Green: (true, true, false) = 110
22
+
- Blue: (false, false, true) = 001
23
+
- Purple: (true, false, true) = 101
24
+
- Gray: (false, true, true) = 011
25
+
- 111: undefined *)
26
+
27
+
type t = [
28
+
| `Red (** Bit pattern: 000 *)
29
+
| `Orange (** Bit pattern: 100 *)
30
+
| `Yellow (** Bit pattern: 010 *)
31
+
| `Green (** Bit pattern: 110 *)
32
+
| `Blue (** Bit pattern: 001 *)
33
+
| `Purple (** Bit pattern: 101 *)
34
+
| `Gray (** Bit pattern: 011 *)
35
+
]
36
+
37
+
let to_bits = function
38
+
| `Red -> (false, false, false) (* 000 *)
39
+
| `Orange -> (true, false, false) (* 100 *)
40
+
| `Yellow -> (false, true, false) (* 010 *)
41
+
| `Green -> (true, true, false) (* 110 *)
42
+
| `Blue -> (false, false, true) (* 001 *)
43
+
| `Purple -> (true, false, true) (* 101 *)
44
+
| `Gray -> (false, true, true) (* 011 *)
45
+
46
+
let of_bits = function
47
+
| (false, false, false) -> Some `Red (* 000 *)
48
+
| (true, false, false) -> Some `Orange (* 100 *)
49
+
| (false, true, false) -> Some `Yellow (* 010 *)
50
+
| (true, true, false) -> Some `Green (* 110 *)
51
+
| (false, false, true) -> Some `Blue (* 001 *)
52
+
| (true, false, true) -> Some `Purple (* 101 *)
53
+
| (false, true, true) -> Some `Gray (* 011 *)
54
+
| (true, true, true) -> None (* 111 - undefined *)
55
+
56
+
let to_keywords = function
57
+
| `Red -> []
58
+
| `Orange -> [ `MailFlagBit0 ]
59
+
| `Yellow -> [ `MailFlagBit1 ]
60
+
| `Green -> [ `MailFlagBit0; `MailFlagBit1 ]
61
+
| `Blue -> [ `MailFlagBit2 ]
62
+
| `Purple -> [ `MailFlagBit0; `MailFlagBit2 ]
63
+
| `Gray -> [ `MailFlagBit1; `MailFlagBit2 ]
64
+
65
+
let of_keywords (keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list) =
66
+
let has k = List.exists (fun x -> x = k) keywords in
67
+
let bit0 = has `MailFlagBit0 in
68
+
let bit1 = has `MailFlagBit1 in
69
+
let bit2 = has `MailFlagBit2 in
70
+
(* If no bits are set, we cannot distinguish between "no flag color"
71
+
and "Red" (which is 000). Return None to indicate ambiguity. *)
72
+
if not bit0 && not bit1 && not bit2 then None
73
+
else of_bits (bit0, bit1, bit2)
74
+
75
+
let of_keywords_default_red (keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list) =
76
+
let has k = List.exists (fun x -> x = k) keywords in
77
+
let bit0 = has `MailFlagBit0 in
78
+
let bit1 = has `MailFlagBit1 in
79
+
let bit2 = has `MailFlagBit2 in
80
+
of_bits (bit0, bit1, bit2)
81
+
82
+
let to_string = function
83
+
| `Red -> "red"
84
+
| `Orange -> "orange"
85
+
| `Yellow -> "yellow"
86
+
| `Green -> "green"
87
+
| `Blue -> "blue"
88
+
| `Purple -> "purple"
89
+
| `Gray -> "gray"
90
+
91
+
let of_string s =
92
+
match String.lowercase_ascii s with
93
+
| "red" -> Some `Red
94
+
| "orange" -> Some `Orange
95
+
| "yellow" -> Some `Yellow
96
+
| "green" -> Some `Green
97
+
| "blue" -> Some `Blue
98
+
| "purple" -> Some `Purple
99
+
| "gray" | "grey" -> Some `Gray
100
+
| _ -> None
101
+
102
+
let pp ppf color = Format.pp_print_string ppf (to_string color)
+73
ocaml-mail-flag/lib/flag_color.mli
+73
ocaml-mail-flag/lib/flag_color.mli
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Apple Mail flag colors.
7
+
8
+
This module implements the Apple Mail flag color encoding using the
9
+
[$MailFlagBit0], [$MailFlagBit1], and [$MailFlagBit2] keywords.
10
+
11
+
See {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute#section-3}
12
+
draft-ietf-mailmaint-messageflag-mailboxattribute Section 3}.
13
+
14
+
Colors are encoded as a 3-bit pattern where each bit corresponds to
15
+
a keyword:
16
+
- Bit 0: [$MailFlagBit0]
17
+
- Bit 1: [$MailFlagBit1]
18
+
- Bit 2: [$MailFlagBit2]
19
+
20
+
The bit patterns are:
21
+
- Red: 000 (no bits set)
22
+
- Orange: 100 (bit 0 only)
23
+
- Yellow: 010 (bit 1 only)
24
+
- Green: 110 (bits 0 and 1)
25
+
- Blue: 001 (bit 2 only)
26
+
- Purple: 101 (bits 0 and 2)
27
+
- Gray: 011 (bits 1 and 2)
28
+
- 111: undefined (all bits set) *)
29
+
30
+
type t = [
31
+
| `Red (** Bit pattern: 000 *)
32
+
| `Orange (** Bit pattern: 100 *)
33
+
| `Yellow (** Bit pattern: 010 *)
34
+
| `Green (** Bit pattern: 110 *)
35
+
| `Blue (** Bit pattern: 001 *)
36
+
| `Purple (** Bit pattern: 101 *)
37
+
| `Gray (** Bit pattern: 011 *)
38
+
]
39
+
40
+
val to_bits : t -> bool * bool * bool
41
+
(** [to_bits color] converts [color] to a [(bit0, bit1, bit2)] tuple
42
+
representing which [$MailFlagBit*] keywords should be set.
43
+
44
+
Example: [to_bits Green] returns [(true, true, false)]. *)
45
+
46
+
val of_bits : bool * bool * bool -> t option
47
+
(** [of_bits (bit0, bit1, bit2)] converts a bit pattern to a color.
48
+
Returns [None] for the undefined pattern [(true, true, true)] (111). *)
49
+
50
+
val to_keywords : t -> [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list
51
+
(** [to_keywords color] returns the list of keyword bits that should be
52
+
set for [color]. Red returns an empty list since no bits are needed. *)
53
+
54
+
val of_keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
55
+
(** [of_keywords keywords] extracts a color from a list of keyword bits.
56
+
Returns [None] if the pattern is 111 (undefined) or if no bits are
57
+
present in the list (which would indicate no flag color is set,
58
+
rather than Red). Use {!of_keywords_default_red} if you want to
59
+
treat an empty list as Red. *)
60
+
61
+
val of_keywords_default_red : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
62
+
(** [of_keywords_default_red keywords] is like {!of_keywords} but treats
63
+
an empty keyword list as Red. Returns [None] only for pattern 111. *)
64
+
65
+
val pp : Format.formatter -> t -> unit
66
+
(** [pp ppf color] pretty-prints the color name to [ppf]. *)
67
+
68
+
val to_string : t -> string
69
+
(** [to_string color] returns the lowercase color name. *)
70
+
71
+
val of_string : string -> t option
72
+
(** [of_string s] parses a color name (case-insensitive).
73
+
Returns [None] if [s] is not a valid color name. *)
+207
ocaml-mail-flag/lib/keyword.ml
+207
ocaml-mail-flag/lib/keyword.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Implementation of unified message keywords. *)
7
+
8
+
type standard = [
9
+
| `Seen
10
+
| `Answered
11
+
| `Flagged
12
+
| `Draft
13
+
| `Deleted
14
+
| `Forwarded
15
+
]
16
+
17
+
type spam = [
18
+
| `Phishing
19
+
| `Junk
20
+
| `NotJunk
21
+
]
22
+
23
+
type extended = [
24
+
| `HasAttachment
25
+
| `HasNoAttachment
26
+
| `Memo
27
+
| `HasMemo
28
+
| `CanUnsubscribe
29
+
| `Unsubscribed
30
+
| `Muted
31
+
| `Followed
32
+
| `AutoSent
33
+
| `Imported
34
+
| `IsTrusted
35
+
| `MaskedEmail
36
+
| `New
37
+
| `Notify
38
+
]
39
+
40
+
type flag_bit = [
41
+
| `MailFlagBit0
42
+
| `MailFlagBit1
43
+
| `MailFlagBit2
44
+
]
45
+
46
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
47
+
48
+
(** Normalize a keyword string by removing the $ prefix and converting to lowercase. *)
49
+
let normalize s =
50
+
let s = String.lowercase_ascii s in
51
+
if String.length s > 0 && s.[0] = '$' then
52
+
String.sub s 1 (String.length s - 1)
53
+
else if String.length s > 0 && s.[0] = '\\' then
54
+
String.sub s 1 (String.length s - 1)
55
+
else
56
+
s
57
+
58
+
let of_string s =
59
+
match normalize s with
60
+
| "seen" -> `Seen
61
+
| "answered" -> `Answered
62
+
| "flagged" -> `Flagged
63
+
| "draft" -> `Draft
64
+
| "deleted" -> `Deleted
65
+
| "forwarded" -> `Forwarded
66
+
| "phishing" -> `Phishing
67
+
| "junk" -> `Junk
68
+
| "notjunk" -> `NotJunk
69
+
| "hasattachment" -> `HasAttachment
70
+
| "hasnoattachment" -> `HasNoAttachment
71
+
| "memo" -> `Memo
72
+
| "hasmemo" -> `HasMemo
73
+
| "canunsubscribe" -> `CanUnsubscribe
74
+
| "unsubscribed" -> `Unsubscribed
75
+
| "muted" -> `Muted
76
+
| "followed" -> `Followed
77
+
| "autosent" -> `AutoSent
78
+
| "imported" -> `Imported
79
+
| "istrusted" -> `IsTrusted
80
+
| "maskedemail" -> `MaskedEmail
81
+
| "new" -> `New
82
+
| "notify" -> `Notify
83
+
| "mailflagbit0" -> `MailFlagBit0
84
+
| "mailflagbit1" -> `MailFlagBit1
85
+
| "mailflagbit2" -> `MailFlagBit2
86
+
| other -> `Custom other
87
+
88
+
let to_string = function
89
+
| `Seen -> "$seen"
90
+
| `Answered -> "$answered"
91
+
| `Flagged -> "$flagged"
92
+
| `Draft -> "$draft"
93
+
| `Deleted -> "$deleted"
94
+
| `Forwarded -> "$forwarded"
95
+
| `Phishing -> "$phishing"
96
+
| `Junk -> "$junk"
97
+
| `NotJunk -> "$notjunk"
98
+
| `HasAttachment -> "$hasattachment"
99
+
| `HasNoAttachment -> "$hasnoattachment"
100
+
| `Memo -> "$memo"
101
+
| `HasMemo -> "$hasmemo"
102
+
| `CanUnsubscribe -> "$canunsubscribe"
103
+
| `Unsubscribed -> "$unsubscribed"
104
+
| `Muted -> "$muted"
105
+
| `Followed -> "$followed"
106
+
| `AutoSent -> "$autosent"
107
+
| `Imported -> "$imported"
108
+
| `IsTrusted -> "$istrusted"
109
+
| `MaskedEmail -> "$maskedemail"
110
+
| `New -> "$new"
111
+
| `Notify -> "$notify"
112
+
| `MailFlagBit0 -> "$MailFlagBit0"
113
+
| `MailFlagBit1 -> "$MailFlagBit1"
114
+
| `MailFlagBit2 -> "$MailFlagBit2"
115
+
| `Custom s -> s
116
+
117
+
let to_imap_string = function
118
+
(* Standard keywords that map to IMAP system flags *)
119
+
| `Seen -> "\\Seen"
120
+
| `Answered -> "\\Answered"
121
+
| `Flagged -> "\\Flagged"
122
+
| `Draft -> "\\Draft"
123
+
| `Deleted -> "\\Deleted"
124
+
(* Non-system keywords use $ prefix *)
125
+
| `Forwarded -> "$Forwarded"
126
+
| `Phishing -> "$Phishing"
127
+
| `Junk -> "$Junk"
128
+
| `NotJunk -> "$NotJunk"
129
+
| `HasAttachment -> "$HasAttachment"
130
+
| `HasNoAttachment -> "$HasNoAttachment"
131
+
| `Memo -> "$Memo"
132
+
| `HasMemo -> "$HasMemo"
133
+
| `CanUnsubscribe -> "$CanUnsubscribe"
134
+
| `Unsubscribed -> "$Unsubscribed"
135
+
| `Muted -> "$Muted"
136
+
| `Followed -> "$Followed"
137
+
| `AutoSent -> "$AutoSent"
138
+
| `Imported -> "$Imported"
139
+
| `IsTrusted -> "$IsTrusted"
140
+
| `MaskedEmail -> "$MaskedEmail"
141
+
| `New -> "$New"
142
+
| `Notify -> "$Notify"
143
+
| `MailFlagBit0 -> "$MailFlagBit0"
144
+
| `MailFlagBit1 -> "$MailFlagBit1"
145
+
| `MailFlagBit2 -> "$MailFlagBit2"
146
+
| `Custom s ->
147
+
if String.length s > 0 && (s.[0] = '$' || s.[0] = '\\') then s
148
+
else "$" ^ s
149
+
150
+
let is_standard = function
151
+
| `Seen | `Answered | `Flagged | `Draft | `Deleted -> true
152
+
| _ -> false
153
+
154
+
let is_mutually_exclusive k1 k2 =
155
+
match (k1, k2) with
156
+
| (`HasAttachment, `HasNoAttachment) | (`HasNoAttachment, `HasAttachment) -> true
157
+
| (`Junk, `NotJunk) | (`NotJunk, `Junk) -> true
158
+
| (`Muted, `Followed) | (`Followed, `Muted) -> true
159
+
| _ -> false
160
+
161
+
let pp ppf k = Fmt.string ppf (to_string k)
162
+
163
+
let equal k1 k2 =
164
+
match (k1, k2) with
165
+
| (`Custom s1, `Custom s2) -> String.equal (String.lowercase_ascii s1) (String.lowercase_ascii s2)
166
+
| _ -> k1 = k2
167
+
168
+
let compare k1 k2 =
169
+
match (k1, k2) with
170
+
| (`Custom s1, `Custom s2) -> String.compare (String.lowercase_ascii s1) (String.lowercase_ascii s2)
171
+
| (`Custom _, _) -> 1
172
+
| (_, `Custom _) -> -1
173
+
| _ -> Stdlib.compare k1 k2
174
+
175
+
(** Apple Mail flag colors *)
176
+
type flag_color = [
177
+
| `Red
178
+
| `Orange
179
+
| `Yellow
180
+
| `Green
181
+
| `Blue
182
+
| `Purple
183
+
| `Gray
184
+
]
185
+
186
+
let flag_color_of_keywords keywords =
187
+
let has_bit0 = List.exists (fun k -> k = `MailFlagBit0) keywords in
188
+
let has_bit1 = List.exists (fun k -> k = `MailFlagBit1) keywords in
189
+
let has_bit2 = List.exists (fun k -> k = `MailFlagBit2) keywords in
190
+
match (has_bit0, has_bit1, has_bit2) with
191
+
| (false, false, false) -> Some `Red
192
+
| (true, false, false) -> Some `Orange
193
+
| (false, true, false) -> Some `Yellow
194
+
| (true, true, true) -> Some `Green
195
+
| (false, false, true) -> Some `Blue
196
+
| (true, false, true) -> Some `Purple
197
+
| (false, true, true) -> Some `Gray
198
+
| (true, true, false) -> None (* Invalid encoding *)
199
+
200
+
let flag_color_to_keywords = function
201
+
| `Red -> []
202
+
| `Orange -> [`MailFlagBit0]
203
+
| `Yellow -> [`MailFlagBit1]
204
+
| `Green -> [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]
205
+
| `Blue -> [`MailFlagBit2]
206
+
| `Purple -> [`MailFlagBit0; `MailFlagBit2]
207
+
| `Gray -> [`MailFlagBit1; `MailFlagBit2]
+177
ocaml-mail-flag/lib/keyword.mli
+177
ocaml-mail-flag/lib/keyword.mli
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Message Keywords for IMAP and JMAP
7
+
8
+
This module provides a unified representation of message keywords that
9
+
works across both IMAP ({{:https://datatracker.ietf.org/doc/html/rfc9051}RFC 9051})
10
+
and JMAP ({{:https://datatracker.ietf.org/doc/html/rfc8621}RFC 8621}) protocols.
11
+
12
+
{2 Keyword Types}
13
+
14
+
Keywords are organized into categories based on their specification:
15
+
- {!standard}: Core flags from RFC 8621 Section 4.1.1 that map to IMAP system flags
16
+
- {!spam}: Spam-related keywords for junk mail handling
17
+
- {!extended}: Extended keywords from draft-ietf-mailmaint
18
+
- {!flag_bit}: Apple Mail flag color bits
19
+
20
+
{2 Protocol Mapping}
21
+
22
+
IMAP system flags ([\Seen], [\Answered], etc.) map to JMAP keywords
23
+
([$seen], [$answered], etc.). The {!to_string} and {!to_imap_string}
24
+
functions handle these conversions. *)
25
+
26
+
(** {1 Keyword Types} *)
27
+
28
+
(** Standard keywords per {{:https://datatracker.ietf.org/doc/html/rfc8621#section-4.1.1}RFC 8621 Section 4.1.1}.
29
+
30
+
These keywords have direct mappings to IMAP system flags defined in
31
+
{{:https://datatracker.ietf.org/doc/html/rfc9051#section-2.3.2}RFC 9051 Section 2.3.2}. *)
32
+
type standard = [
33
+
| `Seen (** Message has been read. Maps to IMAP [\Seen]. *)
34
+
| `Answered (** Message has been answered. Maps to IMAP [\Answered]. *)
35
+
| `Flagged (** Message is flagged/starred. Maps to IMAP [\Flagged]. *)
36
+
| `Draft (** Message is a draft. Maps to IMAP [\Draft]. *)
37
+
| `Deleted (** Message marked for deletion. IMAP only, maps to [\Deleted]. *)
38
+
| `Forwarded (** Message has been forwarded. JMAP [$forwarded] keyword. *)
39
+
]
40
+
41
+
(** Spam-related keywords for junk mail handling.
42
+
43
+
These keywords help mail clients and servers coordinate spam filtering
44
+
decisions across protocol boundaries. *)
45
+
type spam = [
46
+
| `Phishing (** Message is a phishing attempt. JMAP [$phishing]. *)
47
+
| `Junk (** Message is spam/junk. JMAP [$junk]. *)
48
+
| `NotJunk (** Message explicitly marked as not junk. JMAP [$notjunk]. *)
49
+
]
50
+
51
+
(** Extended keywords per draft-ietf-mailmaint.
52
+
53
+
These keywords provide additional metadata for enhanced mail client features
54
+
beyond basic read/reply tracking. *)
55
+
type extended = [
56
+
| `HasAttachment (** Message has attachments. *)
57
+
| `HasNoAttachment (** Message has no attachments. Mutually exclusive with [`HasAttachment]. *)
58
+
| `Memo (** Message is a memo. *)
59
+
| `HasMemo (** Message has an associated memo. *)
60
+
| `CanUnsubscribe (** Message has unsubscribe capability (List-Unsubscribe header). *)
61
+
| `Unsubscribed (** User has unsubscribed from this sender. *)
62
+
| `Muted (** Thread is muted. Mutually exclusive with [`Followed]. *)
63
+
| `Followed (** Thread is followed. Mutually exclusive with [`Muted]. *)
64
+
| `AutoSent (** Message was sent automatically. *)
65
+
| `Imported (** Message was imported from another source. *)
66
+
| `IsTrusted (** Sender is trusted. *)
67
+
| `MaskedEmail (** Message was sent to a masked email address. *)
68
+
| `New (** Message is new (not yet processed by client). *)
69
+
| `Notify (** User should be notified about this message. *)
70
+
]
71
+
72
+
(** Apple Mail flag color bits.
73
+
74
+
Apple Mail uses a 3-bit encoding for flag colors. The color is determined
75
+
by the combination of bits set. See {!flag_color_of_keywords} for the
76
+
mapping. *)
77
+
type flag_bit = [
78
+
| `MailFlagBit0 (** Bit 0 of Apple Mail flag color encoding. *)
79
+
| `MailFlagBit1 (** Bit 1 of Apple Mail flag color encoding. *)
80
+
| `MailFlagBit2 (** Bit 2 of Apple Mail flag color encoding. *)
81
+
]
82
+
83
+
(** Unified keyword type combining all keyword categories.
84
+
85
+
Use [`Custom s] for server-specific or application-specific keywords
86
+
not covered by the standard categories. *)
87
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
88
+
89
+
(** {1 Conversion Functions} *)
90
+
91
+
val of_string : string -> t
92
+
(** [of_string s] parses a keyword string.
93
+
94
+
Handles both JMAP format ([$seen]) and bare format ([seen]).
95
+
Parsing is case-insensitive for known keywords.
96
+
97
+
Examples:
98
+
- ["$seen"] -> [`Seen]
99
+
- ["seen"] -> [`Seen]
100
+
- ["SEEN"] -> [`Seen]
101
+
- ["\\Seen"] -> [`Seen] (IMAP system flag format)
102
+
- ["my-custom-flag"] -> [`Custom "my-custom-flag"] *)
103
+
104
+
val to_string : t -> string
105
+
(** [to_string k] converts a keyword to canonical JMAP format.
106
+
107
+
Standard and extended keywords are returned with [$] prefix in lowercase.
108
+
Apple Mail flag bits preserve their mixed case.
109
+
Custom keywords are returned as-is.
110
+
111
+
Examples:
112
+
- [`Seen] -> ["$seen"]
113
+
- [`MailFlagBit0] -> ["$MailFlagBit0"]
114
+
- [`Custom "foo"] -> ["foo"] *)
115
+
116
+
val to_imap_string : t -> string
117
+
(** [to_imap_string k] converts a keyword to IMAP format.
118
+
119
+
Standard keywords that map to IMAP system flags use backslash prefix.
120
+
Other keywords use [$] prefix with appropriate casing.
121
+
122
+
Examples:
123
+
- [`Seen] -> ["\\Seen"]
124
+
- [`Deleted] -> ["\\Deleted"]
125
+
- [`Forwarded] -> ["$Forwarded"]
126
+
- [`MailFlagBit0] -> ["$MailFlagBit0"] *)
127
+
128
+
(** {1 Predicates} *)
129
+
130
+
val is_standard : t -> bool
131
+
(** [is_standard k] returns [true] if [k] maps to an IMAP system flag.
132
+
133
+
The standard keywords are: [`Seen], [`Answered], [`Flagged], [`Draft],
134
+
and [`Deleted]. Note that [`Forwarded] is {i not} an IMAP system flag. *)
135
+
136
+
val is_mutually_exclusive : t -> t -> bool
137
+
(** [is_mutually_exclusive k1 k2] returns [true] if keywords [k1] and [k2]
138
+
cannot both be set on the same message.
139
+
140
+
Mutually exclusive pairs:
141
+
- [`HasAttachment] and [`HasNoAttachment]
142
+
- [`Junk] and [`NotJunk]
143
+
- [`Muted] and [`Followed] *)
144
+
145
+
(** {1 Pretty Printing} *)
146
+
147
+
val pp : Format.formatter -> t -> unit
148
+
(** [pp ppf k] pretty-prints keyword [k] in JMAP format. *)
149
+
150
+
val equal : t -> t -> bool
151
+
(** [equal k1 k2] tests equality of keywords. *)
152
+
153
+
val compare : t -> t -> int
154
+
(** [compare k1 k2] provides total ordering on keywords. *)
155
+
156
+
(** {1 Apple Mail Flag Colors} *)
157
+
158
+
(** Apple Mail flag colors encoded as 3-bit values. *)
159
+
type flag_color = [
160
+
| `Red (** No bits set *)
161
+
| `Orange (** Bit 0 only *)
162
+
| `Yellow (** Bit 1 only *)
163
+
| `Green (** All bits set *)
164
+
| `Blue (** Bit 2 only *)
165
+
| `Purple (** Bits 0 and 2 *)
166
+
| `Gray (** Bits 1 and 2 *)
167
+
]
168
+
169
+
val flag_color_of_keywords : t list -> flag_color option
170
+
(** [flag_color_of_keywords keywords] extracts the Apple Mail flag color
171
+
from a list of keywords.
172
+
173
+
Returns [None] if bits 0 and 1 are set but not bit 2 (invalid encoding). *)
174
+
175
+
val flag_color_to_keywords : flag_color -> t list
176
+
(** [flag_color_to_keywords color] returns the keyword bits needed to
177
+
represent the given flag color. *)
+46
ocaml-mail-flag/lib/mail_flag.ml
+46
ocaml-mail-flag/lib/mail_flag.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mail Flags for IMAP and JMAP
7
+
8
+
This library provides a unified representation of message flags and mailbox
9
+
attributes that works across both IMAP (RFC 9051) and JMAP (RFC 8621) protocols.
10
+
11
+
The core types use polymorphic variants for type safety and extensibility. *)
12
+
13
+
(** {1 Module Aliases} *)
14
+
15
+
module Keyword = Keyword
16
+
module Mailbox_attr = Mailbox_attr
17
+
module Flag_color = Flag_color
18
+
19
+
(** {1 Type Aliases} *)
20
+
21
+
(** Standard message keywords that map to IMAP system flags. *)
22
+
type standard = Keyword.standard
23
+
24
+
(** Spam-related keywords for junk mail handling. *)
25
+
type spam = Keyword.spam
26
+
27
+
(** Extended keywords from draft-ietf-mailmaint. *)
28
+
type extended = Keyword.extended
29
+
30
+
(** Apple Mail flag color bit keywords. *)
31
+
type flag_bit = Keyword.flag_bit
32
+
33
+
(** Unified message keyword type combining all categories. *)
34
+
type keyword = Keyword.t
35
+
36
+
(** IMAP LIST response attributes. *)
37
+
type list_attr = Mailbox_attr.list_attr
38
+
39
+
(** Special-use mailbox roles. *)
40
+
type special_use = Mailbox_attr.special_use
41
+
42
+
(** Unified mailbox attribute type. *)
43
+
type mailbox_attr = Mailbox_attr.t
44
+
45
+
(** Apple Mail flag colors. *)
46
+
type flag_color = Flag_color.t
+286
ocaml-mail-flag/lib/mail_flag.mli
+286
ocaml-mail-flag/lib/mail_flag.mli
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mail Flags for IMAP and JMAP
7
+
8
+
This library provides a unified representation of message flags and mailbox
9
+
attributes that works across both IMAP
10
+
({{:https://datatracker.ietf.org/doc/html/rfc9051}RFC 9051}) and JMAP
11
+
({{:https://datatracker.ietf.org/doc/html/rfc8621}RFC 8621}) protocols.
12
+
13
+
{2 Overview}
14
+
15
+
The library defines three main concepts:
16
+
17
+
- {!Keyword}: Message keywords/flags like [`Seen], [`Flagged], [`Junk]
18
+
- {!Mailbox_attr}: Mailbox attributes and special-use roles like [`Drafts], [`Inbox]
19
+
- {!Flag_color}: Apple Mail flag color encoding
20
+
21
+
All types use polymorphic variants for:
22
+
- Type safety: The compiler catches invalid flag combinations
23
+
- Extensibility: Custom flags via [`Custom] and [`Extension] variants
24
+
- Interoperability: Easy conversion between protocol representations
25
+
26
+
{2 Protocol Mapping}
27
+
28
+
{b IMAP system flags} ([\Seen], [\Answered], etc.) map to {!standard} keywords.
29
+
Use {!Keyword.to_imap_string} for wire format conversion.
30
+
31
+
{b JMAP keywords} ([$seen], [$answered], etc.) are the canonical form.
32
+
Use {!Keyword.to_string} for JMAP format.
33
+
34
+
{b Mailbox roles} work similarly with {!Mailbox_attr.to_string} for IMAP
35
+
and {!Mailbox_attr.to_jmap_role} for JMAP.
36
+
37
+
{2 References}
38
+
39
+
- {{:https://www.rfc-editor.org/rfc/rfc9051}RFC 9051} - IMAP4rev2
40
+
- {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621} - JMAP for Mail
41
+
- {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154} - IMAP Special-Use Mailboxes
42
+
- {{:https://datatracker.ietf.org/doc/draft-ietf-mailmaint-messageflag-mailboxattribute}
43
+
draft-ietf-mailmaint} - Extended keywords and attributes *)
44
+
45
+
(** {1 Modules} *)
46
+
47
+
(** Message keywords for both IMAP and JMAP.
48
+
49
+
See {!module:Keyword} for the full API. *)
50
+
module Keyword : sig
51
+
(** {1 Keyword Types} *)
52
+
53
+
(** Standard keywords per RFC 8621 Section 4.1.1 that map to IMAP system flags. *)
54
+
type standard = [
55
+
| `Seen (** Message has been read. Maps to IMAP [\Seen]. *)
56
+
| `Answered (** Message has been answered. Maps to IMAP [\Answered]. *)
57
+
| `Flagged (** Message is flagged/starred. Maps to IMAP [\Flagged]. *)
58
+
| `Draft (** Message is a draft. Maps to IMAP [\Draft]. *)
59
+
| `Deleted (** Message marked for deletion. Maps to IMAP [\Deleted]. *)
60
+
| `Forwarded (** Message has been forwarded. JMAP [$forwarded]. *)
61
+
]
62
+
63
+
(** Spam-related keywords for junk mail handling. *)
64
+
type spam = [
65
+
| `Phishing (** Message is a phishing attempt. *)
66
+
| `Junk (** Message is spam/junk. *)
67
+
| `NotJunk (** Message explicitly marked as not junk. *)
68
+
]
69
+
70
+
(** Extended keywords per draft-ietf-mailmaint. *)
71
+
type extended = [
72
+
| `HasAttachment (** Message has attachments. *)
73
+
| `HasNoAttachment (** Message has no attachments. *)
74
+
| `Memo (** Message is a memo. *)
75
+
| `HasMemo (** Message has an associated memo. *)
76
+
| `CanUnsubscribe (** Message has unsubscribe capability. *)
77
+
| `Unsubscribed (** User has unsubscribed from this sender. *)
78
+
| `Muted (** Thread is muted. *)
79
+
| `Followed (** Thread is followed. *)
80
+
| `AutoSent (** Message was sent automatically. *)
81
+
| `Imported (** Message was imported from another source. *)
82
+
| `IsTrusted (** Sender is trusted. *)
83
+
| `MaskedEmail (** Message was sent to a masked email address. *)
84
+
| `New (** Message is new (not yet processed). *)
85
+
| `Notify (** User should be notified about this message. *)
86
+
]
87
+
88
+
(** Apple Mail flag color bits. *)
89
+
type flag_bit = [
90
+
| `MailFlagBit0 (** Bit 0 of Apple Mail flag color encoding. *)
91
+
| `MailFlagBit1 (** Bit 1 of Apple Mail flag color encoding. *)
92
+
| `MailFlagBit2 (** Bit 2 of Apple Mail flag color encoding. *)
93
+
]
94
+
95
+
(** Unified keyword type combining all categories. *)
96
+
type t = [ standard | spam | extended | flag_bit | `Custom of string ]
97
+
98
+
(** {1 Conversion Functions} *)
99
+
100
+
val of_string : string -> t
101
+
(** [of_string s] parses a keyword string.
102
+
Handles JMAP format ([$seen]), IMAP format ([\Seen]), and bare format ([seen]).
103
+
Unknown keywords become [`Custom]. *)
104
+
105
+
val to_string : t -> string
106
+
(** [to_string k] converts a keyword to canonical JMAP format (e.g., ["$seen"]). *)
107
+
108
+
val to_imap_string : t -> string
109
+
(** [to_imap_string k] converts a keyword to IMAP wire format.
110
+
Standard keywords use backslash ([\Seen]), others use dollar ([$Forwarded]). *)
111
+
112
+
(** {1 Predicates} *)
113
+
114
+
val is_standard : t -> bool
115
+
(** [is_standard k] returns [true] if [k] maps to an IMAP system flag. *)
116
+
117
+
val is_mutually_exclusive : t -> t -> bool
118
+
(** [is_mutually_exclusive k1 k2] returns [true] if keywords cannot both be set.
119
+
Mutually exclusive pairs: HasAttachment/HasNoAttachment, Junk/NotJunk, Muted/Followed. *)
120
+
121
+
(** {1 Comparison and Pretty Printing} *)
122
+
123
+
val equal : t -> t -> bool
124
+
val compare : t -> t -> int
125
+
val pp : Format.formatter -> t -> unit
126
+
127
+
(** {1 Apple Mail Flag Colors} *)
128
+
129
+
type flag_color = [
130
+
| `Red | `Orange | `Yellow | `Green | `Blue | `Purple | `Gray
131
+
]
132
+
133
+
val flag_color_of_keywords : t list -> flag_color option
134
+
(** Extract Apple Mail flag color from keywords. Returns [None] for invalid encoding. *)
135
+
136
+
val flag_color_to_keywords : flag_color -> t list
137
+
(** Convert flag color to the keyword bits needed to represent it. *)
138
+
end
139
+
140
+
(** Mailbox attributes and special-use roles.
141
+
142
+
See {!module:Mailbox_attr} for the full API. *)
143
+
module Mailbox_attr : sig
144
+
(** {1 Attribute Types} *)
145
+
146
+
(** IMAP LIST response attributes per RFC 9051 Section 7.2.2. *)
147
+
type list_attr = [
148
+
| `Noinferiors (** No child mailboxes possible. *)
149
+
| `Noselect (** Mailbox cannot be selected. *)
150
+
| `Marked (** Mailbox has new messages. *)
151
+
| `Unmarked (** Mailbox has no new messages. *)
152
+
| `Subscribed (** Mailbox is subscribed. *)
153
+
| `HasChildren (** Mailbox has child mailboxes. *)
154
+
| `HasNoChildren (** Mailbox has no children. *)
155
+
| `NonExistent (** Mailbox does not exist. *)
156
+
| `Remote (** Mailbox is on a remote server. *)
157
+
]
158
+
159
+
(** Special-use mailbox roles per RFC 6154 and RFC 8621. *)
160
+
type special_use = [
161
+
| `All (** Virtual mailbox with all messages. *)
162
+
| `Archive (** Archive mailbox. *)
163
+
| `Drafts (** Drafts mailbox. *)
164
+
| `Flagged (** Virtual mailbox with flagged messages. *)
165
+
| `Important (** Important messages mailbox. *)
166
+
| `Inbox (** User's inbox. *)
167
+
| `Junk (** Spam/junk mailbox. *)
168
+
| `Sent (** Sent messages mailbox. *)
169
+
| `Subscribed (** JMAP virtual subscribed mailbox. *)
170
+
| `Trash (** Trash/deleted messages mailbox. *)
171
+
| `Snoozed (** Snoozed messages (draft-ietf-mailmaint). *)
172
+
| `Scheduled (** Scheduled to send (draft-ietf-mailmaint). *)
173
+
| `Memos (** Memo messages (draft-ietf-mailmaint). *)
174
+
]
175
+
176
+
(** Unified mailbox attribute type. *)
177
+
type t = [ list_attr | special_use | `Extension of string ]
178
+
179
+
(** {1 Conversion Functions} *)
180
+
181
+
val of_string : string -> t
182
+
(** [of_string s] parses a mailbox attribute from IMAP wire format.
183
+
Unknown attributes become [`Extension]. *)
184
+
185
+
val to_string : t -> string
186
+
(** [to_string attr] converts to IMAP wire format with backslash prefix. *)
187
+
188
+
val to_jmap_role : t -> string option
189
+
(** [to_jmap_role attr] converts to JMAP role string (lowercase).
190
+
Returns [None] for LIST attributes without JMAP equivalents. *)
191
+
192
+
val of_jmap_role : string -> special_use option
193
+
(** [of_jmap_role s] parses a JMAP role string into a special-use attribute. *)
194
+
195
+
(** {1 Predicates} *)
196
+
197
+
val is_special_use : t -> bool
198
+
(** [is_special_use attr] returns [true] if attribute is a special-use role. *)
199
+
200
+
val is_selectable : t -> bool
201
+
(** [is_selectable attr] returns [false] for Noselect and NonExistent. *)
202
+
203
+
(** {1 Pretty Printing} *)
204
+
205
+
val pp : Format.formatter -> t -> unit
206
+
end
207
+
208
+
(** Apple Mail flag colors.
209
+
210
+
See {!module:Flag_color} for the full API. *)
211
+
module Flag_color : sig
212
+
(** Flag colors encoded as 3-bit values using [$MailFlagBit*] keywords. *)
213
+
type t = [
214
+
| `Red (** Bit pattern: 000 *)
215
+
| `Orange (** Bit pattern: 100 *)
216
+
| `Yellow (** Bit pattern: 010 *)
217
+
| `Green (** Bit pattern: 110 *)
218
+
| `Blue (** Bit pattern: 001 *)
219
+
| `Purple (** Bit pattern: 101 *)
220
+
| `Gray (** Bit pattern: 011 *)
221
+
]
222
+
223
+
(** {1 Bit Pattern Conversion} *)
224
+
225
+
val to_bits : t -> bool * bool * bool
226
+
(** [to_bits color] returns [(bit0, bit1, bit2)] tuple. *)
227
+
228
+
val of_bits : bool * bool * bool -> t option
229
+
(** [of_bits (b0, b1, b2)] converts bit pattern to color.
230
+
Returns [None] for undefined pattern (true, true, true). *)
231
+
232
+
(** {1 Keyword Conversion} *)
233
+
234
+
val to_keywords : t -> [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list
235
+
(** [to_keywords color] returns keyword bits for the color. *)
236
+
237
+
val of_keywords : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
238
+
(** [of_keywords kws] extracts color from keyword bits.
239
+
Returns [None] if no bits set (ambiguous) or pattern is 111 (undefined). *)
240
+
241
+
val of_keywords_default_red : [ `MailFlagBit0 | `MailFlagBit1 | `MailFlagBit2 ] list -> t option
242
+
(** Like {!of_keywords} but treats empty list as Red. *)
243
+
244
+
(** {1 String Conversion} *)
245
+
246
+
val to_string : t -> string
247
+
(** [to_string color] returns lowercase color name. *)
248
+
249
+
val of_string : string -> t option
250
+
(** [of_string s] parses color name (case-insensitive, accepts "grey"). *)
251
+
252
+
(** {1 Pretty Printing} *)
253
+
254
+
val pp : Format.formatter -> t -> unit
255
+
end
256
+
257
+
(** {1 Type Aliases}
258
+
259
+
Convenient type aliases for use without module qualification. *)
260
+
261
+
(** Standard message keywords that map to IMAP system flags. *)
262
+
type standard = Keyword.standard
263
+
264
+
(** Spam-related keywords. *)
265
+
type spam = Keyword.spam
266
+
267
+
(** Extended keywords from draft-ietf-mailmaint. *)
268
+
type extended = Keyword.extended
269
+
270
+
(** Apple Mail flag color bit keywords. *)
271
+
type flag_bit = Keyword.flag_bit
272
+
273
+
(** Unified message keyword type. *)
274
+
type keyword = Keyword.t
275
+
276
+
(** IMAP LIST response attributes. *)
277
+
type list_attr = Mailbox_attr.list_attr
278
+
279
+
(** Special-use mailbox roles. *)
280
+
type special_use = Mailbox_attr.special_use
281
+
282
+
(** Unified mailbox attribute type. *)
283
+
type mailbox_attr = Mailbox_attr.t
284
+
285
+
(** Apple Mail flag colors. *)
286
+
type flag_color = Flag_color.t
+149
ocaml-mail-flag/lib/mailbox_attr.ml
+149
ocaml-mail-flag/lib/mailbox_attr.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Implementation of unified mailbox attributes and roles. *)
7
+
8
+
type list_attr = [
9
+
| `Noinferiors
10
+
| `Noselect
11
+
| `Marked
12
+
| `Unmarked
13
+
| `Subscribed
14
+
| `HasChildren
15
+
| `HasNoChildren
16
+
| `NonExistent
17
+
| `Remote
18
+
]
19
+
20
+
type special_use = [
21
+
| `All
22
+
| `Archive
23
+
| `Drafts
24
+
| `Flagged
25
+
| `Important
26
+
| `Inbox
27
+
| `Junk
28
+
| `Sent
29
+
| `Subscribed
30
+
| `Trash
31
+
| `Snoozed
32
+
| `Scheduled
33
+
| `Memos
34
+
]
35
+
36
+
type t = [ list_attr | special_use | `Extension of string ]
37
+
38
+
(** Normalize attribute string by removing backslash prefix and converting to lowercase. *)
39
+
let normalize s =
40
+
let s = String.lowercase_ascii s in
41
+
if String.length s > 0 && s.[0] = '\\' then
42
+
String.sub s 1 (String.length s - 1)
43
+
else
44
+
s
45
+
46
+
let of_string s =
47
+
match normalize s with
48
+
(* LIST attributes *)
49
+
| "noinferiors" -> `Noinferiors
50
+
| "noselect" -> `Noselect
51
+
| "marked" -> `Marked
52
+
| "unmarked" -> `Unmarked
53
+
| "subscribed" -> `Subscribed
54
+
| "haschildren" -> `HasChildren
55
+
| "hasnochildren" -> `HasNoChildren
56
+
| "nonexistent" -> `NonExistent
57
+
| "remote" -> `Remote
58
+
(* Special-use roles *)
59
+
| "all" -> `All
60
+
| "archive" -> `Archive
61
+
| "drafts" -> `Drafts
62
+
| "flagged" -> `Flagged
63
+
| "important" -> `Important
64
+
| "inbox" -> `Inbox
65
+
| "junk" | "spam" -> `Junk
66
+
| "sent" -> `Sent
67
+
| "trash" -> `Trash
68
+
| "snoozed" -> `Snoozed
69
+
| "scheduled" -> `Scheduled
70
+
| "memos" -> `Memos
71
+
| other -> `Extension other
72
+
73
+
let to_string = function
74
+
(* LIST attributes *)
75
+
| `Noinferiors -> "\\Noinferiors"
76
+
| `Noselect -> "\\Noselect"
77
+
| `Marked -> "\\Marked"
78
+
| `Unmarked -> "\\Unmarked"
79
+
| `Subscribed -> "\\Subscribed"
80
+
| `HasChildren -> "\\HasChildren"
81
+
| `HasNoChildren -> "\\HasNoChildren"
82
+
| `NonExistent -> "\\NonExistent"
83
+
| `Remote -> "\\Remote"
84
+
(* Special-use roles *)
85
+
| `All -> "\\All"
86
+
| `Archive -> "\\Archive"
87
+
| `Drafts -> "\\Drafts"
88
+
| `Flagged -> "\\Flagged"
89
+
| `Important -> "\\Important"
90
+
| `Inbox -> "\\Inbox"
91
+
| `Junk -> "\\Junk"
92
+
| `Sent -> "\\Sent"
93
+
| `Trash -> "\\Trash"
94
+
| `Snoozed -> "\\Snoozed"
95
+
| `Scheduled -> "\\Scheduled"
96
+
| `Memos -> "\\Memos"
97
+
| `Extension s ->
98
+
if String.length s > 0 && s.[0] = '\\' then s
99
+
else "\\" ^ s
100
+
101
+
let to_jmap_role = function
102
+
(* Special-use roles have JMAP equivalents *)
103
+
| `All -> Some "all"
104
+
| `Archive -> Some "archive"
105
+
| `Drafts -> Some "drafts"
106
+
| `Flagged -> Some "flagged"
107
+
| `Important -> Some "important"
108
+
| `Inbox -> Some "inbox"
109
+
| `Junk -> Some "junk"
110
+
| `Sent -> Some "sent"
111
+
| `Trash -> Some "trash"
112
+
| `Snoozed -> Some "snoozed"
113
+
| `Scheduled -> Some "scheduled"
114
+
| `Memos -> Some "memos"
115
+
(* LIST attributes and extensions have no JMAP role *)
116
+
| `Noinferiors | `Noselect | `Marked | `Unmarked | `Subscribed
117
+
| `HasChildren | `HasNoChildren | `NonExistent | `Remote
118
+
| `Extension _ -> None
119
+
120
+
let of_jmap_role s =
121
+
match String.lowercase_ascii s with
122
+
| "all" -> Some `All
123
+
| "archive" -> Some `Archive
124
+
| "drafts" -> Some `Drafts
125
+
| "flagged" -> Some `Flagged
126
+
| "important" -> Some `Important
127
+
| "inbox" -> Some `Inbox
128
+
| "junk" -> Some `Junk
129
+
| "sent" -> Some `Sent
130
+
| "trash" -> Some `Trash
131
+
| "snoozed" -> Some `Snoozed
132
+
| "scheduled" -> Some `Scheduled
133
+
| "memos" -> Some `Memos
134
+
| "subscribed" -> Some `Subscribed
135
+
| _ -> None
136
+
137
+
let is_special_use = function
138
+
| `All | `Archive | `Drafts | `Flagged | `Important | `Inbox
139
+
| `Junk | `Sent | `Trash | `Snoozed | `Scheduled | `Memos -> true
140
+
| `Subscribed -> true (* Also a JMAP role *)
141
+
| `Noinferiors | `Noselect | `Marked | `Unmarked
142
+
| `HasChildren | `HasNoChildren | `NonExistent | `Remote
143
+
| `Extension _ -> false
144
+
145
+
let is_selectable = function
146
+
| `Noselect | `NonExistent -> false
147
+
| _ -> true
148
+
149
+
let pp ppf attr = Fmt.string ppf (to_string attr)
+188
ocaml-mail-flag/lib/mailbox_attr.mli
+188
ocaml-mail-flag/lib/mailbox_attr.mli
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Unified Mailbox Attributes and Roles
7
+
8
+
This module provides a unified representation of mailbox attributes
9
+
across IMAP and JMAP protocols. It combines IMAP LIST response attributes
10
+
({{:https://www.rfc-editor.org/rfc/rfc9051#section-7.2.2}RFC 9051 Section 7.2.2}),
11
+
special-use mailbox flags ({{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154}),
12
+
and JMAP mailbox roles ({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}).
13
+
14
+
{2 References}
15
+
- {{:https://www.rfc-editor.org/rfc/rfc9051}RFC 9051} - IMAP4rev2
16
+
- {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154} - IMAP LIST Extension for Special-Use Mailboxes
17
+
- {{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258} - IMAP4 LIST Command Extensions
18
+
- {{:https://www.rfc-editor.org/rfc/rfc8457}RFC 8457} - IMAP \$Important Keyword and \Important Special-Use Attribute
19
+
- {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621} - JMAP for Mail *)
20
+
21
+
(** {1 IMAP LIST Attributes}
22
+
23
+
Attributes returned in IMAP LIST responses per
24
+
{{:https://www.rfc-editor.org/rfc/rfc9051#section-7.2.2}RFC 9051 Section 7.2.2}. *)
25
+
26
+
type list_attr = [
27
+
| `Noinferiors
28
+
(** [\Noinferiors] - No child mailboxes are possible under this mailbox.
29
+
The mailbox cannot have inferior (child) mailboxes, either because the
30
+
underlying storage doesn't support it or because the mailbox name is at
31
+
the hierarchy depth limit for this mailbox store. *)
32
+
| `Noselect
33
+
(** [\Noselect] - This mailbox cannot be selected. It exists only to hold
34
+
child mailboxes and is not a valid destination for messages. Stratum
35
+
only, not a real mailbox. *)
36
+
| `Marked
37
+
(** [\Marked] - The mailbox has been marked "interesting" by the server.
38
+
This typically indicates the mailbox contains new messages since the
39
+
last time it was selected. *)
40
+
| `Unmarked
41
+
(** [\Unmarked] - The mailbox is not "interesting". The mailbox does not
42
+
contain new messages since the last time it was selected. *)
43
+
| `Subscribed
44
+
(** [\Subscribed] - The mailbox is subscribed. Returned when the
45
+
SUBSCRIBED selection option is specified or implied. *)
46
+
| `HasChildren
47
+
(** [\HasChildren] - The mailbox has child mailboxes. Part of the
48
+
CHILDREN return option ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}). *)
49
+
| `HasNoChildren
50
+
(** [\HasNoChildren] - The mailbox has no child mailboxes. Part of the
51
+
CHILDREN return option ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}). *)
52
+
| `NonExistent
53
+
(** [\NonExistent] - The mailbox name does not refer to an existing mailbox.
54
+
This attribute is returned when a mailbox is part of the hierarchy but
55
+
doesn't actually exist ({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}).
56
+
Implies [\Noselect]. *)
57
+
| `Remote
58
+
(** [\Remote] - The mailbox is located on a remote server.
59
+
({{:https://www.rfc-editor.org/rfc/rfc5258}RFC 5258}) *)
60
+
]
61
+
62
+
(** {1 Special-Use Roles}
63
+
64
+
Special-use mailbox roles per {{:https://www.rfc-editor.org/rfc/rfc6154}RFC 6154}
65
+
and {{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}. These identify
66
+
mailboxes with specific purposes. *)
67
+
68
+
type special_use = [
69
+
| `All
70
+
(** [\All] - A virtual mailbox containing all messages in the user's
71
+
message store. Implementations may omit some messages. *)
72
+
| `Archive
73
+
(** [\Archive] - A mailbox used to archive messages. The meaning of
74
+
"archived" may vary by server. *)
75
+
| `Drafts
76
+
(** [\Drafts] - A mailbox used to hold draft messages, typically messages
77
+
being composed but not yet sent. *)
78
+
| `Flagged
79
+
(** [\Flagged] - A virtual mailbox containing all messages marked with
80
+
the [\Flagged] flag. *)
81
+
| `Important
82
+
(** [\Important] - A mailbox used to hold messages deemed important to
83
+
the user. ({{:https://www.rfc-editor.org/rfc/rfc8457}RFC 8457}) *)
84
+
| `Inbox
85
+
(** [inbox] - The user's inbox. This is a JMAP role
86
+
({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}) without a direct
87
+
IMAP special-use equivalent since INBOX is always special in IMAP. *)
88
+
| `Junk
89
+
(** [\Junk] - A mailbox used to hold messages that have been identified
90
+
as spam or junk mail. Also known as "Spam" folder. *)
91
+
| `Sent
92
+
(** [\Sent] - A mailbox used to hold copies of messages that have been
93
+
sent. *)
94
+
| `Subscribed
95
+
(** [subscribed] - A JMAP virtual mailbox role
96
+
({{:https://www.rfc-editor.org/rfc/rfc8621}RFC 8621}) representing
97
+
all subscribed mailboxes. *)
98
+
| `Trash
99
+
(** [\Trash] - A mailbox used to hold messages that have been deleted or
100
+
marked for deletion. *)
101
+
| `Snoozed
102
+
(** [snoozed] - A mailbox for messages that have been snoozed until a
103
+
later time. (draft-ietf-mailmaint-special-use-extensions) *)
104
+
| `Scheduled
105
+
(** [scheduled] - A mailbox for messages scheduled to be sent at a
106
+
future time. (draft-ietf-mailmaint-special-use-extensions) *)
107
+
| `Memos
108
+
(** [memos] - A mailbox for memo/note messages.
109
+
(draft-ietf-mailmaint-special-use-extensions) *)
110
+
]
111
+
112
+
(** {1 Unified Attribute Type} *)
113
+
114
+
type t = [ list_attr | special_use | `Extension of string ]
115
+
(** The unified mailbox attribute type combining LIST attributes, special-use
116
+
roles, and server-specific extensions. Extensions are represented with
117
+
their original string form (without leading backslash if present). *)
118
+
119
+
(** {1 Conversion Functions} *)
120
+
121
+
val of_string : string -> t
122
+
(** [of_string s] parses a mailbox attribute from its IMAP wire format.
123
+
The input may optionally include the leading backslash. Parsing is
124
+
case-insensitive. Unknown attributes are returned as [`Extension s].
125
+
126
+
Examples:
127
+
- [of_string "\\Drafts"] returns [`Drafts]
128
+
- [of_string "drafts"] returns [`Drafts]
129
+
- [of_string "\\X-Custom"] returns [`Extension "X-Custom"] *)
130
+
131
+
val to_string : t -> string
132
+
(** [to_string attr] converts an attribute to its IMAP wire format with
133
+
the leading backslash prefix for standard attributes.
134
+
135
+
Examples:
136
+
- [to_string `Drafts] returns ["\\Drafts"]
137
+
- [to_string `HasChildren] returns ["\\HasChildren"]
138
+
- [to_string (`Extension "X-Custom")] returns ["\\X-Custom"] *)
139
+
140
+
val to_jmap_role : t -> string option
141
+
(** [to_jmap_role attr] converts a special-use attribute to its JMAP role
142
+
string (lowercase). Returns [None] for LIST attributes that don't
143
+
correspond to JMAP roles.
144
+
145
+
Examples:
146
+
- [to_jmap_role `Drafts] returns [Some "drafts"]
147
+
- [to_jmap_role `Inbox] returns [Some "inbox"]
148
+
- [to_jmap_role `Noselect] returns [None] *)
149
+
150
+
val of_jmap_role : string -> special_use option
151
+
(** [of_jmap_role s] parses a JMAP role string into a special-use attribute.
152
+
Returns [None] if the role string is not recognized. The input should
153
+
be lowercase as per JMAP conventions.
154
+
155
+
Examples:
156
+
- [of_jmap_role "drafts"] returns [Some `Drafts]
157
+
- [of_jmap_role "inbox"] returns [Some `Inbox]
158
+
- [of_jmap_role "unknown"] returns [None] *)
159
+
160
+
(** {1 Predicates} *)
161
+
162
+
val is_special_use : t -> bool
163
+
(** [is_special_use attr] returns [true] if the attribute is a special-use
164
+
role (as opposed to a LIST attribute or extension).
165
+
166
+
Examples:
167
+
- [is_special_use `Drafts] returns [true]
168
+
- [is_special_use `Noselect] returns [false]
169
+
- [is_special_use (`Extension "x")] returns [false] *)
170
+
171
+
val is_selectable : t -> bool
172
+
(** [is_selectable attr] returns [false] if the attribute indicates the
173
+
mailbox cannot be selected. This is [true] for [`Noselect] and
174
+
[`NonExistent] attributes, and [false] for all others.
175
+
176
+
Note: A mailbox may have multiple attributes. To determine if a mailbox
177
+
is selectable, check that no attribute returns [false] from this function.
178
+
179
+
Examples:
180
+
- [is_selectable `Noselect] returns [false]
181
+
- [is_selectable `NonExistent] returns [false]
182
+
- [is_selectable `Drafts] returns [true]
183
+
- [is_selectable `HasChildren] returns [true] *)
184
+
185
+
(** {1 Pretty Printing} *)
186
+
187
+
val pp : Format.formatter -> t -> unit
188
+
(** [pp ppf attr] pretty-prints the attribute in IMAP wire format. *)
+32
ocaml-mail-flag/mail-flag.opam
+32
ocaml-mail-flag/mail-flag.opam
···
···
1
+
# This file is generated by dune, edit dune-project instead
2
+
opam-version: "2.0"
3
+
synopsis: "Unified message flags and mailbox attributes for IMAP/JMAP"
4
+
description:
5
+
"Type-safe message keywords, system flags, and mailbox attributes for email protocols. Supports RFC 9051 (IMAP4rev2), RFC 8621 (JMAP Mail), RFC 6154 (Special-Use), and draft-ietf-mailmaint extensions."
6
+
maintainer: ["Anil Madhavapeddy <anil@recoil.org>"]
7
+
authors: ["Anil Madhavapeddy"]
8
+
license: "ISC"
9
+
homepage: "https://tangled.org/@anil.recoil.org/ocaml-mail-flag"
10
+
bug-reports: "https://tangled.org/@anil.recoil.org/ocaml-mail-flag/issues"
11
+
depends: [
12
+
"dune" {>= "3.20"}
13
+
"ocaml" {>= "5.1.0"}
14
+
"fmt" {>= "0.9"}
15
+
"odoc" {with-doc}
16
+
"alcotest" {with-test & >= "1.7.0"}
17
+
]
18
+
build: [
19
+
["dune" "subst"] {dev}
20
+
[
21
+
"dune"
22
+
"build"
23
+
"-p"
24
+
name
25
+
"-j"
26
+
jobs
27
+
"@install"
28
+
"@runtest" {with-test}
29
+
"@doc" {with-doc}
30
+
]
31
+
]
32
+
x-maintenance-intent: ["(latest)"]
+11
ocaml-mail-flag/test/dune
+11
ocaml-mail-flag/test/dune
+165
ocaml-mail-flag/test/test_flag_color.ml
+165
ocaml-mail-flag/test/test_flag_color.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Flag_color module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let color_testable =
11
+
Alcotest.testable Flag_color.pp (=)
12
+
13
+
let test_to_bits () =
14
+
(* Test color to bit pattern conversion *)
15
+
Alcotest.(check (triple bool bool bool)) "red" (false, false, false) (Flag_color.to_bits `Red);
16
+
Alcotest.(check (triple bool bool bool)) "orange" (true, false, false) (Flag_color.to_bits `Orange);
17
+
Alcotest.(check (triple bool bool bool)) "yellow" (false, true, false) (Flag_color.to_bits `Yellow);
18
+
Alcotest.(check (triple bool bool bool)) "green" (true, true, false) (Flag_color.to_bits `Green);
19
+
Alcotest.(check (triple bool bool bool)) "blue" (false, false, true) (Flag_color.to_bits `Blue);
20
+
Alcotest.(check (triple bool bool bool)) "purple" (true, false, true) (Flag_color.to_bits `Purple);
21
+
Alcotest.(check (triple bool bool bool)) "gray" (false, true, true) (Flag_color.to_bits `Gray)
22
+
23
+
let test_of_bits () =
24
+
(* Test bit pattern to color conversion *)
25
+
Alcotest.(check (option color_testable)) "000 = red" (Some `Red) (Flag_color.of_bits (false, false, false));
26
+
Alcotest.(check (option color_testable)) "100 = orange" (Some `Orange) (Flag_color.of_bits (true, false, false));
27
+
Alcotest.(check (option color_testable)) "010 = yellow" (Some `Yellow) (Flag_color.of_bits (false, true, false));
28
+
Alcotest.(check (option color_testable)) "110 = green" (Some `Green) (Flag_color.of_bits (true, true, false));
29
+
Alcotest.(check (option color_testable)) "001 = blue" (Some `Blue) (Flag_color.of_bits (false, false, true));
30
+
Alcotest.(check (option color_testable)) "101 = purple" (Some `Purple) (Flag_color.of_bits (true, false, true));
31
+
Alcotest.(check (option color_testable)) "011 = gray" (Some `Gray) (Flag_color.of_bits (false, true, true));
32
+
(* 111 is undefined *)
33
+
Alcotest.(check (option color_testable)) "111 = undefined" None (Flag_color.of_bits (true, true, true))
34
+
35
+
let test_bits_roundtrip () =
36
+
(* Test that to_bits -> of_bits preserves the color *)
37
+
let test_color c =
38
+
let bits = Flag_color.to_bits c in
39
+
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_bits bits)
40
+
in
41
+
test_color `Red;
42
+
test_color `Orange;
43
+
test_color `Yellow;
44
+
test_color `Green;
45
+
test_color `Blue;
46
+
test_color `Purple;
47
+
test_color `Gray
48
+
49
+
let test_to_keywords () =
50
+
(* Test color to keyword list conversion *)
51
+
Alcotest.(check int) "red = 0 keywords" 0 (List.length (Flag_color.to_keywords `Red));
52
+
Alcotest.(check int) "orange = 1 keyword" 1 (List.length (Flag_color.to_keywords `Orange));
53
+
Alcotest.(check int) "yellow = 1 keyword" 1 (List.length (Flag_color.to_keywords `Yellow));
54
+
Alcotest.(check int) "green = 2 keywords" 2 (List.length (Flag_color.to_keywords `Green));
55
+
Alcotest.(check int) "blue = 1 keyword" 1 (List.length (Flag_color.to_keywords `Blue));
56
+
Alcotest.(check int) "purple = 2 keywords" 2 (List.length (Flag_color.to_keywords `Purple));
57
+
Alcotest.(check int) "gray = 2 keywords" 2 (List.length (Flag_color.to_keywords `Gray));
58
+
(* Check specific keywords *)
59
+
Alcotest.(check bool) "orange has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Orange));
60
+
Alcotest.(check bool) "yellow has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Yellow));
61
+
Alcotest.(check bool) "blue has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Blue));
62
+
Alcotest.(check bool) "green has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Green));
63
+
Alcotest.(check bool) "green has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Green));
64
+
Alcotest.(check bool) "purple has bit0" true (List.mem `MailFlagBit0 (Flag_color.to_keywords `Purple));
65
+
Alcotest.(check bool) "purple has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Purple));
66
+
Alcotest.(check bool) "gray has bit1" true (List.mem `MailFlagBit1 (Flag_color.to_keywords `Gray));
67
+
Alcotest.(check bool) "gray has bit2" true (List.mem `MailFlagBit2 (Flag_color.to_keywords `Gray))
68
+
69
+
let test_of_keywords () =
70
+
(* Test keyword list to color conversion *)
71
+
(* Empty list returns None (ambiguous: no color vs Red) *)
72
+
Alcotest.(check (option color_testable)) "empty = None" None (Flag_color.of_keywords []);
73
+
Alcotest.(check (option color_testable)) "bit0 = orange" (Some `Orange) (Flag_color.of_keywords [`MailFlagBit0]);
74
+
Alcotest.(check (option color_testable)) "bit1 = yellow" (Some `Yellow) (Flag_color.of_keywords [`MailFlagBit1]);
75
+
Alcotest.(check (option color_testable)) "bit2 = blue" (Some `Blue) (Flag_color.of_keywords [`MailFlagBit2]);
76
+
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some `Green) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1]);
77
+
Alcotest.(check (option color_testable)) "bits 0,2 = purple" (Some `Purple) (Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit2]);
78
+
Alcotest.(check (option color_testable)) "bits 1,2 = gray" (Some `Gray) (Flag_color.of_keywords [`MailFlagBit1; `MailFlagBit2]);
79
+
(* All bits = undefined *)
80
+
Alcotest.(check (option color_testable)) "all bits = undefined" None
81
+
(Flag_color.of_keywords [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2])
82
+
83
+
let test_of_keywords_default_red () =
84
+
(* Test keyword list to color with Red default for empty list *)
85
+
Alcotest.(check (option color_testable)) "empty = red" (Some `Red) (Flag_color.of_keywords_default_red []);
86
+
Alcotest.(check (option color_testable)) "bit0 = orange" (Some `Orange) (Flag_color.of_keywords_default_red [`MailFlagBit0]);
87
+
Alcotest.(check (option color_testable)) "bits 0,1 = green" (Some `Green)
88
+
(Flag_color.of_keywords_default_red [`MailFlagBit0; `MailFlagBit1]);
89
+
(* All bits still undefined *)
90
+
Alcotest.(check (option color_testable)) "all bits = undefined" None
91
+
(Flag_color.of_keywords_default_red [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2])
92
+
93
+
let test_keywords_roundtrip () =
94
+
(* Test that to_keywords -> of_keywords_default_red preserves non-red colors *)
95
+
let test_color c =
96
+
let kws = Flag_color.to_keywords c in
97
+
Alcotest.(check (option color_testable)) (Flag_color.to_string c) (Some c) (Flag_color.of_keywords_default_red kws)
98
+
in
99
+
test_color `Red;
100
+
test_color `Orange;
101
+
test_color `Yellow;
102
+
test_color `Green;
103
+
test_color `Blue;
104
+
test_color `Purple;
105
+
test_color `Gray
106
+
107
+
let test_to_string () =
108
+
(* Test color to string conversion *)
109
+
Alcotest.(check string) "red" "red" (Flag_color.to_string `Red);
110
+
Alcotest.(check string) "orange" "orange" (Flag_color.to_string `Orange);
111
+
Alcotest.(check string) "yellow" "yellow" (Flag_color.to_string `Yellow);
112
+
Alcotest.(check string) "green" "green" (Flag_color.to_string `Green);
113
+
Alcotest.(check string) "blue" "blue" (Flag_color.to_string `Blue);
114
+
Alcotest.(check string) "purple" "purple" (Flag_color.to_string `Purple);
115
+
Alcotest.(check string) "gray" "gray" (Flag_color.to_string `Gray)
116
+
117
+
let test_of_string () =
118
+
(* Test string to color conversion *)
119
+
Alcotest.(check (option color_testable)) "red" (Some `Red) (Flag_color.of_string "red");
120
+
Alcotest.(check (option color_testable)) "orange" (Some `Orange) (Flag_color.of_string "orange");
121
+
Alcotest.(check (option color_testable)) "yellow" (Some `Yellow) (Flag_color.of_string "yellow");
122
+
Alcotest.(check (option color_testable)) "green" (Some `Green) (Flag_color.of_string "green");
123
+
Alcotest.(check (option color_testable)) "blue" (Some `Blue) (Flag_color.of_string "blue");
124
+
Alcotest.(check (option color_testable)) "purple" (Some `Purple) (Flag_color.of_string "purple");
125
+
Alcotest.(check (option color_testable)) "gray" (Some `Gray) (Flag_color.of_string "gray");
126
+
Alcotest.(check (option color_testable)) "grey" (Some `Gray) (Flag_color.of_string "grey");
127
+
(* Case insensitive *)
128
+
Alcotest.(check (option color_testable)) "RED" (Some `Red) (Flag_color.of_string "RED");
129
+
Alcotest.(check (option color_testable)) "Orange" (Some `Orange) (Flag_color.of_string "Orange");
130
+
(* Unknown *)
131
+
Alcotest.(check (option color_testable)) "unknown" None (Flag_color.of_string "unknown")
132
+
133
+
let test_string_roundtrip () =
134
+
(* Test that to_string -> of_string preserves the color *)
135
+
let test_color c =
136
+
let s = Flag_color.to_string c in
137
+
Alcotest.(check (option color_testable)) s (Some c) (Flag_color.of_string s)
138
+
in
139
+
test_color `Red;
140
+
test_color `Orange;
141
+
test_color `Yellow;
142
+
test_color `Green;
143
+
test_color `Blue;
144
+
test_color `Purple;
145
+
test_color `Gray
146
+
147
+
let () =
148
+
Alcotest.run "Flag_color" [
149
+
"bits", [
150
+
Alcotest.test_case "to_bits" `Quick test_to_bits;
151
+
Alcotest.test_case "of_bits" `Quick test_of_bits;
152
+
Alcotest.test_case "roundtrip" `Quick test_bits_roundtrip;
153
+
];
154
+
"keywords", [
155
+
Alcotest.test_case "to_keywords" `Quick test_to_keywords;
156
+
Alcotest.test_case "of_keywords" `Quick test_of_keywords;
157
+
Alcotest.test_case "of_keywords_default_red" `Quick test_of_keywords_default_red;
158
+
Alcotest.test_case "roundtrip" `Quick test_keywords_roundtrip;
159
+
];
160
+
"strings", [
161
+
Alcotest.test_case "to_string" `Quick test_to_string;
162
+
Alcotest.test_case "of_string" `Quick test_of_string;
163
+
Alcotest.test_case "roundtrip" `Quick test_string_roundtrip;
164
+
];
165
+
]
+212
ocaml-mail-flag/test/test_keyword.ml
+212
ocaml-mail-flag/test/test_keyword.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Keyword module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let keyword_testable =
11
+
Alcotest.testable Keyword.pp Keyword.equal
12
+
13
+
let test_of_string_standard () =
14
+
(* Test standard keywords with $ prefix *)
15
+
Alcotest.(check keyword_testable) "seen with $" `Seen (Keyword.of_string "$seen");
16
+
Alcotest.(check keyword_testable) "answered with $" `Answered (Keyword.of_string "$answered");
17
+
Alcotest.(check keyword_testable) "flagged with $" `Flagged (Keyword.of_string "$flagged");
18
+
Alcotest.(check keyword_testable) "draft with $" `Draft (Keyword.of_string "$draft");
19
+
Alcotest.(check keyword_testable) "deleted with $" `Deleted (Keyword.of_string "$deleted");
20
+
Alcotest.(check keyword_testable) "forwarded with $" `Forwarded (Keyword.of_string "$forwarded")
21
+
22
+
let test_of_string_no_prefix () =
23
+
(* Test standard keywords without prefix *)
24
+
Alcotest.(check keyword_testable) "seen no prefix" `Seen (Keyword.of_string "seen");
25
+
Alcotest.(check keyword_testable) "answered no prefix" `Answered (Keyword.of_string "answered");
26
+
Alcotest.(check keyword_testable) "flagged no prefix" `Flagged (Keyword.of_string "flagged")
27
+
28
+
let test_of_string_case_insensitive () =
29
+
(* Test case insensitivity *)
30
+
Alcotest.(check keyword_testable) "SEEN uppercase" `Seen (Keyword.of_string "$SEEN");
31
+
Alcotest.(check keyword_testable) "Seen mixed" `Seen (Keyword.of_string "Seen");
32
+
Alcotest.(check keyword_testable) "FORWARDED uppercase" `Forwarded (Keyword.of_string "$FORWARDED")
33
+
34
+
let test_of_string_imap_format () =
35
+
(* Test IMAP system flag format with backslash *)
36
+
Alcotest.(check keyword_testable) "\\Seen" `Seen (Keyword.of_string "\\Seen");
37
+
Alcotest.(check keyword_testable) "\\Answered" `Answered (Keyword.of_string "\\Answered");
38
+
Alcotest.(check keyword_testable) "\\Draft" `Draft (Keyword.of_string "\\Draft")
39
+
40
+
let test_of_string_spam () =
41
+
(* Test spam-related keywords *)
42
+
Alcotest.(check keyword_testable) "phishing" `Phishing (Keyword.of_string "$phishing");
43
+
Alcotest.(check keyword_testable) "junk" `Junk (Keyword.of_string "$junk");
44
+
Alcotest.(check keyword_testable) "notjunk" `NotJunk (Keyword.of_string "$notjunk")
45
+
46
+
let test_of_string_extended () =
47
+
(* Test extended keywords *)
48
+
Alcotest.(check keyword_testable) "hasattachment" `HasAttachment (Keyword.of_string "$hasattachment");
49
+
Alcotest.(check keyword_testable) "hasnoattachment" `HasNoAttachment (Keyword.of_string "$hasnoattachment");
50
+
Alcotest.(check keyword_testable) "muted" `Muted (Keyword.of_string "$muted");
51
+
Alcotest.(check keyword_testable) "followed" `Followed (Keyword.of_string "$followed")
52
+
53
+
let test_of_string_flag_bits () =
54
+
(* Test Apple Mail flag bits *)
55
+
Alcotest.(check keyword_testable) "mailflagbit0" `MailFlagBit0 (Keyword.of_string "$mailflagbit0");
56
+
Alcotest.(check keyword_testable) "mailflagbit1" `MailFlagBit1 (Keyword.of_string "$mailflagbit1");
57
+
Alcotest.(check keyword_testable) "mailflagbit2" `MailFlagBit2 (Keyword.of_string "$mailflagbit2")
58
+
59
+
let test_of_string_custom () =
60
+
(* Test custom keywords *)
61
+
Alcotest.(check keyword_testable) "custom keyword" (`Custom "my-label") (Keyword.of_string "my-label");
62
+
Alcotest.(check keyword_testable) "custom with $" (`Custom "custom") (Keyword.of_string "$custom")
63
+
64
+
let test_to_string () =
65
+
(* Test conversion to JMAP format *)
66
+
Alcotest.(check string) "seen" "$seen" (Keyword.to_string `Seen);
67
+
Alcotest.(check string) "answered" "$answered" (Keyword.to_string `Answered);
68
+
Alcotest.(check string) "flagged" "$flagged" (Keyword.to_string `Flagged);
69
+
Alcotest.(check string) "draft" "$draft" (Keyword.to_string `Draft);
70
+
Alcotest.(check string) "deleted" "$deleted" (Keyword.to_string `Deleted);
71
+
Alcotest.(check string) "forwarded" "$forwarded" (Keyword.to_string `Forwarded);
72
+
Alcotest.(check string) "junk" "$junk" (Keyword.to_string `Junk);
73
+
Alcotest.(check string) "mailflagbit0" "$MailFlagBit0" (Keyword.to_string `MailFlagBit0);
74
+
Alcotest.(check string) "custom" "my-label" (Keyword.to_string (`Custom "my-label"))
75
+
76
+
let test_to_imap_string () =
77
+
(* Test conversion to IMAP format *)
78
+
Alcotest.(check string) "seen" "\\Seen" (Keyword.to_imap_string `Seen);
79
+
Alcotest.(check string) "answered" "\\Answered" (Keyword.to_imap_string `Answered);
80
+
Alcotest.(check string) "flagged" "\\Flagged" (Keyword.to_imap_string `Flagged);
81
+
Alcotest.(check string) "draft" "\\Draft" (Keyword.to_imap_string `Draft);
82
+
Alcotest.(check string) "deleted" "\\Deleted" (Keyword.to_imap_string `Deleted);
83
+
(* Non-system flags use $ prefix *)
84
+
Alcotest.(check string) "forwarded" "$Forwarded" (Keyword.to_imap_string `Forwarded);
85
+
Alcotest.(check string) "junk" "$Junk" (Keyword.to_imap_string `Junk);
86
+
Alcotest.(check string) "mailflagbit0" "$MailFlagBit0" (Keyword.to_imap_string `MailFlagBit0)
87
+
88
+
let test_is_standard () =
89
+
(* Test is_standard predicate *)
90
+
Alcotest.(check bool) "seen is standard" true (Keyword.is_standard `Seen);
91
+
Alcotest.(check bool) "answered is standard" true (Keyword.is_standard `Answered);
92
+
Alcotest.(check bool) "flagged is standard" true (Keyword.is_standard `Flagged);
93
+
Alcotest.(check bool) "draft is standard" true (Keyword.is_standard `Draft);
94
+
Alcotest.(check bool) "deleted is standard" true (Keyword.is_standard `Deleted);
95
+
(* Forwarded is NOT an IMAP system flag *)
96
+
Alcotest.(check bool) "forwarded is not standard" false (Keyword.is_standard `Forwarded);
97
+
Alcotest.(check bool) "junk is not standard" false (Keyword.is_standard `Junk);
98
+
Alcotest.(check bool) "custom is not standard" false (Keyword.is_standard (`Custom "x"))
99
+
100
+
let test_mutual_exclusion () =
101
+
(* Test mutually exclusive pairs *)
102
+
Alcotest.(check bool) "has/hasno attachment" true
103
+
(Keyword.is_mutually_exclusive `HasAttachment `HasNoAttachment);
104
+
Alcotest.(check bool) "hasno/has attachment" true
105
+
(Keyword.is_mutually_exclusive `HasNoAttachment `HasAttachment);
106
+
Alcotest.(check bool) "junk/notjunk" true
107
+
(Keyword.is_mutually_exclusive `Junk `NotJunk);
108
+
Alcotest.(check bool) "notjunk/junk" true
109
+
(Keyword.is_mutually_exclusive `NotJunk `Junk);
110
+
Alcotest.(check bool) "muted/followed" true
111
+
(Keyword.is_mutually_exclusive `Muted `Followed);
112
+
Alcotest.(check bool) "followed/muted" true
113
+
(Keyword.is_mutually_exclusive `Followed `Muted);
114
+
(* Non-exclusive pairs *)
115
+
Alcotest.(check bool) "seen/flagged" false
116
+
(Keyword.is_mutually_exclusive `Seen `Flagged);
117
+
Alcotest.(check bool) "seen/seen" false
118
+
(Keyword.is_mutually_exclusive `Seen `Seen);
119
+
Alcotest.(check bool) "junk/muted" false
120
+
(Keyword.is_mutually_exclusive `Junk `Muted)
121
+
122
+
let test_equal () =
123
+
(* Test equality *)
124
+
Alcotest.(check bool) "same keyword" true (Keyword.equal `Seen `Seen);
125
+
Alcotest.(check bool) "different keywords" false (Keyword.equal `Seen `Flagged);
126
+
(* Custom keywords are compared case-insensitively *)
127
+
Alcotest.(check bool) "custom same" true (Keyword.equal (`Custom "label") (`Custom "label"));
128
+
Alcotest.(check bool) "custom case insensitive" true (Keyword.equal (`Custom "Label") (`Custom "label"));
129
+
Alcotest.(check bool) "custom different" false (Keyword.equal (`Custom "a") (`Custom "b"))
130
+
131
+
let test_compare () =
132
+
(* Test comparison *)
133
+
Alcotest.(check int) "same keyword" 0 (Keyword.compare `Seen `Seen);
134
+
Alcotest.(check bool) "custom vs non-custom" true (Keyword.compare (`Custom "a") `Seen > 0);
135
+
Alcotest.(check bool) "non-custom vs custom" true (Keyword.compare `Seen (`Custom "a") < 0)
136
+
137
+
let pp_flag_color ppf c =
138
+
let s = match c with
139
+
| `Red -> "Red" | `Orange -> "Orange" | `Yellow -> "Yellow"
140
+
| `Green -> "Green" | `Blue -> "Blue" | `Purple -> "Purple" | `Gray -> "Gray"
141
+
in
142
+
Format.pp_print_string ppf s
143
+
144
+
let eq_flag_color a b =
145
+
match (a, b) with
146
+
| `Red, `Red | `Orange, `Orange | `Yellow, `Yellow
147
+
| `Green, `Green | `Blue, `Blue | `Purple, `Purple | `Gray, `Gray -> true
148
+
| _ -> false
149
+
150
+
let flag_color_testable = Alcotest.testable pp_flag_color eq_flag_color
151
+
152
+
let test_flag_color_of_keywords () =
153
+
(* Test Apple Mail flag color extraction *)
154
+
Alcotest.(check (option flag_color_testable))
155
+
"no bits = red" (Some `Red) (Keyword.flag_color_of_keywords []);
156
+
Alcotest.(check (option flag_color_testable))
157
+
"bit0 = orange" (Some `Orange) (Keyword.flag_color_of_keywords [`MailFlagBit0]);
158
+
Alcotest.(check (option flag_color_testable))
159
+
"bit1 = yellow" (Some `Yellow) (Keyword.flag_color_of_keywords [`MailFlagBit1]);
160
+
Alcotest.(check (option flag_color_testable))
161
+
"bit2 = blue" (Some `Blue) (Keyword.flag_color_of_keywords [`MailFlagBit2]);
162
+
Alcotest.(check (option flag_color_testable))
163
+
"bits 0,2 = purple" (Some `Purple) (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit2]);
164
+
Alcotest.(check (option flag_color_testable))
165
+
"bits 1,2 = gray" (Some `Gray) (Keyword.flag_color_of_keywords [`MailFlagBit1; `MailFlagBit2]);
166
+
Alcotest.(check (option flag_color_testable))
167
+
"all bits = green" (Some `Green) (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit1; `MailFlagBit2]);
168
+
(* Invalid encoding: bits 0 and 1 but not 2 *)
169
+
Alcotest.(check (option flag_color_testable))
170
+
"bits 0,1 = invalid" None (Keyword.flag_color_of_keywords [`MailFlagBit0; `MailFlagBit1])
171
+
172
+
let test_flag_color_to_keywords () =
173
+
(* Test Apple Mail flag color encoding *)
174
+
Alcotest.(check int) "red = no bits" 0 (List.length (Keyword.flag_color_to_keywords `Red));
175
+
Alcotest.(check int) "orange = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Orange));
176
+
Alcotest.(check int) "yellow = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Yellow));
177
+
Alcotest.(check int) "blue = 1 bit" 1 (List.length (Keyword.flag_color_to_keywords `Blue));
178
+
Alcotest.(check int) "purple = 2 bits" 2 (List.length (Keyword.flag_color_to_keywords `Purple));
179
+
Alcotest.(check int) "gray = 2 bits" 2 (List.length (Keyword.flag_color_to_keywords `Gray));
180
+
Alcotest.(check int) "green = 3 bits" 3 (List.length (Keyword.flag_color_to_keywords `Green))
181
+
182
+
let () =
183
+
Alcotest.run "Keyword" [
184
+
"of_string", [
185
+
Alcotest.test_case "standard keywords" `Quick test_of_string_standard;
186
+
Alcotest.test_case "no prefix" `Quick test_of_string_no_prefix;
187
+
Alcotest.test_case "case insensitive" `Quick test_of_string_case_insensitive;
188
+
Alcotest.test_case "IMAP format" `Quick test_of_string_imap_format;
189
+
Alcotest.test_case "spam keywords" `Quick test_of_string_spam;
190
+
Alcotest.test_case "extended keywords" `Quick test_of_string_extended;
191
+
Alcotest.test_case "flag bits" `Quick test_of_string_flag_bits;
192
+
Alcotest.test_case "custom" `Quick test_of_string_custom;
193
+
];
194
+
"to_string", [
195
+
Alcotest.test_case "JMAP format" `Quick test_to_string;
196
+
];
197
+
"to_imap_string", [
198
+
Alcotest.test_case "IMAP format" `Quick test_to_imap_string;
199
+
];
200
+
"predicates", [
201
+
Alcotest.test_case "is_standard" `Quick test_is_standard;
202
+
Alcotest.test_case "is_mutually_exclusive" `Quick test_mutual_exclusion;
203
+
];
204
+
"equality", [
205
+
Alcotest.test_case "equal" `Quick test_equal;
206
+
Alcotest.test_case "compare" `Quick test_compare;
207
+
];
208
+
"flag_color", [
209
+
Alcotest.test_case "of_keywords" `Quick test_flag_color_of_keywords;
210
+
Alcotest.test_case "to_keywords" `Quick test_flag_color_to_keywords;
211
+
];
212
+
]
+174
ocaml-mail-flag/test/test_mailbox_attr.ml
+174
ocaml-mail-flag/test/test_mailbox_attr.ml
···
···
1
+
(*---------------------------------------------------------------------------
2
+
Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
3
+
SPDX-License-Identifier: ISC
4
+
---------------------------------------------------------------------------*)
5
+
6
+
(** Tests for the Mailbox_attr module. *)
7
+
8
+
open Mail_flag
9
+
10
+
let attr_testable =
11
+
Alcotest.testable Mailbox_attr.pp (fun a b ->
12
+
Mailbox_attr.to_string a = Mailbox_attr.to_string b)
13
+
14
+
(* A testable for special_use which is a subtype of t *)
15
+
let pp_special_use ppf (x : Mailbox_attr.special_use) =
16
+
Mailbox_attr.pp ppf (x :> Mailbox_attr.t)
17
+
18
+
let special_use_testable : Mailbox_attr.special_use Alcotest.testable =
19
+
Alcotest.testable pp_special_use (fun a b ->
20
+
Mailbox_attr.to_string (a :> Mailbox_attr.t) = Mailbox_attr.to_string (b :> Mailbox_attr.t))
21
+
22
+
let test_of_string_special_use () =
23
+
(* Test special-use attributes with backslash prefix *)
24
+
Alcotest.(check attr_testable) "\\Drafts" `Drafts (Mailbox_attr.of_string "\\Drafts");
25
+
Alcotest.(check attr_testable) "\\Sent" `Sent (Mailbox_attr.of_string "\\Sent");
26
+
Alcotest.(check attr_testable) "\\Trash" `Trash (Mailbox_attr.of_string "\\Trash");
27
+
Alcotest.(check attr_testable) "\\Junk" `Junk (Mailbox_attr.of_string "\\Junk");
28
+
Alcotest.(check attr_testable) "\\Archive" `Archive (Mailbox_attr.of_string "\\Archive");
29
+
Alcotest.(check attr_testable) "\\All" `All (Mailbox_attr.of_string "\\All");
30
+
Alcotest.(check attr_testable) "\\Flagged" `Flagged (Mailbox_attr.of_string "\\Flagged");
31
+
Alcotest.(check attr_testable) "\\Important" `Important (Mailbox_attr.of_string "\\Important");
32
+
Alcotest.(check attr_testable) "\\Inbox" `Inbox (Mailbox_attr.of_string "\\Inbox")
33
+
34
+
let test_of_string_no_backslash () =
35
+
(* Test special-use attributes without backslash prefix *)
36
+
Alcotest.(check attr_testable) "drafts" `Drafts (Mailbox_attr.of_string "drafts");
37
+
Alcotest.(check attr_testable) "sent" `Sent (Mailbox_attr.of_string "sent");
38
+
Alcotest.(check attr_testable) "trash" `Trash (Mailbox_attr.of_string "trash");
39
+
Alcotest.(check attr_testable) "inbox" `Inbox (Mailbox_attr.of_string "inbox")
40
+
41
+
let test_of_string_case_insensitive () =
42
+
(* Test case insensitivity *)
43
+
Alcotest.(check attr_testable) "DRAFTS" `Drafts (Mailbox_attr.of_string "DRAFTS");
44
+
Alcotest.(check attr_testable) "\\SENT" `Sent (Mailbox_attr.of_string "\\SENT");
45
+
Alcotest.(check attr_testable) "Trash" `Trash (Mailbox_attr.of_string "Trash")
46
+
47
+
let test_of_string_list_attrs () =
48
+
(* Test LIST attributes *)
49
+
Alcotest.(check attr_testable) "\\Noinferiors" `Noinferiors (Mailbox_attr.of_string "\\Noinferiors");
50
+
Alcotest.(check attr_testable) "\\Noselect" `Noselect (Mailbox_attr.of_string "\\Noselect");
51
+
Alcotest.(check attr_testable) "\\Marked" `Marked (Mailbox_attr.of_string "\\Marked");
52
+
Alcotest.(check attr_testable) "\\Unmarked" `Unmarked (Mailbox_attr.of_string "\\Unmarked");
53
+
Alcotest.(check attr_testable) "\\Subscribed" `Subscribed (Mailbox_attr.of_string "\\Subscribed");
54
+
Alcotest.(check attr_testable) "\\HasChildren" `HasChildren (Mailbox_attr.of_string "\\HasChildren");
55
+
Alcotest.(check attr_testable) "\\HasNoChildren" `HasNoChildren (Mailbox_attr.of_string "\\HasNoChildren");
56
+
Alcotest.(check attr_testable) "\\NonExistent" `NonExistent (Mailbox_attr.of_string "\\NonExistent");
57
+
Alcotest.(check attr_testable) "\\Remote" `Remote (Mailbox_attr.of_string "\\Remote")
58
+
59
+
let test_of_string_junk_alias () =
60
+
(* Test that "spam" is recognized as Junk *)
61
+
Alcotest.(check attr_testable) "spam" `Junk (Mailbox_attr.of_string "spam");
62
+
Alcotest.(check attr_testable) "\\Spam" `Junk (Mailbox_attr.of_string "\\Spam")
63
+
64
+
let test_of_string_extended () =
65
+
(* Test extended special-use attributes *)
66
+
Alcotest.(check attr_testable) "\\Snoozed" `Snoozed (Mailbox_attr.of_string "\\Snoozed");
67
+
Alcotest.(check attr_testable) "\\Scheduled" `Scheduled (Mailbox_attr.of_string "\\Scheduled");
68
+
Alcotest.(check attr_testable) "\\Memos" `Memos (Mailbox_attr.of_string "\\Memos")
69
+
70
+
let test_of_string_extension () =
71
+
(* Test unknown extensions *)
72
+
Alcotest.(check attr_testable) "X-Custom" (`Extension "x-custom") (Mailbox_attr.of_string "X-Custom");
73
+
Alcotest.(check attr_testable) "\\X-MyAttr" (`Extension "x-myattr") (Mailbox_attr.of_string "\\X-MyAttr")
74
+
75
+
let test_to_string () =
76
+
(* Test conversion to IMAP wire format *)
77
+
Alcotest.(check string) "Drafts" "\\Drafts" (Mailbox_attr.to_string `Drafts);
78
+
Alcotest.(check string) "Sent" "\\Sent" (Mailbox_attr.to_string `Sent);
79
+
Alcotest.(check string) "Trash" "\\Trash" (Mailbox_attr.to_string `Trash);
80
+
Alcotest.(check string) "Junk" "\\Junk" (Mailbox_attr.to_string `Junk);
81
+
Alcotest.(check string) "Inbox" "\\Inbox" (Mailbox_attr.to_string `Inbox);
82
+
Alcotest.(check string) "Noselect" "\\Noselect" (Mailbox_attr.to_string `Noselect);
83
+
Alcotest.(check string) "HasChildren" "\\HasChildren" (Mailbox_attr.to_string `HasChildren);
84
+
Alcotest.(check string) "Extension" "\\x-custom" (Mailbox_attr.to_string (`Extension "x-custom"))
85
+
86
+
let test_to_jmap_role () =
87
+
(* Test special-use to JMAP role conversion *)
88
+
Alcotest.(check (option string)) "drafts role" (Some "drafts") (Mailbox_attr.to_jmap_role `Drafts);
89
+
Alcotest.(check (option string)) "sent role" (Some "sent") (Mailbox_attr.to_jmap_role `Sent);
90
+
Alcotest.(check (option string)) "trash role" (Some "trash") (Mailbox_attr.to_jmap_role `Trash);
91
+
Alcotest.(check (option string)) "junk role" (Some "junk") (Mailbox_attr.to_jmap_role `Junk);
92
+
Alcotest.(check (option string)) "inbox role" (Some "inbox") (Mailbox_attr.to_jmap_role `Inbox);
93
+
Alcotest.(check (option string)) "archive role" (Some "archive") (Mailbox_attr.to_jmap_role `Archive);
94
+
Alcotest.(check (option string)) "all role" (Some "all") (Mailbox_attr.to_jmap_role `All);
95
+
Alcotest.(check (option string)) "flagged role" (Some "flagged") (Mailbox_attr.to_jmap_role `Flagged);
96
+
Alcotest.(check (option string)) "important role" (Some "important") (Mailbox_attr.to_jmap_role `Important);
97
+
Alcotest.(check (option string)) "snoozed role" (Some "snoozed") (Mailbox_attr.to_jmap_role `Snoozed);
98
+
Alcotest.(check (option string)) "scheduled role" (Some "scheduled") (Mailbox_attr.to_jmap_role `Scheduled);
99
+
Alcotest.(check (option string)) "memos role" (Some "memos") (Mailbox_attr.to_jmap_role `Memos);
100
+
(* LIST attributes have no JMAP role *)
101
+
Alcotest.(check (option string)) "noselect no role" None (Mailbox_attr.to_jmap_role `Noselect);
102
+
Alcotest.(check (option string)) "haschildren no role" None (Mailbox_attr.to_jmap_role `HasChildren);
103
+
Alcotest.(check (option string)) "extension no role" None (Mailbox_attr.to_jmap_role (`Extension "x"))
104
+
105
+
let test_of_jmap_role () =
106
+
(* Test JMAP role to special-use conversion *)
107
+
Alcotest.(check (option special_use_testable)) "drafts" (Some `Drafts) (Mailbox_attr.of_jmap_role "drafts");
108
+
Alcotest.(check (option special_use_testable)) "sent" (Some `Sent) (Mailbox_attr.of_jmap_role "sent");
109
+
Alcotest.(check (option special_use_testable)) "trash" (Some `Trash) (Mailbox_attr.of_jmap_role "trash");
110
+
Alcotest.(check (option special_use_testable)) "junk" (Some `Junk) (Mailbox_attr.of_jmap_role "junk");
111
+
Alcotest.(check (option special_use_testable)) "inbox" (Some `Inbox) (Mailbox_attr.of_jmap_role "inbox");
112
+
Alcotest.(check (option special_use_testable)) "unknown" None (Mailbox_attr.of_jmap_role "unknown")
113
+
114
+
let test_is_special_use () =
115
+
(* Test is_special_use predicate *)
116
+
Alcotest.(check bool) "drafts is special-use" true (Mailbox_attr.is_special_use `Drafts);
117
+
Alcotest.(check bool) "sent is special-use" true (Mailbox_attr.is_special_use `Sent);
118
+
Alcotest.(check bool) "inbox is special-use" true (Mailbox_attr.is_special_use `Inbox);
119
+
Alcotest.(check bool) "subscribed is special-use" true (Mailbox_attr.is_special_use `Subscribed);
120
+
(* LIST attributes are not special-use *)
121
+
Alcotest.(check bool) "noselect not special-use" false (Mailbox_attr.is_special_use `Noselect);
122
+
Alcotest.(check bool) "haschildren not special-use" false (Mailbox_attr.is_special_use `HasChildren);
123
+
Alcotest.(check bool) "extension not special-use" false (Mailbox_attr.is_special_use (`Extension "x"))
124
+
125
+
let test_is_selectable () =
126
+
(* Test is_selectable predicate *)
127
+
Alcotest.(check bool) "drafts selectable" true (Mailbox_attr.is_selectable `Drafts);
128
+
Alcotest.(check bool) "inbox selectable" true (Mailbox_attr.is_selectable `Inbox);
129
+
Alcotest.(check bool) "haschildren selectable" true (Mailbox_attr.is_selectable `HasChildren);
130
+
(* Noselect and NonExistent are not selectable *)
131
+
Alcotest.(check bool) "noselect not selectable" false (Mailbox_attr.is_selectable `Noselect);
132
+
Alcotest.(check bool) "nonexistent not selectable" false (Mailbox_attr.is_selectable `NonExistent)
133
+
134
+
let test_roundtrip () =
135
+
(* Test that to_string -> of_string preserves the attribute *)
136
+
let test_attr attr =
137
+
let s = Mailbox_attr.to_string attr in
138
+
Alcotest.(check attr_testable) ("roundtrip " ^ s) attr (Mailbox_attr.of_string s)
139
+
in
140
+
test_attr `Drafts;
141
+
test_attr `Sent;
142
+
test_attr `Trash;
143
+
test_attr `Junk;
144
+
test_attr `Inbox;
145
+
test_attr `Noselect;
146
+
test_attr `HasChildren;
147
+
test_attr `Snoozed
148
+
149
+
let () =
150
+
Alcotest.run "Mailbox_attr" [
151
+
"of_string", [
152
+
Alcotest.test_case "special-use with backslash" `Quick test_of_string_special_use;
153
+
Alcotest.test_case "special-use no backslash" `Quick test_of_string_no_backslash;
154
+
Alcotest.test_case "case insensitive" `Quick test_of_string_case_insensitive;
155
+
Alcotest.test_case "LIST attributes" `Quick test_of_string_list_attrs;
156
+
Alcotest.test_case "junk/spam alias" `Quick test_of_string_junk_alias;
157
+
Alcotest.test_case "extended attributes" `Quick test_of_string_extended;
158
+
Alcotest.test_case "extensions" `Quick test_of_string_extension;
159
+
];
160
+
"to_string", [
161
+
Alcotest.test_case "IMAP wire format" `Quick test_to_string;
162
+
];
163
+
"JMAP roles", [
164
+
Alcotest.test_case "to_jmap_role" `Quick test_to_jmap_role;
165
+
Alcotest.test_case "of_jmap_role" `Quick test_of_jmap_role;
166
+
];
167
+
"predicates", [
168
+
Alcotest.test_case "is_special_use" `Quick test_is_special_use;
169
+
Alcotest.test_case "is_selectable" `Quick test_is_selectable;
170
+
];
171
+
"roundtrip", [
172
+
Alcotest.test_case "to_string -> of_string" `Quick test_roundtrip;
173
+
];
174
+
]