irc.client: Some fixes and improvments, more tests

extra/irc/client/client-tests.factor

@@ -1,18 +1,28 @@
-USING: kernel ;
+USING: kernel tools.test accessors arrays sequences qualified
-IN:
+       io.streams.string io.streams.duplex namespaces
-irc.client.private
+       irc.client.private ;
-: me? ( string -- ? )
+EXCLUDE: irc.client => join ;
-    "factorbot" = ;
-
-USING: irc.client irc.client.private kernel tools.test accessors arrays ;
 IN: irc.client.tests
 
+! Utilities
+: <test-stream> ( lines -- stream )
+  "\n" join <string-reader> <string-writer> <duplex-stream> ;
+
+: make-client ( lines -- irc-client )
+   "someserver" irc-port "factorbot" f <irc-profile> <irc-client>
+   swap [ 2nip <test-stream> f ] curry >>connect ;
+
+: with-dummy-client ( quot -- )
+     rot with-variable ; inline
+
+! Parsing tests
 irc-message new
     ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
     "someuser!n=user@some.where" >>prefix
                        "PRIVMSG" >>command
                { "#factortest" } >>parameters
-    "hi" >>trailing 1array
+                            "hi" >>trailing
+1array
 [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
   string>irc-message f >>timestamp ] unit-test
 
@@ -22,15 +32,24 @@ privmsg new
                        "PRIVMSG" >>command
                { "#factortest" } >>parameters
                             "hi" >>trailing
-    "#factortest" >>name 1array
+                   "#factortest" >>name
+1array
 [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
   parse-irc-line f >>timestamp ] unit-test
 
-{ "someuser" } [ "someuser!n=user@some.where"
+{ "" } make-client dup nick>> "factorbot" >>name drop current-irc-client [
-                 parse-name ] unit-test
+    { t } [ irc-client> nick>> name>> me? ] unit-test
+
+    { "factorbot" } [ irc-client> nick>> name>> ] unit-test
+
+    { "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
 
     { "#factortest" } [ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
                         parse-irc-line irc-message-origin ] unit-test
 
     { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
                      parse-irc-line irc-message-origin ] unit-test
+] with-variable
+
+! Client tests
+{ } [ { "" } make-client connect-irc ] unit-test

extra/irc/client/client.factor

@@ -3,7 +3,7 @@
 USING: arrays combinators concurrency.mailboxes concurrency.futures io
        io.encodings.8-bit io.sockets kernel namespaces sequences
        sequences.lib splitting threads calendar classes.tuple
-       classes ascii assocs accessors destructors ;
+       classes ascii assocs accessors destructors continuations ;
 IN: irc.client
 
 ! ======================================
@@ -26,10 +26,11 @@ TUPLE: nick name channels log ;
 C: <nick> nick
 
 TUPLE: irc-client profile nick stream in-messages out-messages join-messages
-       listeners is-running ;
+       listeners is-running connect ;
 : <irc-client> ( profile -- irc-client )
     f V{ } clone V{ } clone <nick>
-    f <mailbox> <mailbox> <mailbox> H{ } clone f irc-client boa ;
+    f <mailbox> <mailbox> <mailbox> H{ } clone f
+    [ <inet> latin1 <client> ] irc-client boa ;
 
 TUPLE: irc-listener in-messages out-messages ;
 : <irc-listener> ( -- irc-listener )
@@ -79,7 +80,7 @@ TUPLE: unhandled < irc-message ;
     " hostname servername :irc.factor" irc-print ;
 
 : /CONNECT ( server port -- stream )
-    <inet> latin1 <client> drop ;
+    irc-client> connect>> call drop ;
 
 : /JOIN ( channel password -- )
     "JOIN " irc-write
@@ -183,6 +184,9 @@ M: privmsg handle-incoming-irc ( privmsg -- )
 M: join handle-incoming-irc ( join -- )
     irc-client> join-messages>> mailbox-put ;
 
+M: irc-end handle-incoming-irc ( irc-end -- )
+    irc-client> listeners>> values [ in-messages>> mailbox-put ] with each ;
+
 ! ======================================
 ! Client message handling
 ! ======================================
@@ -196,6 +200,9 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
 ! Reader/Writer
 ! ======================================
 
+: irc-mailbox-get ( mailbox quot -- )
+    swap 5 seconds  [ mailbox-get-timeout swap call ] 3curry [ drop ] recover ;
+
 : stream-readln-or-close ( stream -- str/f )
     dup stream-readln [ nip ] [ dispose f ] if* ;
 
@@ -213,14 +220,14 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
     ] if* ;
 
 : writer-loop ( -- )
-    irc-client> out-messages>> mailbox-get handle-outgoing-irc ;
+    irc-client> out-messages>> [ handle-outgoing-irc ] irc-mailbox-get ;
 
 ! ======================================
 ! Processing loops
 ! ======================================
 
 : in-multiplexer-loop ( -- )
-    irc-client> in-messages>> mailbox-get handle-incoming-irc ;
+    irc-client> in-messages>> [ handle-incoming-irc ] irc-mailbox-get ;
 
 : maybe-annotate-with-name ( name obj -- obj )
     dup privmsg instance? [ swap >>name ] [ nip ] if ;