From 15a4475d3c3fd3802b52a8ba4dd5da0fee11f208 Mon Sep 17 00:00:00 2001 From: tali Date: Wed, 10 Jan 2024 19:11:50 -0500 Subject: [PATCH] new improved Irc.Mode.t utility --- lib/irc/mode.ml | 141 ++++++++++++++++++++--------------------------- lib/irc/mode.mli | 66 +++++++++++----------- 2 files changed, 93 insertions(+), 114 deletions(-) diff --git a/lib/irc/mode.ml b/lib/irc/mode.ml index fc51241..cd6003b 100644 --- a/lib/irc/mode.ml +++ b/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; diff --git a/lib/irc/mode.mli b/lib/irc/mode.mli index c4c2c55..75998d3 100644 --- a/lib/irc/mode.mli +++ b/lib/irc/mode.mli @@ -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]