add algorithm parsing user mode strings

lib/irc/mode.ml

@@ -109,6 +109,49 @@ module Set = struct
 end
 
 
+module Parse = struct
+  exception Error
+
+  let fail fmt =
+    Format.kasprintf (fun _ -> raise Error) fmt
+
+  type user_mode_set = {
+    add : Set.t;
+    rem : Set.t;
+  }
+
+  let pp_user_mode_set ppf { add; rem } = match add, rem with
+    | _, 0 -> Format.fprintf ppf "+%a" Set.pp add
+    | 0, _ -> Format.fprintf ppf "-%a" Set.pp rem
+    | _, _ -> Format.fprintf ppf "+%a-%a" Set.pp add Set.pp rem
+
+  let parse_mode_set str ~of_char ~add ~rem ~init =
+    let rec loop dir acc i =
+      if i >= String.length str then acc
+      else match str.[i] with
+        | '+' -> loop `add acc (i + 1)
+        | '-' -> loop `rem acc (i + 1)
+        | _ ->
+          let mode = try of_char str.[i]
+            with Invalid_argument _ ->
+              fail "unrecognized mode char"
+          in
+          match dir with
+          | `add -> loop dir (add acc mode) (i + 1)
+          | `rem -> loop dir (rem acc mode) (i + 1)
+          | `none -> fail "mode must start with + or -"
+    in
+    loop `none init 0
+
+  let user str =
+    parse_mode_set str
+      ~of_char:of_char_user
+      ~init:{ add = Set.empty; rem = Set.empty }
+      ~add:(fun ms m -> { add = Set.add m ms.add; rem = Set.remove m ms.rem })
+      ~rem:(fun ms m -> { add = Set.remove m ms.add; rem = Set.add m ms.rem })
+end
+
+
 let%expect_test _ =
   let roundtrip of_char_x m =
     match of_char_x (to_char m) with
@@ -143,3 +186,22 @@ let%expect_test _ =
   print_bool_nl (Set.(mem `w (of_string "ins"))); [%expect "false"];
   print_bool_nl (Set.(mem `w (of_string "wwww"))); [%expect "true"];
   print_bool_nl (Set.(mem `t (of_string "imnosw"))); [%expect "false"];
+
+  let print_user_mode_set_nl um =
+    Format.printf "%a\n" Parse.pp_user_mode_set um
+  in
+
+  let expect_parse_error f =
+    try f () |> ignore; print_endline "no error"
+    with Parse.Error -> ()
+       | e -> print_endline (Printexc.to_string e)
+  in
+
+  print_user_mode_set_nl (Parse.user "+iw"); [%expect {| +iw |}];
+  print_user_mode_set_nl (Parse.user "-wo"); [%expect {| -ow |}];
+  print_user_mode_set_nl (Parse.user "+i-w"); [%expect {| +i-w |}];
+  print_user_mode_set_nl (Parse.user "-i+w"); [%expect {| +w-i |}];
+  print_user_mode_set_nl (Parse.user "+i-i"); [%expect {| -i |}];
+  print_user_mode_set_nl (Parse.user "-o+o"); [%expect {| +o |}];
+  expect_parse_error (fun () -> Parse.user "+b");
+  expect_parse_error (fun () -> Parse.user "w");

lib/irc/mode.mli

@@ -57,3 +57,24 @@ module Set : sig
   val to_list  : t -> elt list
   val of_list : [< elt] list -> t
 end
+
+module Parse : sig
+  exception Error
+
+  type user_mode_set = {
+    add : Set.t;
+    rem : Set.t;
+  }
+
+  val pp_user_mode_set : Format.formatter -> user_mode_set -> unit
+
+  val user : string -> user_mode_set
+
+  (* type ('a, 'b) add_rem = Add of 'a | Rem of 'b *)
+  (* type chan_mode_set = *)
+  (*   | A of chan_a * (string, string option) add_rem *)
+  (*   | B of chan_b * (string, string) add_rem *)
+  (*   | C of chan_c * (string, unit) add_rem *)
+  (*   | D of chan_d * (unit, unit) add_rem *)
+  (* val chan : string -> chan_mode_set list *)
+end