irc.client: Clean code a bit, add some unit-tests
parent
cf07763259
commit
352c9b8997
|
@ -0,0 +1,36 @@
|
||||||
|
USING: kernel ;
|
||||||
|
IN:
|
||||||
|
irc.client.private
|
||||||
|
: me? ( string -- ? )
|
||||||
|
"factorbot" = ;
|
||||||
|
|
||||||
|
USING: irc.client irc.client.private kernel tools.test accessors arrays ;
|
||||||
|
IN: irc.client.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
|
||||||
|
[ ":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
|
||||||
|
[ ":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
|
||||||
|
|
||||||
|
{ "#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
|
|
@ -3,7 +3,7 @@
|
||||||
USING: arrays combinators concurrency.mailboxes concurrency.futures io
|
USING: arrays combinators concurrency.mailboxes concurrency.futures io
|
||||||
io.encodings.8-bit io.sockets kernel namespaces sequences
|
io.encodings.8-bit io.sockets kernel namespaces sequences
|
||||||
sequences.lib splitting threads calendar classes.tuple
|
sequences.lib splitting threads calendar classes.tuple
|
||||||
ascii assocs accessors destructors ;
|
classes ascii assocs accessors destructors ;
|
||||||
IN: irc.client
|
IN: irc.client
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
|
@ -106,43 +106,6 @@ TUPLE: unhandled < irc-message ;
|
||||||
: /PONG ( text -- )
|
: /PONG ( text -- )
|
||||||
"PONG " irc-write irc-print ;
|
"PONG " irc-write irc-print ;
|
||||||
|
|
||||||
! ======================================
|
|
||||||
! Server message handling
|
|
||||||
! ======================================
|
|
||||||
|
|
||||||
: irc-message-origin ( irc-message -- name )
|
|
||||||
dup name>> irc-client> nick>> name>> = [ sender>> ] [ name>> ] if ;
|
|
||||||
|
|
||||||
GENERIC: handle-incoming-irc ( irc-message -- )
|
|
||||||
|
|
||||||
M: irc-message handle-incoming-irc ( irc-message -- )
|
|
||||||
drop ;
|
|
||||||
|
|
||||||
M: logged-in handle-incoming-irc ( logged-in -- )
|
|
||||||
name>> irc-client> nick>> (>>name) ;
|
|
||||||
|
|
||||||
M: ping handle-incoming-irc ( ping -- )
|
|
||||||
trailing>> /PONG ;
|
|
||||||
|
|
||||||
M: nick-in-use handle-incoming-irc ( nick-in-use -- )
|
|
||||||
name>> "_" append /NICK ;
|
|
||||||
|
|
||||||
M: privmsg handle-incoming-irc ( privmsg -- )
|
|
||||||
dup irc-message-origin irc-client> listeners>> at
|
|
||||||
[ in-messages>> mailbox-put ] [ drop ] if* ;
|
|
||||||
|
|
||||||
M: join handle-incoming-irc ( join -- )
|
|
||||||
irc-client> join-messages>> mailbox-put ;
|
|
||||||
|
|
||||||
! ======================================
|
|
||||||
! Client message handling
|
|
||||||
! ======================================
|
|
||||||
|
|
||||||
GENERIC: handle-outgoing-irc ( obj -- )
|
|
||||||
|
|
||||||
M: privmsg handle-outgoing-irc ( privmsg -- )
|
|
||||||
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
! Message parsing
|
! Message parsing
|
||||||
! ======================================
|
! ======================================
|
||||||
|
@ -189,6 +152,46 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
|
||||||
} case
|
} case
|
||||||
[ [ tuple-slots ] [ parameters>> ] bi append ] dip prefix >tuple ;
|
[ [ tuple-slots ] [ parameters>> ] bi append ] dip prefix >tuple ;
|
||||||
|
|
||||||
|
! ======================================
|
||||||
|
! Server message handling
|
||||||
|
! ======================================
|
||||||
|
|
||||||
|
: me? ( string -- ? )
|
||||||
|
irc-client> nick>> name>> = ;
|
||||||
|
|
||||||
|
: irc-message-origin ( irc-message -- name )
|
||||||
|
dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
|
||||||
|
|
||||||
|
GENERIC: handle-incoming-irc ( irc-message -- )
|
||||||
|
|
||||||
|
M: irc-message handle-incoming-irc ( irc-message -- )
|
||||||
|
drop ;
|
||||||
|
|
||||||
|
M: logged-in handle-incoming-irc ( logged-in -- )
|
||||||
|
name>> irc-client> nick>> (>>name) ;
|
||||||
|
|
||||||
|
M: ping handle-incoming-irc ( ping -- )
|
||||||
|
trailing>> /PONG ;
|
||||||
|
|
||||||
|
M: nick-in-use handle-incoming-irc ( nick-in-use -- )
|
||||||
|
name>> "_" append /NICK ;
|
||||||
|
|
||||||
|
M: privmsg handle-incoming-irc ( privmsg -- )
|
||||||
|
dup irc-message-origin irc-client> listeners>> at
|
||||||
|
[ in-messages>> mailbox-put ] [ drop ] if* ;
|
||||||
|
|
||||||
|
M: join handle-incoming-irc ( join -- )
|
||||||
|
irc-client> join-messages>> mailbox-put ;
|
||||||
|
|
||||||
|
! ======================================
|
||||||
|
! Client message handling
|
||||||
|
! ======================================
|
||||||
|
|
||||||
|
GENERIC: handle-outgoing-irc ( obj -- )
|
||||||
|
|
||||||
|
M: privmsg handle-outgoing-irc ( privmsg -- )
|
||||||
|
[ name>> ] [ trailing>> ] bi /PRIVMSG ;
|
||||||
|
|
||||||
! ======================================
|
! ======================================
|
||||||
! Reader/Writer
|
! Reader/Writer
|
||||||
! ======================================
|
! ======================================
|
||||||
|
@ -219,19 +222,12 @@ M: privmsg handle-outgoing-irc ( privmsg -- )
|
||||||
: in-multiplexer-loop ( -- )
|
: in-multiplexer-loop ( -- )
|
||||||
irc-client> in-messages>> mailbox-get handle-incoming-irc ;
|
irc-client> in-messages>> mailbox-get handle-incoming-irc ;
|
||||||
|
|
||||||
! FIXME: Hack, this should be handled better
|
: maybe-annotate-with-name ( name obj -- obj )
|
||||||
GENERIC: annotate-message-with-name ( name obj -- obj )
|
dup privmsg instance? [ swap >>name ] [ nip ] if ;
|
||||||
M: object annotate-message-with-name nip ;
|
|
||||||
M: privmsg annotate-message-with-name swap >>name ;
|
|
||||||
|
|
||||||
: listener-loop ( name -- ) ! FIXME: take different values from the stack?
|
: listener-loop ( name listener -- )
|
||||||
dup irc-client> listeners>> at [
|
out-messages>> mailbox-get maybe-annotate-with-name
|
||||||
out-messages>> mailbox-get annotate-message-with-name
|
irc-client> out-messages>> mailbox-put ;
|
||||||
irc-client> out-messages>>
|
|
||||||
mailbox-put
|
|
||||||
] [
|
|
||||||
drop
|
|
||||||
] if* ;
|
|
||||||
|
|
||||||
: spawn-irc-loop ( quot name -- )
|
: spawn-irc-loop ( quot name -- )
|
||||||
[ [ irc-client> is-running>> ] compose ] dip
|
[ [ irc-client> is-running>> ] compose ] dip
|
||||||
|
@ -247,9 +243,10 @@ M: privmsg annotate-message-with-name swap >>name ;
|
||||||
! ======================================
|
! ======================================
|
||||||
|
|
||||||
: make-registered-listener ( name -- listener )
|
: make-registered-listener ( name -- listener )
|
||||||
<irc-listener> swap dup
|
<irc-listener>
|
||||||
[ listener-loop ] curry "listener" spawn-irc-loop
|
[ [ listener-loop ] 2curry "listener" spawn-irc-loop ]
|
||||||
[ irc-client> listeners>> set-at ] curry keep ;
|
[ swap [ irc-client> listeners>> set-at ] curry keep ]
|
||||||
|
2bi ;
|
||||||
|
|
||||||
: make-join-future ( name -- future )
|
: make-join-future ( name -- future )
|
||||||
[ [ swap trailing>> = ] curry ! compare name with channel name
|
[ [ swap trailing>> = ] curry ! compare name with channel name
|
||||||
|
@ -283,7 +280,3 @@ PRIVATE>
|
||||||
swap current-irc-client [
|
swap current-irc-client [
|
||||||
dup f maybe-join make-listener-future
|
dup f maybe-join make-listener-future
|
||||||
] with-variable ;
|
] with-variable ;
|
||||||
|
|
||||||
! shorcut for privmsgs, etc
|
|
||||||
: sender>> ( obj -- string )
|
|
||||||
prefix>> parse-name ;
|
|
||||||
|
|
Loading…
Reference in New Issue