talircd/lib/irc/mode.ml

type user = [`i | `o | `w]
type chan_a = [`b]
type chan_b = [`k | `o | `v]
type chan_c = [`l]
type chan_d = [`i | `m | `s | `t | `n]
type chan = [chan_a | chan_b | chan_c | chan_d]
type t = [user | chan]

let to_string = function
  | `b -> "b"
  | `i -> "i"
  | `k -> "k"
  | `l -> "l"
  | `m -> "m"
  | `n -> "n"
  | `o -> "o"
  | `s -> "s"
  | `t -> "t"
  | `v -> "v"
  | `w -> "w"

let to_char x = (to_string x).[0]
let pp ppf x = Format.pp_print_string ppf (to_string x)

let of_char_user = function
  | 'i' -> `i
  | 'o' -> `o
  | 'w' -> `w
  | _ -> invalid_arg "Mode.of_char_user"

let of_char_chan = function
  | 'b' -> `b
  | 'i' -> `i
  | 'k' -> `k
  | 'l' -> `l
  | 'm' -> `m
  | 'n' -> `n
  | 'o' -> `o
  | 's' -> `s
  | 't' -> `t
  | 'v' -> `v
  | _ -> invalid_arg "Mode.of_char_chan"

let[@warning "+8"] _check_exhaustive (x : chan) =
  match x with
  | #chan_a -> ()
  | #chan_b -> ()
  | #chan_c -> ()
  | #chan_d -> ()

let%expect_test _ =
  let roundtrip of_char_x m =
    match of_char_x (to_char m) with
    | m' when m = m' -> ()
    | m' -> Printf.printf "fail:%s!=%s\n" (to_string m) (to_string m')
    | exception Invalid_argument _ -> Printf.printf "error:%s\n" (to_string m)
  in
  let roundtrip_user m = roundtrip of_char_user m in
  let roundtrip_chan m = roundtrip of_char_chan m in

  roundtrip_user `i;
  roundtrip_user `w;
  roundtrip_chan `i;
  roundtrip_chan `k;
  roundtrip_chan `l;
  roundtrip_chan `m;
  roundtrip_chan `n;
  roundtrip_chan `o;
  roundtrip_chan `s;
  roundtrip_chan `t;