MrMime_trace.Encoder

struct
  open Encoder

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

  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_field' = function
    | `Received (l, Some date) ->
      let w_data = function
        | `Word word -> Address.Encoder.w_word word
        | `Domain domain -> Address.Encoder.w_domain domain
        | `Addr addr -> Address.Encoder.w_mailbox' addr
      in
      string "Received: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ w_lst space w_data l $ close_box
                               $ hovbox 0 $ string ";" $ space $ Date.Encoder.w_date date $ close_box) (unlift k))))
      $ w_crlf
    | `Received (l, None) ->
      let w_data = function
        | `Word word -> Address.Encoder.w_word word
        | `Domain domain -> Address.Encoder.w_domain domain
        | `Addr addr -> Address.Encoder.w_mailbox' addr
      in
      string "Received: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ w_lst space w_data l $ close_box) (unlift k))))
      $ w_crlf
    | `ReturnPath (Some m) ->
      string  "Return-Path: "
      $ (fun k -> Wrap.(lift ((hovbox 0 $ Address.Encoder.w_mailbox' m $ close_box) (unlift k))))
      $ w_crlf
    | `ReturnPath None ->
      string "Return-Path: < >" $ w_crlf

  let w_field = function
    | `Trace (Some trace, received) ->
      w_field' (`ReturnPath (Some trace))
      $ List.fold_right (fun x acc -> w_field' (`Received x) $ acc) received noop
    | `Trace (None, received) ->
      List.fold_right (fun x acc -> w_field' (`Received x) $ acc) received noop

  let w_trace { trace; received; } =
    w_field' (`ReturnPath trace)
    $ List.fold_right (fun x acc -> w_field' (`Received x) $ acc) received noop
end