irc.client: Refactorings

extra/irc/client/client-tests.factor

@@ -49,10 +49,10 @@ M: mb-writer stream-nl ( mb-writer -- )
   { "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
+                      parse-irc-line forward-name ] unit-test
 
   { "someuser" } [ ":someuser!n=user@some.where PRIVMSG factorbot :hi"
-                   parse-irc-line irc-message-origin ] unit-test
+                   parse-irc-line forward-name ] unit-test
 ] with-irc
 
 ! Test login and nickname set

extra/irc/client/client.factor

@@ -3,7 +3,7 @@
 USING: concurrency.mailboxes kernel io.sockets io.encodings.8-bit calendar
        accessors destructors namespaces io assocs arrays qualified fry
        continuations threads strings classes combinators splitting hashtables
-       ascii irc.messages irc.messages.private ;
+       ascii irc.messages ;
 RENAME: join sequences => sjoin
 EXCLUDE: sequences => join ;
 IN: irc.client
@@ -67,7 +67,6 @@ SINGLETON: irc-listener-end ! send to a listener to stop its execution
 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
-UNION: irc-broadcasted-message irc-end irc-disconnected irc-connected ;
 
 : terminate-irc ( irc-client -- )
     [ is-running>> ] keep and [
@@ -122,6 +121,9 @@ M: irc-listener to-listener ( message irc-listener -- )
     [ dup irc-channel-listener? [ participants>> key? ] [ 2drop f ] if ]
     with filter ;
 
+: to-listeners-with-participant ( message nickname -- )
+    listeners-with-participant [ to-listener ] with each ;
+
 : remove-participant-from-all ( nick -- )
     dup listeners-with-participant [ (remove-participant) ] with each ;
 
@@ -145,7 +147,7 @@ M: irc-listener to-listener ( message irc-listener -- )
 DEFER: me?
 
 : maybe-forward-join ( join -- )
-    [ prefix>> parse-name me? ] keep and
+    [ irc-message-sender me? ] keep and
     [ irc> join-messages>> mailbox-put ] when* ;
 
 ! ======================================
@@ -177,60 +179,64 @@ DEFER: me?
 : me? ( string -- ? )
     irc> profile>> nickname>> = ;
 
-: irc-message-origin ( irc-message -- name )
+GENERIC: forward-name ( irc-message -- name )
-    dup name>> me? [ prefix>> parse-name ] [ name>> ] if ;
+M: join forward-name ( join -- name ) trailing>> ;
+M: part forward-name ( part -- name ) channel>> ;
+M: kick forward-name ( kick -- name ) channel>> ;
+M: mode forward-name ( mode -- name ) channel>> ;
+M: privmsg forward-name ( privmsg -- name )
+    dup name>> me? [ irc-message-sender ] [ name>> ] if ;
 
-: broadcast-message-to-listeners ( message -- )
+UNION: single-forward join part kick mode privmsg ;
-    irc> listeners>> values [ to-listener ] with each ;
+UNION: multiple-forward nick quit ;
+UNION: broadcast-forward irc-end irc-disconnected irc-connected ;
+GENERIC: forward-message ( irc-message -- )
 
-GENERIC: handle-incoming-irc ( irc-message -- )
+M: irc-message forward-message ( irc-message -- )
-
-M: irc-message handle-incoming-irc ( irc-message -- )
     +server-listener+ listener> [ to-listener ] [ drop ] if* ;
 
-M: logged-in handle-incoming-irc ( logged-in -- )
+M: single-forward forward-message ( forward-single -- )
+    dup forward-name to-listener ;
+
+M: multiple-forward forward-message ( multiple-forward -- )
+    dup irc-message-sender to-listeners-with-participant ;
+
+M: join forward-message ( join -- )
+    [ maybe-forward-join ] [ call-next-method ] bi ;
+    
+M: broadcast-forward forward-message ( irc-broadcasted-message -- )
+    irc> listeners>> values [ to-listener ] with each ;
+
+GENERIC: process-message ( irc-message -- )
+
+M: object process-message ( object -- )
+    drop ;
+    
+M: logged-in process-message ( logged-in -- )
     name>> irc> profile>> (>>nickname) ;
 
-M: ping handle-incoming-irc ( ping -- )
+M: ping process-message ( ping -- )
     trailing>> /PONG ;
 
-M: nick-in-use handle-incoming-irc ( nick-in-use -- )
+M: nick-in-use process-message ( nick-in-use -- )
     name>> "_" append /NICK ;
 
-M: privmsg handle-incoming-irc ( privmsg -- )
+M: join process-message ( join -- )
-    dup irc-message-origin to-listener ;
+    [ drop +normal+ ] [ irc-message-sender ] [ trailing>> ] tri add-participant ;
 
-M: join handle-incoming-irc ( join -- )
+M: part process-message ( part -- )
-    [ maybe-forward-join ]
+    [ irc-message-sender ] [ channel>> ] bi remove-participant ;
-    [ dup trailing>> to-listener ]
-    [ [ drop +normal+ ] [ prefix>> parse-name ] [ trailing>> ] tri add-participant ]
-    tri ;
 
-M: part handle-incoming-irc ( part -- )
+M: kick process-message ( kick -- )
-    [ dup channel>> to-listener ]
-    [ [ prefix>> parse-name ] [ channel>> ] bi remove-participant ]
-    bi ;
-
-M: kick handle-incoming-irc ( kick -- )
-    [ dup channel>> to-listener ]
     [ [ who>> ] [ channel>> ] bi remove-participant ]
     [ dup who>> me? [ unregister-listener ] [ drop ] if ]
-    tri ;
-
-M: quit handle-incoming-irc ( quit -- )
-    [ dup prefix>> parse-name listeners-with-participant
-      [ to-listener ] with each ]
-    [ prefix>> parse-name remove-participant-from-all ]
     bi ;
 
-M: mode handle-incoming-irc ( mode -- ) ! FIXME: modify participant list
+M: quit process-message ( quit -- )
-    dup channel>> to-listener ;
+    irc-message-sender remove-participant-from-all ;
 
-M: nick handle-incoming-irc ( nick -- )
+M: nick process-message ( nick -- )
-    [ dup prefix>> parse-name listeners-with-participant
+    [ irc-message-sender ] [ trailing>> ] bi rename-participant-in-all ;
-      [ to-listener ] with each ]
-    [ [ prefix>> parse-name ] [ trailing>> ] bi rename-participant-in-all ]
-    bi ;
 
 : >nick/mode ( string -- nick mode )
     dup first "+@" member? [ unclip ] [ 0 ] if participant-mode ;
@@ -239,22 +245,20 @@ M: nick handle-incoming-irc ( nick -- )
     trailing>> [ blank? ] trim " " split
     [ >nick/mode 2array ] map >hashtable ;
 
-M: names-reply handle-incoming-irc ( names-reply -- )
+M: names-reply process-message ( names-reply -- )
     [ names-reply>participants ] [ channel>> listener> ] bi [
         [ (>>participants) ]
         [ [ f f f <participant-changed> ] dip name>> to-listener ] bi
     ] [ drop ] if* ;
 
-M: irc-broadcasted-message handle-incoming-irc ( irc-broadcasted-message -- )
+: handle-incoming-irc ( irc-message -- )
-    broadcast-message-to-listeners ;
+    [ forward-message ] [ process-message ] bi ;
 
 ! ======================================
 ! Client message handling
 ! ======================================
 
-GENERIC: handle-outgoing-irc ( obj -- )
+: handle-outgoing-irc ( irc-message -- )
-
-M: irc-message handle-outgoing-irc ( irc-message -- )
     irc-message>client-line irc-print ;
 
 ! ======================================

extra/irc/messages/messages-tests.factor

@@ -3,7 +3,9 @@ USING: kernel tools.test accessors arrays qualified
 EXCLUDE: sequences => join ;
 IN: irc.messages.tests
 
-! Parsing tests
+
+{ "someuser" } [ "someuser!n=user@some.where" parse-name ] unit-test
+
 irc-message new
     ":someuser!n=user@some.where PRIVMSG #factortest :hi" >>line
     "someuser!n=user@some.where" >>prefix

extra/irc/messages/messages.factor

@@ -98,6 +98,11 @@ M: irc-message irc-message>server-line ( irc-message -- string )
 
 PRIVATE>
 
+UNION: sender-in-prefix privmsg join part quit kick mode nick ;
+GENERIC: irc-message-sender ( irc-message -- sender )
+M: sender-in-prefix irc-message-sender ( sender-in-prefix -- sender )
+    prefix>> parse-name ;
+
 : string>irc-message ( string -- object )
     dup split-prefix split-trailing
     [ [ blank? ] trim " " split unclip swap ] dip