1 ! Copyright (C) 2008 Bruno Deferrari
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: kernel fry splitting ascii calendar accessors combinators qualified
4 arrays classes.tuple math.order quotations ;
5 RENAME: join sequences => sjoin
6 EXCLUDE: sequences => join ;
9 TUPLE: irc-message line prefix command parameters trailing timestamp ;
10 TUPLE: logged-in < irc-message name ;
11 TUPLE: ping < irc-message ;
12 TUPLE: join < irc-message ;
13 TUPLE: part < irc-message channel ;
14 TUPLE: quit < irc-message ;
15 TUPLE: nick < irc-message ;
16 TUPLE: privmsg < irc-message name ;
17 TUPLE: kick < irc-message channel who ;
18 TUPLE: roomlist < irc-message channel names ;
19 TUPLE: nick-in-use < irc-message asterisk name ;
20 TUPLE: notice < irc-message type ;
21 TUPLE: mode < irc-message channel mode ;
22 TUPLE: names-reply < irc-message who = channel ;
23 TUPLE: unhandled < irc-message ;
25 : <irc-client-message> ( command parameters trailing -- irc-message )
26 irc-message new now >>timestamp
27 [ [ (>>trailing) ] [ (>>parameters) ] [ (>>command) ] tri ] keep ;
31 GENERIC: irc-command-string ( irc-message -- string )
33 M: irc-message irc-command-string ( irc-message -- string ) command>> ;
34 M: ping irc-command-string ( ping -- string ) drop "PING" ;
35 M: join irc-command-string ( join -- string ) drop "JOIN" ;
36 M: part irc-command-string ( part -- string ) drop "PART" ;
37 M: quit irc-command-string ( quit -- string ) drop "QUIT" ;
38 M: nick irc-command-string ( nick -- string ) drop "NICK" ;
39 M: privmsg irc-command-string ( privmsg -- string ) drop "PRIVMSG" ;
40 M: notice irc-command-string ( notice -- string ) drop "NOTICE" ;
41 M: mode irc-command-string ( mode -- string ) drop "MODE" ;
42 M: kick irc-command-string ( kick -- string ) drop "KICK" ;
44 GENERIC: irc-command-parameters ( irc-message -- seq )
46 M: irc-message irc-command-parameters ( irc-message -- seq ) parameters>> ;
47 M: ping irc-command-parameters ( ping -- seq ) drop { } ;
48 M: join irc-command-parameters ( join -- seq ) drop { } ;
49 M: part irc-command-parameters ( part -- seq ) name>> 1array ;
50 M: quit irc-command-parameters ( quit -- seq ) drop { } ;
51 M: nick irc-command-parameters ( nick -- seq ) drop { } ;
52 M: privmsg irc-command-parameters ( privmsg -- seq ) name>> 1array ;
53 M: notice irc-command-parameters ( norice -- seq ) type>> 1array ;
54 M: kick irc-command-parameters ( kick -- seq )
55 [ channel>> ] [ who>> ] bi 2array ;
56 M: mode irc-command-parameters ( mode -- seq )
57 [ name>> ] [ channel>> ] [ mode>> ] tri 3array ;
61 GENERIC: irc-message>client-line ( irc-message -- string )
63 M: irc-message irc-message>client-line ( irc-message -- string )
64 [ irc-command-string ]
65 [ irc-command-parameters " " sjoin ]
66 [ trailing>> [ CHAR: : prefix ] [ "" ] if* ]
67 tri 3array " " sjoin ;
69 GENERIC: irc-message>server-line ( irc-message -- string )
71 M: irc-message irc-message>server-line ( irc-message -- string )
72 drop "not implemented yet" ;
75 ! ======================================
77 ! ======================================
79 : split-at-first ( seq separators -- before after )
80 dupd '[ , member? ] find
85 : remove-heading-: ( seq -- seq ) dup ":" head? [ 1 tail ] when ;
87 : parse-name ( string -- string )
88 remove-heading-: "!" split-at-first drop ;
90 : split-prefix ( string -- string/f string )
92 [ remove-heading-: " " split1 ]
96 : split-trailing ( string -- string string/f )
101 : string>irc-message ( string -- object )
102 dup split-prefix split-trailing
103 [ [ blank? ] trim " " split unclip swap ] dip
104 now irc-message boa ;
106 : parse-irc-line ( string -- message )
110 { "NOTICE" [ notice ] }
111 { "001" [ logged-in ] }
112 { "433" [ nick-in-use ] }
113 { "353" [ names-reply ] }
117 { "PRIVMSG" [ privmsg ] }
123 [ [ tuple-slots ] [ parameters>> ] bi append ] dip
124 [ all-slots over [ length ] bi@ min head >quotation ] keep
125 '[ @ , boa nip ] call ;