MrMime_resent.Encoder

struct
  open Encoder

  let rec w_lst w_sep w_data l =
    let open Wrap in
      let rec aux = function
      | [] -> noop
      | [ x ] -> w_data x
      | x :: r -> w_data x $ w_sep $ aux r
    in aux l

  let w_crlf k e = string "\r\n" k e

  let w_field = function
    | `ResentCc l ->
      string "Resent-Cc: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_addresses l $ close_box) (unlift k))))
      $ w_crlf
    | `ResentMessageID m ->
      string "Resent-Message-ID: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ MsgID.Encoder.w_msg_id m $ close_box) (unlift k))))
      $ w_crlf
    | `ResentSender p ->
      string "Resent-Sender: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_mailbox p $ close_box) (unlift k))))
      $ w_crlf
    | `ResentBcc l ->
      string "Resent-Bcc: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_addresses l $ close_box) (unlift k))))
      $ w_crlf
    | `ResentFrom l ->
      string "Resent-From: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ w_lst (string "," $ space) Address.Encoder.w_mailbox l $ close_box) (unlift k))))
      $ w_crlf
    | `ResentReplyTo l ->
      string "Resent-Reply-To: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_addresses l $ close_box) (unlift k))))
      $ w_crlf
    | `ResentDate d ->
      string "Resent-Date: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Date.Encoder.w_date d $ close_box) (unlift k))))
      $ w_crlf
    | `ResentTo l ->
      string "Resent-To: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_addresses l $ close_box) (unlift k))))
      $ w_crlf

  let w_resent { date; from; sender; to'; cc; bcc; msg_id; reply_to; } =
    (match date with Some v -> w_field (`ResentDate v) | None -> noop)
    $ (match from with [] -> noop | v -> w_field (`ResentFrom v))
    $ (match sender with Some v -> w_field (`ResentSender v) | None -> noop)
    $ (match to' with [] -> noop | v -> w_field (`ResentTo v))
    $ (match cc with [] -> noop | v -> w_field (`ResentCc v))
    $ (match bcc with [] -> noop | v -> w_field (`ResentBcc v))
    $ (match msg_id with Some v -> w_field (`ResentMessageID v) | None -> noop)
    $ (match reply_to with [] -> noop | v -> w_field (`ResentReplyTo v))
end