(*---------------------------------------------------------------------------
   Copyright (c) 2025 Anil Madhavapeddy. All rights reserved.
   SPDX-License-Identifier: ISC
  ---------------------------------------------------------------------------*)

type t = {
  name : string;
  value : string;
}

let create ~name ~value = { name; value }

let name t = t.name
let value t = t.value

let make name value = { name; value }

let jsont =
  let kind = "EmailHeader" in
  Jsont.Object.map ~kind make
  |> Jsont.Object.mem "name" Jsont.string ~enc:name
  |> Jsont.Object.mem "value" Jsont.string ~enc:value
  |> Jsont.Object.finish

(* Header categories *)

type address_header = [
  | `From
  | `Sender
  | `Reply_to
  | `To
  | `Cc
  | `Bcc
  | `Resent_from
  | `Resent_sender
  | `Resent_reply_to
  | `Resent_to
  | `Resent_cc
  | `Resent_bcc
]

type message_id_header = [
  | `Message_id
  | `In_reply_to
  | `References
  | `Resent_message_id
]

type date_header = [
  | `Date
  | `Resent_date
]

type url_header = [
  | `List_help
  | `List_unsubscribe
  | `List_subscribe
  | `List_post
  | `List_owner
  | `List_archive
]

type text_header = [
  | `Subject
  | `Comments
  | `Keywords
  | `List_id
]

type standard_header = [
  | address_header
  | message_id_header
  | date_header
  | url_header
  | text_header
]

type custom_header = [ `Custom of string ]

type any_header = [ standard_header | custom_header ]

let standard_header_to_string : [< standard_header ] -> string = function
  | `From -> "From"
  | `Sender -> "Sender"
  | `Reply_to -> "Reply-To"
  | `To -> "To"
  | `Cc -> "Cc"
  | `Bcc -> "Bcc"
  | `Resent_from -> "Resent-From"
  | `Resent_sender -> "Resent-Sender"
  | `Resent_reply_to -> "Resent-Reply-To"
  | `Resent_to -> "Resent-To"
  | `Resent_cc -> "Resent-Cc"
  | `Resent_bcc -> "Resent-Bcc"
  | `Message_id -> "Message-ID"
  | `In_reply_to -> "In-Reply-To"
  | `References -> "References"
  | `Resent_message_id -> "Resent-Message-ID"
  | `Date -> "Date"
  | `Resent_date -> "Resent-Date"
  | `List_help -> "List-Help"
  | `List_unsubscribe -> "List-Unsubscribe"
  | `List_subscribe -> "List-Subscribe"
  | `List_post -> "List-Post"
  | `List_owner -> "List-Owner"
  | `List_archive -> "List-Archive"
  | `Subject -> "Subject"
  | `Comments -> "Comments"
  | `Keywords -> "Keywords"
  | `List_id -> "List-Id"

let standard_header_of_string s : standard_header option =
  match String.lowercase_ascii s with
  | "from" -> Some `From
  | "sender" -> Some `Sender
  | "reply-to" -> Some `Reply_to
  | "to" -> Some `To
  | "cc" -> Some `Cc
  | "bcc" -> Some `Bcc
  | "resent-from" -> Some `Resent_from
  | "resent-sender" -> Some `Resent_sender
  | "resent-reply-to" -> Some `Resent_reply_to
  | "resent-to" -> Some `Resent_to
  | "resent-cc" -> Some `Resent_cc
  | "resent-bcc" -> Some `Resent_bcc
  | "message-id" -> Some `Message_id
  | "in-reply-to" -> Some `In_reply_to
  | "references" -> Some `References
  | "resent-message-id" -> Some `Resent_message_id
  | "date" -> Some `Date
  | "resent-date" -> Some `Resent_date
  | "list-help" -> Some `List_help
  | "list-unsubscribe" -> Some `List_unsubscribe
  | "list-subscribe" -> Some `List_subscribe
  | "list-post" -> Some `List_post
  | "list-owner" -> Some `List_owner
  | "list-archive" -> Some `List_archive
  | "subject" -> Some `Subject
  | "comments" -> Some `Comments
  | "keywords" -> Some `Keywords
  | "list-id" -> Some `List_id
  | _ -> None

let any_header_to_string : [< any_header ] -> string = function
  | `Custom s -> s
  | #standard_header as h -> standard_header_to_string h

(* Header parsed forms *)

type form = [
  | `Raw
  | `Text
  | `Addresses
  | `Grouped_addresses
  | `Message_ids
  | `Date
  | `Urls
]

let form_to_string : [< form ] -> string = function
  | `Raw -> ""
  | `Text -> "asText"
  | `Addresses -> "asAddresses"
  | `Grouped_addresses -> "asGroupedAddresses"
  | `Message_ids -> "asMessageIds"
  | `Date -> "asDate"
  | `Urls -> "asURLs"

let form_of_string s : form option =
  match s with
  | "" -> Some `Raw
  | "asText" -> Some `Text
  | "asAddresses" -> Some `Addresses
  | "asGroupedAddresses" -> Some `Grouped_addresses
  | "asMessageIds" -> Some `Message_ids
  | "asDate" -> Some `Date
  | "asURLs" -> Some `Urls
  | _ -> None

(* Header property requests *)

type header_property =
  | Raw of { name : string; all : bool }
  | Text of { header : [ text_header | custom_header ]; all : bool }
  | Addresses of { header : [ address_header | custom_header ]; all : bool }
  | Grouped_addresses of { header : [ address_header | custom_header ]; all : bool }
  | Message_ids of { header : [ message_id_header | custom_header ]; all : bool }
  | Date of { header : [ date_header | custom_header ]; all : bool }
  | Urls of { header : [ url_header | custom_header ]; all : bool }

let header_name_of_property : header_property -> string = function
  | Raw { name; _ } -> name
  | Text { header; _ } -> any_header_to_string (header :> any_header)
  | Addresses { header; _ } -> any_header_to_string (header :> any_header)
  | Grouped_addresses { header; _ } -> any_header_to_string (header :> any_header)
  | Message_ids { header; _ } -> any_header_to_string (header :> any_header)
  | Date { header; _ } -> any_header_to_string (header :> any_header)
  | Urls { header; _ } -> any_header_to_string (header :> any_header)

let header_property_all : header_property -> bool = function
  | Raw { all; _ } -> all
  | Text { all; _ } -> all
  | Addresses { all; _ } -> all
  | Grouped_addresses { all; _ } -> all
  | Message_ids { all; _ } -> all
  | Date { all; _ } -> all
  | Urls { all; _ } -> all

let header_property_form : header_property -> form = function
  | Raw _ -> `Raw
  | Text _ -> `Text
  | Addresses _ -> `Addresses
  | Grouped_addresses _ -> `Grouped_addresses
  | Message_ids _ -> `Message_ids
  | Date _ -> `Date
  | Urls _ -> `Urls

let header_property_to_string prop =
  let name = header_name_of_property prop in
  let form = form_to_string (header_property_form prop) in
  let all_suffix = if header_property_all prop then ":all" else "" in
  let form_suffix = if form = "" then "" else ":" ^ form in
  "header:" ^ name ^ form_suffix ^ all_suffix

let header_property_of_string s : header_property option =
  if not (String.length s > 7 && String.sub s 0 7 = "header:") then
    None
  else
    let rest = String.sub s 7 (String.length s - 7) in
    (* Parse the parts: name[:form][:all] *)
    let parts = String.split_on_char ':' rest in
    match parts with
    | [] -> None
    | [name] ->
      Some (Raw { name; all = false })
    | [name; second] ->
      if second = "all" then
        Some (Raw { name; all = true })
      else begin
        match form_of_string second with
        | None -> None
        | Some `Raw -> Some (Raw { name; all = false })
        | Some `Text -> Some (Text { header = `Custom name; all = false })
        | Some `Addresses -> Some (Addresses { header = `Custom name; all = false })
        | Some `Grouped_addresses -> Some (Grouped_addresses { header = `Custom name; all = false })
        | Some `Message_ids -> Some (Message_ids { header = `Custom name; all = false })
        | Some `Date -> Some (Date { header = `Custom name; all = false })
        | Some `Urls -> Some (Urls { header = `Custom name; all = false })
      end
    | [name; form_str; "all"] ->
      begin match form_of_string form_str with
      | None -> None
      | Some `Raw -> Some (Raw { name; all = true })
      | Some `Text -> Some (Text { header = `Custom name; all = true })
      | Some `Addresses -> Some (Addresses { header = `Custom name; all = true })
      | Some `Grouped_addresses -> Some (Grouped_addresses { header = `Custom name; all = true })
      | Some `Message_ids -> Some (Message_ids { header = `Custom name; all = true })
      | Some `Date -> Some (Date { header = `Custom name; all = true })
      | Some `Urls -> Some (Urls { header = `Custom name; all = true })
      end
    | _ -> None

(* Convenience constructors *)

let raw ?(all=false) name = Raw { name; all }

let text ?(all=false) header = Text { header; all }

let addresses ?(all=false) header = Addresses { header; all }

let grouped_addresses ?(all=false) header = Grouped_addresses { header; all }

let message_ids ?(all=false) header = Message_ids { header; all }

let date ?(all=false) header = Date { header; all }

let urls ?(all=false) header = Urls { header; all }

(* Header values in responses *)

type header_value =
  | String_single of string option
  | String_all of string list
  | Addresses_single of Mail_address.t list option
  | Addresses_all of Mail_address.t list list
  | Grouped_single of Mail_address.Group.t list option
  | Grouped_all of Mail_address.Group.t list list
  | Date_single of Ptime.t option
  | Date_all of Ptime.t option list
  | Strings_single of string list option
  | Strings_all of string list option list

let header_value_jsont ~form ~all : header_value Jsont.t =
  match form, all with
  | (`Raw | `Text), false ->
    Jsont.map
      ~dec:(fun s -> String_single s)
      ~enc:(function String_single s -> s | _ -> None)
      (Jsont.option Jsont.string)
  | (`Raw | `Text), true ->
    Jsont.map
      ~dec:(fun l -> String_all l)
      ~enc:(function String_all l -> l | _ -> [])
      (Jsont.list Jsont.string)
  | `Addresses, false ->
    Jsont.map
      ~dec:(fun l -> Addresses_single l)
      ~enc:(function Addresses_single l -> l | _ -> None)
      (Jsont.option (Jsont.list Mail_address.jsont))
  | `Addresses, true ->
    Jsont.map
      ~dec:(fun l -> Addresses_all l)
      ~enc:(function Addresses_all l -> l | _ -> [])
      (Jsont.list (Jsont.list Mail_address.jsont))
  | `Grouped_addresses, false ->
    Jsont.map
      ~dec:(fun l -> Grouped_single l)
      ~enc:(function Grouped_single l -> l | _ -> None)
      (Jsont.option (Jsont.list Mail_address.Group.jsont))
  | `Grouped_addresses, true ->
    Jsont.map
      ~dec:(fun l -> Grouped_all l)
      ~enc:(function Grouped_all l -> l | _ -> [])
      (Jsont.list (Jsont.list Mail_address.Group.jsont))
  | `Message_ids, false ->
    Jsont.map
      ~dec:(fun l -> Strings_single l)
      ~enc:(function Strings_single l -> l | _ -> None)
      (Jsont.option (Jsont.list Jsont.string))
  | `Message_ids, true ->
    Jsont.map
      ~dec:(fun l -> Strings_all l)
      ~enc:(function Strings_all l -> l | _ -> [])
      (Jsont.list (Jsont.option (Jsont.list Jsont.string)))
  | `Date, false ->
    Jsont.map
      ~dec:(fun t -> Date_single t)
      ~enc:(function Date_single t -> t | _ -> None)
      (Jsont.option Proto_date.Rfc3339.jsont)
  | `Date, true ->
    Jsont.map
      ~dec:(fun l -> Date_all l)
      ~enc:(function Date_all l -> l | _ -> [])
      (Jsont.list (Jsont.option Proto_date.Rfc3339.jsont))
  | `Urls, false ->
    Jsont.map
      ~dec:(fun l -> Strings_single l)
      ~enc:(function Strings_single l -> l | _ -> None)
      (Jsont.option (Jsont.list Jsont.string))
  | `Urls, true ->
    Jsont.map
      ~dec:(fun l -> Strings_all l)
      ~enc:(function Strings_all l -> l | _ -> [])
      (Jsont.list (Jsont.option (Jsont.list Jsont.string)))

(* Low-level JSON codecs *)

let raw_jsont = Jsont.string

let text_jsont = Jsont.string

let addresses_jsont = Jsont.list Mail_address.jsont

let grouped_addresses_jsont = Jsont.list Mail_address.Group.jsont

let message_ids_jsont = Jsont.list Jsont.string

let date_jsont = Proto_date.Rfc3339.jsont

let urls_jsont = Jsont.list Jsont.string