create irc user modes module Irc.Mode

lib/irc/mode.ml

@@ -0,0 +1,89 @@
+type t = int
+
+let _o = 1
+let _a = 2
+let _w = 4
+let _i = 8
+let _r = 16
+let _O = 32
+let _s = 64
+
+let all ts = List.fold_left (lor) 0 ts
+let filter t u = t land u
+
+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 = function
+  | 'o' -> _o
+  | 'a' -> _a
+  | 'w' -> _w
+  | 'i' -> _i
+  | 'r' -> _r
+  | 'O' -> _O
+  | 's' -> _s
+  | _ -> 0
+
+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%expect_test _ =
+  let print_mode_nl m =
+    Format.kasprintf print_string "%a\n" pp 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 |}];

lib/irc/mode.mli

@@ -0,0 +1,40 @@
+type t
+
+val pp : Format.formatter -> t -> unit
+
+val _a : t
+(** a - user is flagged as away **)
+
+val _i : t
+(** i - marks a users as invisible **)
+
+val _w : t
+(** w - user receives wallops **)
+
+val _r : t
+(** r - restricted user connection **)
+
+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