USING: kernel tools.test accessors arrays sequences qualified
io.streams.string io.streams.duplex namespaces threads
calendar irc.client.private irc.client irc.messages.private
- concurrency.mailboxes classes ;
+ concurrency.mailboxes classes assocs ;
EXCLUDE: irc.messages => join ;
RENAME: join irc.messages => join_
IN: irc.client.tests
":some.where 001 factorbot :Welcome factorbot"
} make-client
[ connect-irc ] keep 1 seconds sleep
- profile>> nickname>> ] unit-test
+ profile>> nickname>> ] unit-test
{ join_ "#factortest" } [
{ ":factorbot!n=factorbo@some.where JOIN :#factortest"
":ircserver.net 477 factorbot #factortest :[ircserver-info] blah blah"
} make-client dup "factorbot" set-nick
[ connect-irc ] keep 1 seconds sleep
- join-messages>> 5 seconds mailbox-get-timeout
+ join-messages>> 1 seconds mailbox-get-timeout
[ class ] [ trailing>> ] bi ] unit-test
-! TODO: user join
-! ":somedude!n=user@isp.net JOIN :#factortest"
+
+{ +join+ "somebody" } [
+ { ":somebody!n=somebody@some.where JOIN :#factortest"
+ } make-client dup "factorbot" set-nick
+ [ listeners>> [ "#factortest" [ <irc-channel-listener> ] keep ] dip set-at ]
+ [ connect-irc ]
+ [ listeners>> [ "#factortest" ] dip at
+ [ read-message drop ] [ read-message drop ] [ read-message ] tri ] tri
+ [ action>> ] [ nick>> ] bi
+ ] unit-test
! TODO: channel message
-! ":somedude!n=user@isp.net PRIVMSG #factortest :hello"
+! ":somebody!n=somebody@some.where PRIVMSG #factortest :hello"
! TODO: direct private message
! ":somedude!n=user@isp.net PRIVMSG factorbot2 :hello"
\ No newline at end of file
SYMBOL: +voice+
SYMBOL: +normal+
-: participant-mode ( n -- assoc )
+: participant-mode ( n -- mode )
H{ { 64 +operator+ } { 43 +voice+ } { 0 +normal+ } } at ;
+! participant changed actions
+SYMBOL: +join+
+SYMBOL: +part+
+SYMBOL: +mode+
+
! listener objects
: <irc-listener> ( -- irc-listener ) <mailbox> <mailbox> irc-listener boa ;
! Message objects
! ======================================
+TUPLE: participant-changed nick action ;
+C: <participant-changed> participant-changed
+
SINGLETON: irc-end ! sent when the client isn't running anymore
SINGLETON: irc-disconnected ! sent when connection is lost
SINGLETON: irc-connected ! sent when connection is established
: listener> ( name -- listener/f ) irc> listeners>> at ;
: unregister-listener ( name -- ) irc> listeners>> delete-at ;
-: to-listener ( message name -- )
+GENERIC: to-listener ( message obj -- )
+
+M: string to-listener ( message string -- )
listener> [ +server-listener+ listener> ] unless*
- [ in-messages>> mailbox-put ] [ drop ] if* ;
+ [ to-listener ] [ drop ] if* ;
+
+M: irc-listener to-listener ( message irc-listener -- )
+ in-messages>> mailbox-put ;
: remove-participant ( nick channel -- )
listener> [ participants>> delete-at ] [ drop ] if* ;
+: listeners-with-participant ( nick -- seq )
+ irc> listeners>> values
+ [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ]
+ with filter ;
+
: remove-participant-from-all ( nick -- )
- irc> listeners>>
- [ irc-channel-listener? [ swap remove-participant ] [ 2drop ] if ] with
- assoc-each ;
+ dup listeners-with-participant [ delete-at ] with each ;
-: add-participant ( nick mode channel -- )
+: add-participant ( mode nick channel -- )
listener> [ participants>> set-at ] [ 2drop ] if* ;
DEFER: me?
dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
: broadcast-message-to-listeners ( message -- )
- irc> listeners>> values [ in-messages>> mailbox-put ] with each ;
+ irc> listeners>> values [ to-listener ] with each ;
+
+GENERIC: handle-participant-change ( irc-message -- )
+
+M: join handle-participant-change ( join -- )
+ [ prefix>> parse-name +join+ <participant-changed> ]
+ [ trailing>> ] bi to-listener ;
+
+M: part handle-participant-change ( part -- )
+ [ prefix>> parse-name +part+ <participant-changed> ]
+ [ channel>> ] bi to-listener ;
+
+M: kick handle-participant-change ( kick -- )
+ [ who>> +part+ <participant-changed> ]
+ [ channel>> ] bi to-listener ;
+
+M: quit handle-participant-change ( quit -- )
+ prefix>> parse-name
+ [ +part+ <participant-changed> ] [ listeners-with-participant ] bi
+ [ to-listener ] with each ;
GENERIC: handle-incoming-irc ( irc-message -- )
M: irc-message handle-incoming-irc ( irc-message -- )
- +server-listener+ listener> [ in-messages>> mailbox-put ] [ drop ] if* ;
+ +server-listener+ listener> [ to-listener ] [ drop ] if* ;
M: logged-in handle-incoming-irc ( logged-in -- )
name>> irc> profile>> (>>nickname) ;
dup irc-message-origin to-listener ;
M: join handle-incoming-irc ( join -- )
- [ maybe-forward-join ]
- [ dup trailing>> to-listener ]
- [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
- tri ;
+ { [ maybe-forward-join ] ! keep
+ [ dup trailing>> to-listener ]
+ [ [ drop f ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
+ [ handle-participant-change ]
+ } cleave ;
M: part handle-incoming-irc ( part -- )
- [ dup channel>> to-listener ] keep
- [ prefix>> parse-name ] [ channel>> ] bi remove-participant ;
+ [ dup channel>> to-listener ]
+ [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ]
+ [ handle-participant-change ]
+ tri ;
M: kick handle-incoming-irc ( kick -- )
- [ dup channel>> to-listener ]
- [ [ who>> ] [ channel>> ] bi remove-participant ]
- [ dup who>> me? [ unregister-listener ] [ drop ] if ]
- tri ;
+ { [ dup channel>> to-listener ]
+ [ [ who>> ] [ channel>> ] bi remove-participant ]
+ [ handle-participant-change ]
+ [ dup who>> me? [ unregister-listener ] [ drop ] if ]
+ } cleave ;
M: quit handle-incoming-irc ( quit -- )
- [ prefix>> parse-name remove-participant-from-all ] keep
- call-next-method ;
+ { [ dup prefix>> parse-name listeners-with-participant
+ [ to-listener ] with each ]
+ [ handle-participant-change ]
+ [ prefix>> parse-name remove-participant-from-all ]
+ [ ]
+ } cleave call-next-method ;
: >nick/mode ( string -- nick mode )
dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
: (handle-disconnect) ( -- )
irc>
- [ [ irc-disconnected ] dip in-messages>> mailbox-put ]
+ [ [ irc-disconnected ] dip to-listener ]
[ dup reconnect-time>> sleep (connect-irc) ]
[ profile>> nickname>> /LOGIN ]
tri ;