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 to_string = function
|
||||||
let _a = 2
|
| `b -> "b"
|
||||||
let _w = 4
|
| `i -> "i"
|
||||||
let _i = 8
|
| `k -> "k"
|
||||||
let _r = 16
|
| `l -> "l"
|
||||||
let _O = 32
|
| `m -> "m"
|
||||||
let _s = 64
|
| `n -> "n"
|
||||||
|
| `o -> "o"
|
||||||
|
| `s -> "s"
|
||||||
|
| `t -> "t"
|
||||||
|
| `v -> "v"
|
||||||
|
| `w -> "w"
|
||||||
|
|
||||||
let all ts = List.fold_left (lor) 0 ts
|
let to_char x = (to_string x).[0]
|
||||||
let filter t u = t land u
|
let pp ppf x = Format.pp_print_string ppf (to_string x)
|
||||||
|
|
||||||
let of_bitmask_string ?(allowed = 12) s =
|
let of_char_user = function
|
||||||
(* This parameter is a bitmask, with only 2 bits having any signification: if the bit 2
|
| 'i' -> `i
|
||||||
is set, the user mode 'w' will be set and if the bit 3 is set, the user mode 'i' will
|
| 'o' -> `o
|
||||||
be set. *)
|
| 'w' -> `w
|
||||||
try filter (int_of_string s) allowed
|
| _ -> invalid_arg "Mode.of_char_user"
|
||||||
with Failure _ -> 0
|
|
||||||
|
|
||||||
let of_char = function
|
let of_char_chan = function
|
||||||
| 'o' -> _o
|
| 'b' -> `b
|
||||||
| 'a' -> _a
|
| 'i' -> `i
|
||||||
| 'w' -> _w
|
| 'k' -> `k
|
||||||
| 'i' -> _i
|
| 'l' -> `l
|
||||||
| 'r' -> _r
|
| 'm' -> `m
|
||||||
| 'O' -> _O
|
| 'n' -> `n
|
||||||
| 's' -> _s
|
| 'o' -> `o
|
||||||
| _ -> 0
|
| 's' -> `s
|
||||||
|
| 't' -> `t
|
||||||
|
| 'v' -> `v
|
||||||
|
| _ -> invalid_arg "Mode.of_char_chan"
|
||||||
|
|
||||||
let pp ppf t =
|
let[@warning "+8"] _check_exhaustive (x : chan) =
|
||||||
let f ch =
|
match x with
|
||||||
if t land (of_char ch) <> 0 then
|
| #chan_a -> ()
|
||||||
Format.pp_print_char ppf ch
|
| #chan_b -> ()
|
||||||
in
|
| #chan_c -> ()
|
||||||
String.iter f "aiwroOs"
|
| #chan_d -> ()
|
||||||
|
|
||||||
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%expect_test _ =
|
let%expect_test _ =
|
||||||
let print_mode_nl m =
|
let roundtrip of_char_x m =
|
||||||
Format.kasprintf print_string "%a\n" pp 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
|
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 |}];
|
roundtrip_user `i;
|
||||||
print_mode_nl (all [_o; _a]); [%expect {| ao |}];
|
roundtrip_user `w;
|
||||||
print_mode_nl (all [_i; _w; _i]); [%expect {| iw |}];
|
roundtrip_chan `i;
|
||||||
print_mode_nl (all [_o; _a]); [%expect {| ao |}];
|
roundtrip_chan `k;
|
||||||
print_mode_nl (all [_o; _a] ^ +_w); [%expect {| awo |}];
|
roundtrip_chan `l;
|
||||||
print_mode_nl (all [_o; _a; _i] ^ -_o); [%expect {| ai |}];
|
roundtrip_chan `m;
|
||||||
|
roundtrip_chan `n;
|
||||||
print_mode_nl (of_string "awrO"); [%expect {| awrO |}];
|
roundtrip_chan `o;
|
||||||
print_mode_nl (of_string "is"); [%expect {| is |}];
|
roundtrip_chan `s;
|
||||||
print_mode_nl (of_bitmask_string "0"); [%expect {| |}];
|
roundtrip_chan `t;
|
||||||
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 |}];
|
|
||||||
|
|
|
||||||
|
|
@ -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
|
Type B:
|
||||||
(** a - user is flagged as away **)
|
+k Key Channel Mode
|
||||||
|
+o Operator Channel Membership Prefix (@)
|
||||||
|
+v Voice Channel Membership Prefix (+)
|
||||||
|
|
||||||
val _i : t
|
Type C:
|
||||||
(** i - marks a users as invisible **)
|
+l Client Limit Channel Mode
|
||||||
|
|
||||||
val _w : t
|
Type D:
|
||||||
(** w - user receives wallops **)
|
+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
|
type user = [`i | `o | `w]
|
||||||
(** r - restricted user connection **)
|
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
|
val pp : Format.formatter -> [< t] -> unit
|
||||||
(** o - operator flag **)
|
val to_char : [< t] -> char
|
||||||
|
val of_char_user : char -> [> user]
|
||||||
val _O : t
|
val of_char_chan : char -> [> chan]
|
||||||
(** 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
|
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue