jon.recoil.org
forked from
anil.recoil.org/ocaml-imap
IMAP in OCaml
1(*---------------------------------------------------------------------------
2 Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
3 SPDX-License-Identifier: ISC
4 ---------------------------------------------------------------------------*)
5
6(** {0 RFC 5256 THREAD Extension}
7
8 Message threading algorithms as specified in
9 {{:https://datatracker.ietf.org/doc/html/rfc5256}RFC 5256 Section 3}.
10
11 The THREAD command allows clients to retrieve messages organized into
12 conversation threads based on message relationships. *)
13
14(** {1 Threading Algorithms}
15
16 RFC 5256 Section 3 defines two threading algorithms. Servers MUST
17 implement at least ORDEREDSUBJECT and SHOULD implement REFERENCES. *)
18
19(** Threading algorithm used to organize messages into threads.
20
21 @rfc 5256 Section 3 *)
22type algorithm =
23 | Orderedsubject
24 (** ORDEREDSUBJECT algorithm (RFC 5256 Section 3.1).
25 Groups messages by base subject (stripping Re:/Fwd: prefixes),
26 then sorts each group by sent date. Simple but effective for
27 basic threading. *)
28 | References
29 (** REFERENCES algorithm (RFC 5256 Section 3.2).
30 Implements the JWZ threading algorithm using Message-ID,
31 In-Reply-To, and References headers to build a complete
32 parent/child thread tree. More accurate than ORDEREDSUBJECT
33 but computationally more expensive. *)
34 | Extension of string
35 (** Future algorithm extensions. Servers may advertise additional
36 threading algorithms via the THREAD capability. *)
37
38(** {1 Thread Result Structure}
39
40 Thread results form a forest of trees. Each tree represents a
41 conversation thread, with messages as nodes. *)
42
43(** A thread node in the result tree.
44
45 Thread responses use a nested parenthesized structure where each
46 message may have zero or more child messages (replies).
47
48 @rfc 5256 Section 4 *)
49type 'a node =
50 | Message of 'a * 'a node list
51 (** A message with its sequence number or UID (depending on whether
52 UID THREAD was used) and a list of child messages (replies).
53 The children are ordered by the threading algorithm. *)
54 | Dummy of 'a node list
55 (** A placeholder for a missing parent message. This occurs when
56 replies reference a message that is not in the search results
57 (e.g., it was deleted or not matched by the search criteria).
58 The REFERENCES algorithm may produce dummy nodes to maintain
59 thread structure. *)
60
61(** Thread result: a list of root-level thread trees.
62
63 Each element is a top-level thread. The threads are ordered according
64 to the threading algorithm (typically by date of the first message
65 in each thread).
66
67 @rfc 5256 Section 4 *)
68type 'a t = 'a node list
69
70(** {1 Pretty Printers} *)
71
72let pp_algorithm ppf = function
73 | Orderedsubject -> Fmt.string ppf "ORDEREDSUBJECT"
74 | References -> Fmt.string ppf "REFERENCES"
75 | Extension s -> Fmt.pf ppf "%s" (String.uppercase_ascii s)
76
77let algorithm_to_string alg = Fmt.str "%a" pp_algorithm alg
78
79let algorithm_of_string s =
80 match String.uppercase_ascii s with
81 | "ORDEREDSUBJECT" -> Orderedsubject
82 | "REFERENCES" -> References
83 | other -> Extension other
84
85let rec pp_node pp_elt ppf = function
86 | Message (elt, []) ->
87 pp_elt ppf elt
88 | Message (elt, children) ->
89 Fmt.pf ppf "(%a %a)" pp_elt elt
90 Fmt.(list ~sep:sp (pp_node pp_elt)) children
91 | Dummy children ->
92 Fmt.pf ppf "(%a)" Fmt.(list ~sep:sp (pp_node pp_elt)) children
93
94let pp pp_elt ppf threads =
95 Fmt.(list ~sep:sp (pp_node pp_elt)) ppf threads