Source file `forward_path.ml`

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
type t =
  | Postmaster
  | Domain of Domain.t
  | Forward_path of Path.t

let pp ppf = function
  | Postmaster -> Fmt.string ppf "<Postmaster>"
  | Domain domain -> Fmt.pf ppf "<Postmaster@%a>" Domain.pp domain
  | Forward_path path -> Fmt.pf ppf "forward-path:%a" Path.pp path

let equal a b = match a, b with
  | Postmaster, Postmaster -> true
  | Domain a, Domain b -> Domain.equal a b
  | Forward_path a, Forward_path b -> Path.equal a b
  | _, _ -> false

let compare a b =
  let inf = (-1) and sup = 1 in
  match a, b with
  | Postmaster, Postmaster -> 0
  | Domain a, Domain b -> Domain.compare a b
  | Forward_path a, Forward_path b -> Path.compare a b
  | Postmaster, _ -> sup
  | (Forward_path _ | Domain _), Postmaster -> inf
  | Domain _, _ -> sup
  | Forward_path _, Domain _ -> inf

module Decoder = struct
  open Angstrom

  let forward_path = Path.Decoder.path
  let mail_parameters = Reverse_path.Decoder.mail_parameters

  let of_string x =
    let p =
      (string "<Postmaster@" *> Domain.Decoder.domain <* char '>' >>| fun domain -> Domain domain)
      <|> (string "<Postmaster>" *> return Postmaster)
      <|> (forward_path >>| fun path -> Forward_path path) in
    let p = p
      >>= fun forward_path -> (option [] (char ' ' *> mail_parameters))
      >>| fun parameters -> (forward_path, parameters) in
    match parse_string ~consume:Consume.All p x with
    | Ok v -> v
    | Error _ -> Fmt.invalid_arg "Invalid forward-path: %s" x
end

module Encoder = struct
  let to_string = function
    | Postmaster -> "<Postmaster>"
    | Domain domain -> Fmt.strf "<Postmaster@%s>" (Domain.to_string domain)
    | Forward_path path -> Path.Encoder.to_string path
end