Paste: idiomatic <irc-client>
Author: | erg |
Mode: | factor |
Date: | Mon, 6 Oct 2008 19:37:08 |
Plain Text |
TUPLE: irc-client profile stream in-messages out-messages chats is-running nick connect reconnect-time is-ready ;
: <irc-client>
irc-client new
swap >>profile
<mailbox> >>in-messages
<mailbox> >>out-messages
H{ } clone >>chats
dup profile>> nickname>> >>nick
[ <inet> latin1 <client> ] >>connect
15 seconds >>reconnect-time ;
Author: | erg |
Mode: | factor |
Date: | Mon, 6 Oct 2008 19:51:21 |
Plain Text |
USING: kernel fry splitting ascii calendar accessors combinators qualified
arrays classes.tuple math.order ;
RENAME: join sequences => sjoin
EXCLUDE: sequences => join ;
IN: irc.messages
TUPLE: irc-message line prefix command parameters trailing timestamp ;
TUPLE: logged-in < irc-message name ;
TUPLE: ping < irc-message ;
TUPLE: join < irc-message ;
TUPLE: part < irc-message channel ;
TUPLE: quit < irc-message ;
TUPLE: nick < irc-message ;
TUPLE: privmsg < irc-message name ;
TUPLE: kick < irc-message channel who ;
TUPLE: roomlist < irc-message channel names ;
TUPLE: nick-in-use < irc-message asterisk name ;
TUPLE: notice < irc-message type ;
TUPLE: mode < irc-message name mode parameter ;
TUPLE: names-reply < irc-message who channel ;
TUPLE: unhandled < irc-message ;
: <irc-client-message>
irc-message new
now >>timestamp
swap >>trailing
swap >>parameters
swap >>command ;
<PRIVATE
GENERIC: command-string>>
M: irc-message command-string>> command>> ;
M: ping command-string>> drop "PING" ;
M: join command-string>> drop "JOIN" ;
M: part command-string>> drop "PART" ;
M: quit command-string>> drop "QUIT" ;
M: nick command-string>> drop "NICK" ;
M: privmsg command-string>> drop "PRIVMSG" ;
M: notice command-string>> drop "NOTICE" ;
M: mode command-string>> drop "MODE" ;
M: kick command-string>> drop "KICK" ;
GENERIC: command-parameters>>
M: irc-message command-parameters>> parameters>> ;
M: ping command-parameters>> drop { } ;
M: join command-parameters>> drop { } ;
M: part command-parameters>> channel>> 1array ;
M: quit command-parameters>> drop { } ;
M: nick command-parameters>> drop { } ;
M: privmsg command-parameters>> name>> 1array ;
M: notice command-parameters>> type>> 1array ;
M: kick command-parameters>>
[ channel>> ] [ who>> ] bi 2array ;
M: mode command-parameters>>
[ name>> ] [ channel>> ] [ mode>> ] tri 3array ;
GENERIC# >>command-parameters 1
M: irc-message >>command-parameters
drop ;
M: logged-in >>command-parameters
first >>name ;
M: privmsg >>command-parameters
first >>name ;
M: notice >>command-parameters
first >>type ;
M: part >>command-parameters
first >>channel ;
M: kick >>command-parameters
first2 [ >>channel ] [ >>who ] bi* ;
M: nick-in-use >>command-parameters
second >>name ;
M: names-reply >>command-parameters
first3 nip [ >>who ] [ >>channel ] bi* ;
M: mode >>command-parameters
dup length 3 = [
first3 [ >>name ] [ >>mode ] [ >>parameter ] tri*
] [
first2 [ >>name ] [ >>mode ] bi*
] if ;
PRIVATE>
GENERIC: irc-message>client-line
M: irc-message irc-message>client-line
[ command-string>> ]
[ command-parameters>> " " sjoin ]
[ trailing>> [ CHAR: : prefix ] [ "" ] if* ]
tri 3array " " sjoin ;
GENERIC: irc-message>server-line
M: irc-message irc-message>server-line
drop "not implemented yet" ;
<PRIVATE
: split-at-first
dupd '[ _ member? ] find [ cut 1 tail ] [ swap ] if ;
: remove-heading-:
":" ?head drop ;
: parse-name
remove-heading-: "!" split-at-first drop ;
: split-prefix
dup ":" head?
[ remove-heading-: " " split1 ] [ f swap ] if ;
: split-trailing
":" split1 ;
: copy-message-in
{
[ parameters>> [ >>parameters ] [ >>command-parameters ] bi ]
[ line>> >>line ]
[ prefix>> >>prefix ]
[ command>> >>command ]
[ trailing>> >>trailing ]
[ timestamp>> >>timestamp ]
} cleave ;
PRIVATE>
UNION: sender-in-prefix privmsg join part quit kick mode nick ;
GENERIC: irc-message-sender
M: sender-in-prefix irc-message-sender
prefix>> parse-name ;
: string>irc-message
dup split-prefix split-trailing
[ [ blank? ] trim " " split unclip swap ] dip
now irc-message boa ;
: irc-message>command
[
command>> {
{ "PING" [ ping ] }
{ "NOTICE" [ notice ] }
{ "001" [ logged-in ] }
{ "433" [ nick-in-use ] }
{ "353" [ names-reply ] }
{ "JOIN" [ join ] }
{ "PART" [ part ] }
{ "NICK" [ nick ] }
{ "PRIVMSG" [ privmsg ] }
{ "QUIT" [ quit ] }
{ "MODE" [ mode ] }
{ "KICK" [ kick ] }
[ drop unhandled ]
} case new
] keep copy-message-in ;
: parse-irc-line
string>irc-message irc-message>command ;
New Annotation