new improved Irc.Mode.t utility
This commit is contained in:
parent
fbf9211b5f
commit
15a4475d3c
141
lib/irc/mode.ml
141
lib/irc/mode.ml
|
|
@ -1,89 +1,70 @@
|
|||
type t = int
|
||||
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 _o = 1
|
||||
let _a = 2
|
||||
let _w = 4
|
||||
let _i = 8
|
||||
let _r = 16
|
||||
let _O = 32
|
||||
let _s = 64
|
||||
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 all ts = List.fold_left (lor) 0 ts
|
||||
let filter t u = t land u
|
||||
let to_char x = (to_string x).[0]
|
||||
let pp ppf x = Format.pp_print_string ppf (to_string x)
|
||||
|
||||
let of_bitmask_string ?(allowed = 12) s =
|
||||
(* This parameter is a bitmask, with only 2 bits having any signification: if the bit 2
|
||||
is set, the user mode 'w' will be set and if the bit 3 is set, the user mode 'i' will
|
||||
be set. *)
|
||||
try filter (int_of_string s) allowed
|
||||
with Failure _ -> 0
|
||||
let of_char_user = function
|
||||
| 'i' -> `i
|
||||
| 'o' -> `o
|
||||
| 'w' -> `w
|
||||
| _ -> invalid_arg "Mode.of_char_user"
|
||||
|
||||
let of_char = function
|
||||
| 'o' -> _o
|
||||
| 'a' -> _a
|
||||
| 'w' -> _w
|
||||
| 'i' -> _i
|
||||
| 'r' -> _r
|
||||
| 'O' -> _O
|
||||
| 's' -> _s
|
||||
| _ -> 0
|
||||
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 pp ppf t =
|
||||
let f ch =
|
||||
if t land (of_char ch) <> 0 then
|
||||
Format.pp_print_char ppf ch
|
||||
in
|
||||
String.iter f "aiwroOs"
|
||||
|
||||
let rec of_string_rec s acc i =
|
||||
if i >= String.length s then
|
||||
acc
|
||||
else
|
||||
of_string_rec s (acc lor of_char s.[i]) (i + 1)
|
||||
|
||||
let of_string s =
|
||||
of_string_rec s 0 0
|
||||
|
||||
type diff = int
|
||||
|
||||
let pp_diff ppf d =
|
||||
if d < 0 then
|
||||
(Format.pp_print_string ppf "-"; pp ppf (-d))
|
||||
else
|
||||
(Format.pp_print_string ppf "+"; pp ppf d)
|
||||
|
||||
let ( ~+ ) m = Int.abs m
|
||||
let ( ~- ) m = Int.neg (~+ m)
|
||||
|
||||
let ( ^ ) t d =
|
||||
if d < 0 then
|
||||
Int.logand (Int.neg d |> Int.lognot) t
|
||||
else
|
||||
Int.logor d t
|
||||
|
||||
let diff_of_string s =
|
||||
if String.starts_with s ~prefix:"-" then
|
||||
- of_string_rec s 0 1
|
||||
else
|
||||
+ of_string s
|
||||
|
||||
;;
|
||||
let[@warning "+8"] _check_exhaustive (x : chan) =
|
||||
match x with
|
||||
| #chan_a -> ()
|
||||
| #chan_b -> ()
|
||||
| #chan_c -> ()
|
||||
| #chan_d -> ()
|
||||
|
||||
let%expect_test _ =
|
||||
let print_mode_nl m =
|
||||
Format.kasprintf print_string "%a\n" pp m
|
||||
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
|
||||
|
||||
print_mode_nl (_O); [%expect {| O |}];
|
||||
print_mode_nl (all [_o; _a]); [%expect {| ao |}];
|
||||
print_mode_nl (all [_i; _w; _i]); [%expect {| iw |}];
|
||||
print_mode_nl (all [_o; _a]); [%expect {| ao |}];
|
||||
print_mode_nl (all [_o; _a] ^ +_w); [%expect {| awo |}];
|
||||
print_mode_nl (all [_o; _a; _i] ^ -_o); [%expect {| ai |}];
|
||||
|
||||
print_mode_nl (of_string "awrO"); [%expect {| awrO |}];
|
||||
print_mode_nl (of_string "is"); [%expect {| is |}];
|
||||
print_mode_nl (of_bitmask_string "0"); [%expect {| |}];
|
||||
print_mode_nl (of_bitmask_string "4"); [%expect {| w |}];
|
||||
print_mode_nl (of_bitmask_string "8"); [%expect {| i |}];
|
||||
print_mode_nl (of_bitmask_string "12"); [%expect {| iw |}];
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -1,40 +1,38 @@
|
|||
type t
|
||||
(*
|
||||
User Modes:
|
||||
+i Invisible User Mode
|
||||
+o Oper User Mode
|
||||
+w WALLOPS User Mode
|
||||
|
||||
val pp : Format.formatter -> t -> unit
|
||||
Channel Modes:
|
||||
Type A:
|
||||
+b Ban Channel Mode
|
||||
|
||||
val _a : t
|
||||
(** a - user is flagged as away **)
|
||||
Type B:
|
||||
+k Key Channel Mode
|
||||
+o Operator Channel Membership Prefix (@)
|
||||
+v Voice Channel Membership Prefix (+)
|
||||
|
||||
val _i : t
|
||||
(** i - marks a users as invisible **)
|
||||
Type C:
|
||||
+l Client Limit Channel Mode
|
||||
|
||||
val _w : t
|
||||
(** w - user receives wallops **)
|
||||
Type D:
|
||||
+i Invite-Only Channel Mode
|
||||
+m Moderated Channel Mode
|
||||
+s Secret Channel Mode
|
||||
+t Protected Topic Channel Mode
|
||||
+n No External Messages Mode
|
||||
*)
|
||||
|
||||
val _r : t
|
||||
(** r - restricted user connection **)
|
||||
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]
|
||||
|
||||
val _o : t
|
||||
(** o - operator flag **)
|
||||
|
||||
val _O : t
|
||||
(** O - local operator flag **)
|
||||
|
||||
val _s : t
|
||||
(** s - marks a user for receipt of server notices **)
|
||||
|
||||
val all : t list -> t
|
||||
val filter : t -> t -> t
|
||||
|
||||
val of_char : char -> t
|
||||
val of_string : string -> t
|
||||
val of_bitmask_string : ?allowed:t -> string -> t
|
||||
|
||||
type diff
|
||||
|
||||
val pp_diff : Format.formatter -> t -> unit
|
||||
|
||||
val ( ~+ ) : t -> diff
|
||||
val ( ~- ) : t -> diff
|
||||
val ( ^ ) : t -> diff -> t
|
||||
val diff_of_string : string -> t
|
||||
val pp : Format.formatter -> [< t] -> unit
|
||||
val to_char : [< t] -> char
|
||||
val of_char_user : char -> [> user]
|
||||
val of_char_chan : char -> [> chan]
|
||||
|
|
|
|||
Loading…
Reference in New Issue