beefed up Irc.Msg.prefix

lib/irc/irc.ml

@@ -0,0 +1,3 @@
+module Msg = Msg
+module Mode = Mode
+include Types

lib/irc/msg.ml

@@ -1,5 +1,30 @@
+open Types
+
+type prefix =
+  | No_prefix
+  | Server_prefix of string
+  | User_prefix of nick * userinfo option * string option
+
+let pp_userinfo_opt ppf = function
+  | None -> ()
+  | Some { username; _ } -> Format.fprintf ppf "!%s" username
+
+let pp_hostname_opt ppf = function
+  | None -> ()
+  | Some hostname -> Format.fprintf ppf "@%s" hostname
+
+let prefix_string = function
+  | No_prefix -> ""
+  | Server_prefix s -> s
+  | User_prefix (nick, uinfo, host) ->
+    Format.asprintf "%s%a%a"
+      nick pp_userinfo_opt uinfo pp_hostname_opt host
+
+let pp_prefix ppf p =
+  Format.fprintf ppf "%S" (prefix_string p)
+
 type t = {
-  prefix : string option;
+  prefix : prefix;
   command : string;
   params : string list;
   trailing : bool;
@@ -10,17 +35,16 @@ let rec is_params_trailing = function
   | [tr] -> String.contains tr ' '
   | _ :: tl -> is_params_trailing tl
 
-let make ?prefix ?(always_trailing = false) command params =
+let make ?(prefix = No_prefix) ?(always_trailing = false) command params =
   let trailing = always_trailing || is_params_trailing params in
   { prefix; command; params; trailing }
 
 let write buf t =
-  Option.iter
+  if t.prefix <> No_prefix then begin
-    (fun pre ->
     Buffer.add_char buf ':';
-       Buffer.add_string buf pre;
+    Buffer.add_string buf (prefix_string t.prefix);
-       Buffer.add_char buf ' ')
+    Buffer.add_char buf ' ';
-    t.prefix;
+  end;
   Buffer.add_string buf t.command;
   let rec add_params = function
     | [] -> ()
@@ -38,11 +62,11 @@ let write buf t =
 exception Empty_message of int
 exception Incomplete
 
-let crlf = function '\r' | '\n' -> true | _ -> false
+let crlf = function '\r' | '\n' | '\x00' -> true | _ -> false
 let cl = function ':' -> true | _ -> false
 let sp = function ' ' -> true | _ -> false
-let nocrlf = function '\r' | '\n' -> false | _ -> true
+let nocrlf = function '\r' | '\n' | '\x00' -> false | _ -> true
-let nospcrlf = function ' ' | '\r' | '\n' -> false | _ -> true
+let nospcrlf = function ' ' | '\r' | '\n' | '\x00' -> false | _ -> true
 
 let startswith str f i =
   if i >= String.length str then
@@ -63,9 +87,11 @@ let parse str =
   let parse_prefix i =
     if startswith str cl i then
       let i, pfx = span str nospcrlf (i + 1) in
-      i, Some pfx
+      (* TODO: parse [User_prefix] *)
+      (* not really needed because prefixes from clients are always ignored *)
+      i, Server_prefix pfx
     else
-      i, None
+      i, No_prefix
   in
 
   let parse_command i =
@@ -93,7 +119,7 @@ let parse str =
     let i, prefix = parse_prefix i in
     let i, command = parse_command i in
     let i, params, always_trailing = parse_params [] i in
-    let msg = make command params ?prefix ~always_trailing in
+    let msg = make command params ~prefix ~always_trailing in
     i, msg
   in
 
@@ -123,27 +149,44 @@ let%expect_test _ =
     Format.printf "%S\n" rest
   in
 
+  Format.printf "%a" pp_prefix No_prefix;
+  [%expect {| "" |}];
+
+  Format.printf "%a" pp_prefix (Server_prefix "localhost");
+  [%expect {| "localhost" |}];
+
+  Format.printf "%a" pp_prefix (User_prefix ("tali", None, None));
+  [%expect {| "tali" |}];
+
+  Format.printf "%a" pp_prefix (User_prefix ("tali", None, Some "elsewhere"));
+  [%expect {| "tali@elsewhere" |}];
+
+  let milo = { username = "milo"; realname = "Milo" } in
+  Format.printf "%a" pp_prefix (User_prefix ("tali", Some milo, Some "elsewhere"));
+  [%expect {| "tali!milo@elsewhere" |}];
+
   make "NICK" ["tali"] |> print_msg_nl;
   [%expect {| "NICK tali\r\n" |}];
 
   make "USER" ["milo"; "0"; "*"; "milo"] ~always_trailing:true |> print_msg_nl;
   [%expect {| "USER milo 0 * :milo\r\n" |}];
 
-  make "001" ["tali"; "Welcome to the IRC Network"] ~prefix:"localhost" |> print_msg_nl;
+  let lo = Server_prefix "localhost" in
+  make "001" ["tali"; "Welcome to the IRC Network"] ~prefix:lo |> print_msg_nl;
   [%expect {| ":localhost 001 tali :Welcome to the IRC Network\r\n" |}];
 
-  parse ":source  usEr  tali  0  *  iitalics\r\n" |> print_parsed_msgs;
+  parse ":server.com  usEr  tali  0  *  iitalics\r\n" |> print_parsed_msgs;
   [%expect {|
-    { prefix = (Some "source"); command = "USER";
+    { prefix = "server.com"; command = "USER";
       params = ["tali"; "0"; "*"; "iitalics"]; trailing = false }
     ""
   |}];
 
   parse "PRIVMSG #lol :Hello world\r\nPRIVMSG #lol :meow\r\nPRIVM" |> print_parsed_msgs;
   [%expect {|
-    { prefix = None; command = "PRIVMSG"; params = ["#lol"; "Hello world"];
+    { prefix = ""; command = "PRIVMSG"; params = ["#lol"; "Hello world"];
       trailing = true }
-    { prefix = None; command = "PRIVMSG"; params = ["#lol"; "meow"];
+    { prefix = ""; command = "PRIVMSG"; params = ["#lol"; "meow"];
       trailing = true }
     "PRIVM"
   |}];
@@ -153,7 +196,7 @@ let%expect_test _ =
 
   parse ":ignore-me \r\nFOO\r\n" |> print_parsed_msgs;
   [%expect {|
-    { prefix = None; command = "FOO"; params = []; trailing = false }
+    { prefix = ""; command = "FOO"; params = []; trailing = false }
     ""
   |}];
   

lib/irc/msg.mli

@@ -1,5 +1,14 @@
+open Types
+
+type prefix =
+  | No_prefix
+  | Server_prefix of string
+  | User_prefix of nick * userinfo option * string option
+
+val prefix_string : prefix -> string
+
 type t = {
-  prefix : string option;
+  prefix : prefix;
   command : string;
   params : string list;
   trailing : bool;
@@ -7,7 +16,7 @@ type t = {
 
 val pp : Format.formatter -> t -> unit
 
-val make : ?prefix:string -> ?always_trailing:bool ->
+val make : ?prefix:prefix -> ?always_trailing:bool ->
   string -> string list -> t
 
 val write : Buffer.t -> t -> unit

lib/irc/types.ml

@@ -0,0 +1,2 @@
+type nick = string
+type userinfo = { username : string; realname : string }