f51bc8a2076b5b0fdb527290f644192e3264a912
[cloogle-irc.git] / IRC.icl
1 implementation module IRC
2
3 import StdList, StdTuple, StdOverloaded, StdFunc, StdString, StdChar, StdBool
4 import _SystemArray
5
6 import GenPrint
7 import GenIRC
8
9 import Control.Applicative
10 import Control.Monad
11 import Data.Either
12 import Data.Maybe
13 import Data.Tuple
14 import Text.Parsers.Simple.Chars
15 import Text.Parsers.Simple.Core
16
17 import StdDebug
18
19 from Data.Functor import <$>
20 from Data.Func import $
21 from StdMisc import undef, abort
22 from Text import class Text(lpad,trim,rtrim,split,indexOf,concat),
23 instance Text String
24 import qualified Text
25
26 jon :== 'Text'.join
27
28 derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
29
30 Start = (map (fmap toString) msgs, msgs)
31 where
32 msgs =
33 [ parseIRCMessage ":clooglebot!~cloogle@dhcp-077-249-221-037.chello.nl QUIT\r\n"
34 , parseIRCMessage ":clooglebot!~cloogle QUIT\r\n"
35 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n"
36 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY test\r\n"
37 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY :test with spaces\r\n"
38 , parseIRCMessage ":cherryh.freenode.net NOTICE * :*** Found your hostname\r\n"
39 , parseIRCMessage ":cherryh.freenode.net QUIT :hoi hoi\r\n"
40 , parseIRCMessage ":cherryh.freenode.net JOIN #cha,#ch-b #twilight\r\n"
41 , parseIRCMessage ":cherryh.freenode.net ISON a b c d e f :g h\r\n"
42 , parseIRCMessage ":wilhelm.freenode.net 001 clooglebot :Welcome to the freenode Internet Relay Chat Network clooglebot\r\n"
43 , parseIRCMessage "PING :orwell.freenode.net\r\n"
44 , parseIRCMessage ":ChanServ!ChanServ@services. MODE #cloogle +o frobnicator\r\n"
45 ]
46
47 parseIRCMessage :: String -> Either [Error] IRCMessage
48 parseIRCMessage s = case runParser parsePrefix (fromString s) of
49 // Prefix is parsed
50 ([(prefix, rest):_], _)
51 //Try parsing a numeric reply
52 = case parse parseReply rest of
53 //Try a normal command
54 Left e = case parseCmd rest of
55 Left e2 = Left [e2:e]
56 Right cmd = Right {IRCMessage | irc_prefix=prefix, irc_command=Right cmd}
57 Right repl = Right {IRCMessage | irc_prefix=prefix, irc_command=Left repl}
58 // Error parsing prefix
59 (_, es) = Left ["Error parsing prefix"]
60
61 //Prefix
62 parsePrefix :: Parser Char (Maybe (Either IRCUser String))
63 parsePrefix
64 = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ')
65 where
66 parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
67 parseEither p q = Left <$> p <|> Right <$> q
68
69 parseUser :: Parser Char IRCUser
70 parseUser = parseNick
71 >>= \nick->optional (pToken '!' >>| parseUsr)
72 >>= \muser->optional (pToken '@' >>| parseHost)
73 >>= \mhost->pure {IRCUser
74 | irc_nick=nick, irc_user=muser, irc_host=mhost}
75
76 parseUsr :: Parser Char String
77 parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
78
79 parseNick :: Parser Char String
80 parseNick = pAlpha
81 >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "-[]\\`^{}"))
82 >>= \cs->pure (toString [c:cs])
83
84 parseHost :: Parser Char String
85 parseHost = jon "." <$> (pSepBy parseName (pToken '.'))
86 >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s)
87 where
88 parseName :: Parser Char String
89 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-'])
90
91 //Parse Cmd
92 parseCmd :: [Char] -> Either Error IRCCommand
93 parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
94 where
95 argfun :: [String] -> [String]
96 argfun [] = []
97 argfun [x:xs]
98 # x = trim x
99 | x.[0] == ':' = [jon " " $ [x % (1, size x):map rtrim xs]]
100 | otherwise = [x:argfun xs]
101
102 //Reply
103
104 parseReply :: Parser Char IRCNumReply
105 parseReply = spaceParser
106 >>| (pMany (pToken '0') >>| pSome pDigit <* spaceParser)
107 >>= \rep->(toString <$> pSome (pNoneOf [' ':illegal]) <* spaceParser)
108 >>= \rec->(toString <$> pSome (pNoneOf illegal))
109 >>= \msg->pure {IRCNumReply
110 | irc_reply = fromInt $ toInt $ toString rep
111 , irc_recipient = rec
112 , irc_message = msg % (if (msg.[0] == ':') 1 0, size msg)
113 }
114 <* pToken '\r' <* pToken '\n'
115 where
116 spaceParser :: Parser Char [Char]
117 spaceParser = pMany $ pToken ' '
118
119 //Common parsers
120 pNoneOf :: [a] -> Parser a a | Eq a
121 pNoneOf l = pSatisfy (not o flip isMember l)
122
123 illegal :: [Char]
124 illegal = ['\x00','\r','\n']
125
126 instance toString IRCNumReply where
127 toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+
128 m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message)
129 instance toString IRCMessage where
130 toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
131 <+ either toString toString m.irc_command
132 instance toString IRCUser where
133 toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
134 <+ maybe "" ((<+) "@") m.irc_host
135 instance toString IRCCommand where
136 toString m = jon " " (gIRCPrint{|*|} m) +++ "\r\n"
137 instance toString IRCReplies where toString r = printToString r
138 instance toString IRCErrors where toString r = printToString r
139
140 (<+) infixr 5 :: a b -> String | toString a & toString b
141 (<+) a b = toString a +++ toString b
142
143 instance fromInt IRCReplies where
144 fromInt r = case r of
145 1 = RPL_WELCOME; 2 = RPL_YOURHOST;
146 3 = RPL_CREATED; 4 = RPL_MYINFO;
147 5 = RPL_BOUNCE; 200 = RPL_TRACELINK;
148 201 = RPL_TRACECONNECTING; 202 = RPL_TRACEHANDSHAKE;
149 203 = RPL_TRACEUNKNOWN; 204 = RPL_TRACEOPERATOR;
150 205 = RPL_TRACEUSER; 206 = RPL_TRACESERVER;
151 207 = RPL_TRACESERVICE; 208 = RPL_TRACENEWTYPE;
152 209 = RPL_TRACECLASS; 210 = RPL_TRACERECONNECT;
153 211 = RPL_STATSLINKINFO; 212 = RPL_STATSCOMMANDS;
154 219 = RPL_ENDOFSTATS; 221 = RPL_UMODEIS;
155 234 = RPL_SERVLIST; 235 = RPL_SERVLISTEND;
156 242 = RPL_STATSUPTIME; 243 = RPL_STATSOLINE;
157 251 = RPL_LUSERCLIENT; 252 = RPL_LUSEROP;
158 253 = RPL_LUSERUNKNOWN; 254 = RPL_LUSERCHANNELS;
159 255 = RPL_LUSERME; 256 = RPL_ADMINME;
160 257 = RPL_ADMINLOC1; 258 = RPL_ADMINLOC2;
161 259 = RPL_ADMINEMAIL; 261 = RPL_TRACELOG;
162 262 = RPL_TRACEEND; 263 = RPL_TRYAGAIN;
163 301 = RPL_AWAY; 302 = RPL_USERHOST;
164 303 = RPL_ISON; 304 = RPL_UNAWAY;
165 305 = RPL_NOWAWAY; 311 = RPL_WHOISUSER;
166 312 = RPL_WHOISSERVER; 313 = RPL_WHOISOPERATOR;
167 314 = RPL_WHOWASUSER; 315 = RPL_ENDOFWHO;
168 317 = RPL_WHOISIDLE; 318 = RPL_ENDOFWHOIS;
169 319 = RPL_WHOISCHANNELS; 321 = RPL_LISTSTART;
170 322 = RPL_LIST; 323 = RPL_LISTEND;
171 324 = RPL_CHANNELMODEIS; 325 = RPL_UNIQOPIS;
172 331 = RPL_NOTOPIC; 332 = RPL_TOPIC;
173 341 = RPL_INVITING; 342 = RPL_SUMMONING;
174 346 = RPL_INVITELIST; 347 = RPL_ENDOFINVITELIST;
175 348 = RPL_EXCEPTLIST; 349 = RPL_ENDOFEXCEPTLIST;
176 351 = RPL_VERSION; 352 = RPL_WHOREPLY;
177 353 = RPL_NAMREPLY; 364 = RPL_LINKS;
178 365 = RPL_ENDOFLINKS; 366 = RPL_ENDOFNAMES;
179 367 = RPL_BANLIST; 368 = RPL_ENDOFBANLIST;
180 369 = RPL_ENDOFWHOWAS; 371 = RPL_INFO;
181 372 = RPL_MOTD; 374 = RPL_ENDOFINFO;
182 375 = RPL_MOTDSTART; 376 = RPL_ENDOFMOTD;
183 381 = RPL_YOUREOPER; 382 = RPL_REHASHING;
184 383 = RPL_YOURESERVICE; 391 = RPL_TIME;
185 392 = RPL_USERSSTART; 393 = RPL_USERS;
186 394 = RPL_ENDOFUSERS; 395 = RPL_NOUSERS;
187 _ = abort $ "fromInt IRCReplies: " +++ toString r +++ " undef\n"
188
189 instance toInt IRCReplies where
190 toInt r = case r of
191 RPL_WELCOME = 1; RPL_YOURHOST = 2;
192 RPL_CREATED = 3; RPL_MYINFO = 4;
193 RPL_BOUNCE = 5; RPL_TRACELINK = 200;
194 RPL_TRACECONNECTING = 201; RPL_TRACEHANDSHAKE = 202;
195 RPL_TRACEUNKNOWN = 203; RPL_TRACEOPERATOR = 204;
196 RPL_TRACEUSER = 205; RPL_TRACESERVER = 206;
197 RPL_TRACESERVICE = 207; RPL_TRACENEWTYPE = 208;
198 RPL_TRACECLASS = 209; RPL_TRACERECONNECT = 210;
199 RPL_STATSLINKINFO = 211; RPL_STATSCOMMANDS = 212;
200 RPL_ENDOFSTATS = 219; RPL_UMODEIS = 221;
201 RPL_SERVLIST = 234; RPL_SERVLISTEND = 234;
202 RPL_STATSUPTIME = 242; RPL_STATSOLINE = 243;
203 RPL_LUSERCLIENT = 251; RPL_LUSEROP = 252;
204 RPL_LUSERUNKNOWN = 253; RPL_LUSERCHANNELS = 254;
205 RPL_LUSERME = 255; RPL_ADMINME = 256;
206 RPL_ADMINLOC1 = 257; RPL_ADMINLOC2 = 258;
207 RPL_ADMINEMAIL = 259; RPL_TRACELOG = 261;
208 RPL_TRACEEND = 262; RPL_TRYAGAIN = 263;
209 RPL_AWAY = 301; RPL_USERHOST = 302;
210 RPL_ISON = 303; RPL_UNAWAY = 304;
211 RPL_NOWAWAY = 305; RPL_WHOISUSER = 311;
212 RPL_WHOISSERVER = 312; RPL_WHOISOPERATOR = 313;
213 RPL_WHOWASUSER = 314; RPL_ENDOFWHO = 315;
214 RPL_WHOISIDLE = 317; RPL_ENDOFWHOIS = 318;
215 RPL_WHOISCHANNELS = 319; RPL_LISTSTART = 321;
216 RPL_LIST = 322; RPL_LISTEND = 323;
217 RPL_CHANNELMODEIS = 324; RPL_UNIQOPIS = 325;
218 RPL_NOTOPIC = 331; RPL_TOPIC = 332;
219 RPL_INVITING = 341; RPL_SUMMONING = 342;
220 RPL_INVITELIST = 346; RPL_ENDOFINVITELIST = 347;
221 RPL_EXCEPTLIST = 348; RPL_ENDOFEXCEPTLIST = 349;
222 RPL_VERSION = 351; RPL_WHOREPLY = 352;
223 RPL_NAMREPLY = 353; RPL_LINKS = 364;
224 RPL_ENDOFLINKS = 365; RPL_ENDOFNAMES = 366;
225 RPL_BANLIST = 367; RPL_ENDOFBANLIST = 367;
226 RPL_ENDOFWHOWAS = 369; RPL_INFO = 371;
227 RPL_MOTD = 372; RPL_ENDOFINFO = 374;
228 RPL_MOTDSTART = 375; RPL_ENDOFMOTD = 376;
229 RPL_YOUREOPER = 381; RPL_REHASHING = 382;
230 RPL_YOURESERVICE = 383; RPL_TIME = 391;
231 RPL_USERSSTART = 392; RPL_USERS = 393;
232 RPL_ENDOFUSERS = 394; RPL_NOUSERS = 395;
233
234 instance fromInt IRCErrors where
235 fromInt r = case r of
236 401 = ERR_NOSUCHNICK; 402 = ERR_NOSUCHSERVER;
237 403 = ERR_NOSUCHCHANNEL; 404 = ERR_CANNOTSENDTOCHAN;
238 405 = ERR_TOOMANYCHANNELS; 406 = ERR_WASNOSUCHNICK;
239 407 = ERR_TOOMANYTARGETS; 408 = ERR_NOSUCHSERVICE;
240 409 = ERR_NOORIGIN; 411 = ERR_NORECIPIENT;
241 412 = ERR_NOTEXTTOSEND; 413 = ERR_NOTOPLEVEL;
242 414 = ERR_WILDTOPLEVEL; 415 = ERR_BADMASK;
243 421 = ERR_UNKNOWNCOMMAND; 422 = ERR_NOMOTD;
244 423 = ERR_NOADMININFO; 424 = ERR_FILEERROR;
245 431 = ERR_NONICKNAMEGIVEN; 432 = ERR_ERRONEUSNICKNAME;
246 433 = ERR_NICKNAMEINUSE; 436 = ERR_NICKCOLLISION;
247 437 = ERR_UNAVAILRESOURCE; 441 = ERR_USERNOTINCHANNEL;
248 442 = ERR_NOTONCHANNEL; 443 = ERR_USERONCHANNEL;
249 444 = ERR_NOLOGIN; 445 = ERR_SUMMONDISABLED;
250 446 = ERR_USERSDISABLED; 451 = ERR_NOTREGISTERED;
251 461 = ERR_NEEDMOREPARAMS; 462 = ERR_ALREADYREGISTRED;
252 463 = ERR_NOPERMFORHOST; 464 = ERR_PASSWDMISMATCH;
253 465 = ERR_YOUREBANNEDCREEP; 466 = ERR_YOUWILLBEBANNED;
254 467 = ERR_KEYSET; 471 = ERR_CHANNELISFULL;
255 472 = ERR_UNKNOWNMODE; 473 = ERR_INVITEONLYCHAN;
256 474 = ERR_BANNEDFROMCHAN; 475 = ERR_BADCHANNELKEY;
257 476 = ERR_BADCHANMASK; 477 = ERR_NOCHANMODES;
258 478 = ERR_BANLISTFULL; 481 = ERR_NOPRIVILEGES;
259 482 = ERR_CHANOPRIVSNEEDED; 483 = ERR_CANTKILLSERVER;
260 484 = ERR_RESTRICTED; 485 = ERR_UNIQOPPRIVSNEEDED;
261 491 = ERR_NOOPERHOST; 501 = ERR_UMODEUNKNOWNFLAG;
262 502 = ERR_USERSDONTMATCH;
263
264 instance toInt IRCErrors where
265 toInt r = case r of
266 ERR_NOSUCHNICK = 401; ERR_NOSUCHSERVER = 402;
267 ERR_NOSUCHCHANNEL = 403; ERR_CANNOTSENDTOCHAN = 404;
268 ERR_TOOMANYCHANNELS = 405; ERR_WASNOSUCHNICK = 406;
269 ERR_TOOMANYTARGETS = 407; ERR_NOSUCHSERVICE = 408;
270 ERR_NOORIGIN = 409; ERR_NORECIPIENT = 411;
271 ERR_NOTEXTTOSEND = 412; ERR_NOTOPLEVEL = 413;
272 ERR_WILDTOPLEVEL = 414; ERR_BADMASK = 415;
273 ERR_UNKNOWNCOMMAND = 421; ERR_NOMOTD = 422;
274 ERR_NOADMININFO = 423; ERR_FILEERROR = 424;
275 ERR_NONICKNAMEGIVEN = 431; ERR_ERRONEUSNICKNAME = 432;
276 ERR_NICKNAMEINUSE = 433; ERR_NICKCOLLISION = 436;
277 ERR_UNAVAILRESOURCE = 437; ERR_USERNOTINCHANNEL = 441;
278 ERR_NOTONCHANNEL = 442; ERR_USERONCHANNEL = 443;
279 ERR_NOLOGIN = 444; ERR_SUMMONDISABLED = 445;
280 ERR_USERSDISABLED = 446; ERR_NOTREGISTERED = 451;
281 ERR_NEEDMOREPARAMS = 461; ERR_ALREADYREGISTRED = 462;
282 ERR_NOPERMFORHOST = 463; ERR_PASSWDMISMATCH = 464;
283 ERR_YOUREBANNEDCREEP = 465; ERR_YOUWILLBEBANNED = 466;
284 ERR_KEYSET = 467; ERR_CHANNELISFULL = 471;
285 ERR_UNKNOWNMODE = 472; ERR_INVITEONLYCHAN = 473;
286 ERR_BANNEDFROMCHAN = 474; ERR_BADCHANNELKEY = 475;
287 ERR_BADCHANMASK = 476; ERR_NOCHANMODES = 477;
288 ERR_BANLISTFULL = 478; ERR_NOPRIVILEGES = 481;
289 ERR_CHANOPRIVSNEEDED = 482; ERR_CANTKILLSERVER = 483;
290 ERR_RESTRICTED = 484; ERR_UNIQOPPRIVSNEEDED = 485;
291 ERR_NOOPERHOST = 491; ERR_UMODEUNKNOWNFLAG = 501;
292 ERR_USERSDONTMATCH = 502;