-USING: kernel ;
-IN:
-irc.client.private
-: me? ( string -- ? )
- "factorbot" = ;
-
-USING: irc.client irc.client.private kernel tools.test accessors arrays ;
+USING: kernel tools.test accessors arrays sequences qualified
+ io.streams.string io.streams.duplex namespaces
+ irc.client.private ;
+EXCLUDE: irc.client => join ;
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
+ "PRIVMSG" >>command
+ { "#factortest" } >>parameters
+ "hi" >>trailing
+1array
[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
string>irc-message f >>timestamp ] unit-test
privmsg new
":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
"someuser!n=user@some.where" >>prefix
- "PRIVMSG" >>command
- { "#factortest" } >>parameters
- "hi" >>trailing
- "#factortest" >>name 1array
+ "PRIVMSG" >>command
+ { "#factortest" } >>parameters
+ "hi" >>trailing
+ "#factortest" >>name
+1array
[ ":someuser!n=user@some.where PRIVMSG #factortest :hi"
parse-irc-line f >>timestamp ] unit-test
-{ "someuser" } [ "someuser!n=user@some.where"
- parse-name ] unit-test
+{ "" } make-client dup nick>> "factorbot" >>name drop current-irc-client [
+ { 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
-{ "#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
-{ "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
- parse-irc-line irc-message-origin ] unit-test
+! Client tests
+{ } [ { "" } make-client connect-irc ] unit-test
\ No newline at end of file
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
! ======================================
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 )
" 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
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
! ======================================
! 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* ;
] 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 ;