(*---------------------------------------------------------------------------
  Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
  SPDX-License-Identifier: ISC
 ---------------------------------------------------------------------------*)

(** {0 RFC 5256 THREAD Extension}

    Message threading algorithms as specified in
    {{:https://datatracker.ietf.org/doc/html/rfc5256}RFC 5256 Section 3}.

    The THREAD command allows clients to retrieve messages organized into
    conversation threads based on message relationships. *)

(** {1 Threading Algorithms}

    RFC 5256 Section 3 defines two threading algorithms. Servers MUST
    implement at least ORDEREDSUBJECT and SHOULD implement REFERENCES. *)

(** Threading algorithm used to organize messages into threads.

    @rfc 5256 Section 3 *)
type algorithm =
  | Orderedsubject
      (** ORDEREDSUBJECT algorithm (RFC 5256 Section 3.1).
          Groups messages by base subject (stripping Re:/Fwd: prefixes),
          then sorts each group by sent date. Simple but effective for
          basic threading. *)
  | References
      (** REFERENCES algorithm (RFC 5256 Section 3.2).
          Implements the JWZ threading algorithm using Message-ID,
          In-Reply-To, and References headers to build a complete
          parent/child thread tree. More accurate than ORDEREDSUBJECT
          but computationally more expensive. *)
  | Extension of string
      (** Future algorithm extensions. Servers may advertise additional
          threading algorithms via the THREAD capability. *)

(** {1 Thread Result Structure}

    Thread results form a forest of trees. Each tree represents a
    conversation thread, with messages as nodes. *)

(** A thread node in the result tree.

    Thread responses use a nested parenthesized structure where each
    message may have zero or more child messages (replies).

    @rfc 5256 Section 4 *)
type 'a node =
  | Message of 'a * 'a node list
      (** A message with its sequence number or UID (depending on whether
          UID THREAD was used) and a list of child messages (replies).
          The children are ordered by the threading algorithm. *)
  | Dummy of 'a node list
      (** A placeholder for a missing parent message. This occurs when
          replies reference a message that is not in the search results
          (e.g., it was deleted or not matched by the search criteria).
          The REFERENCES algorithm may produce dummy nodes to maintain
          thread structure. *)

(** Thread result: a list of root-level thread trees.

    Each element is a top-level thread. The threads are ordered according
    to the threading algorithm (typically by date of the first message
    in each thread).

    @rfc 5256 Section 4 *)
type 'a t = 'a node list

(** {1 Pretty Printers} *)

let pp_algorithm ppf = function
  | Orderedsubject -> Fmt.string ppf "ORDEREDSUBJECT"
  | References -> Fmt.string ppf "REFERENCES"
  | Extension s -> Fmt.pf ppf "%s" (String.uppercase_ascii s)

let algorithm_to_string alg = Fmt.str "%a" pp_algorithm alg

let algorithm_of_string s =
  match String.uppercase_ascii s with
  | "ORDEREDSUBJECT" -> Orderedsubject
  | "REFERENCES" -> References
  | other -> Extension other

let rec pp_node pp_elt ppf = function
  | Message (elt, []) ->
      pp_elt ppf elt
  | Message (elt, children) ->
      Fmt.pf ppf "(%a %a)" pp_elt elt
        Fmt.(list ~sep:sp (pp_node pp_elt)) children
  | Dummy children ->
      Fmt.pf ppf "(%a)" Fmt.(list ~sep:sp (pp_node pp_elt)) children

let pp pp_elt ppf threads =
  Fmt.(list ~sep:sp (pp_node pp_elt)) ppf threads