1 implementation module IRC
3 import StdList, StdTuple, StdOverloaded, StdFunc, StdString, StdChar, StdBool
9 import Control.Applicative
14 import Text.Parsers.Simple.Chars
15 import Text.Parsers.Simple.Core
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),
28 derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
30 Start = (map (fmap toString) msgs, 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"
47 parseIRCMessage :: String -> Either [Error] IRCMessage
48 parseIRCMessage s = case runParser parsePrefix (fromString s) of
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
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"]
62 parsePrefix :: Parser Char (Maybe (Either IRCUser String))
64 = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ')
66 parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
67 parseEither p q = Left <$> p <|> Right <$> q
69 parseUser :: Parser Char IRCUser
71 >>= \nick->optional (pToken '!' >>| parseUsr)
72 >>= \muser->optional (pToken '@' >>| parseHost)
73 >>= \mhost->pure {IRCUser
74 | irc_nick=nick, irc_user=muser, irc_host=mhost}
76 parseUsr :: Parser Char String
77 parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
79 parseNick :: Parser Char String
81 >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "-[]\\`^{}"))
82 >>= \cs->pure (toString [c:cs])
84 parseHost :: Parser Char String
85 parseHost = jon "." <$> (pSepBy parseName (pToken '.'))
86 >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s)
88 parseName :: Parser Char String
89 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/'])
92 parseCmd :: [Char] -> Either Error IRCCommand
93 parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
95 argfun :: [String] -> [String]
99 | x.[0] == ':' = [jon " " $ [x % (1, size x):map rtrim xs]]
100 | otherwise = [x:argfun xs]
103 parseReply :: Parser Char IRCNumReply
104 parseReply = spaceParser
105 >>| (pMany (pToken '0') >>| pSome pDigit <* spaceParser)
106 >>= \rep->(toString <$> pSome (pNoneOf [' ':illegal]) <* spaceParser)
107 >>= \rec->(toString <$> pSome (pNoneOf illegal))
108 >>= \msg->pure {IRCNumReply
109 | irc_reply = fromInt $ toInt $ toString rep
110 , irc_recipient = rec
111 , irc_message = msg % (if (msg.[0] == ':') 1 0, size msg)
113 <* pToken '\r' <* pToken '\n'
115 spaceParser :: Parser Char [Char]
116 spaceParser = pMany $ pToken ' '
119 pNoneOf :: [a] -> Parser a a | Eq a
120 pNoneOf l = pSatisfy (not o flip isMember l)
123 illegal = ['\x00','\r','\n']
125 instance toString IRCNumReply where
126 toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+
127 m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message)
128 instance toString IRCMessage where
129 toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
130 <+ either toString toString m.irc_command
131 instance toString IRCUser where
132 toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
133 <+ maybe "" ((<+) "@") m.irc_host
134 instance toString IRCCommand where
135 toString m = jon " " (gIRCPrint{|*|} m)
136 instance toString IRCReplies where toString r = printToString r
137 instance toString IRCErrors where toString r = printToString r
139 (<+) infixr 5 :: a b -> String | toString a & toString b
140 (<+) a b = toString a +++ toString b
142 instance fromInt IRCReplies where
143 fromInt r = case r of
150 201 = RPL_TRACECONNECTING
151 202 = RPL_TRACEHANDSHAKE
152 203 = RPL_TRACEUNKNOWN
153 204 = RPL_TRACEOPERATOR
155 206 = RPL_TRACESERVER
156 207 = RPL_TRACESERVICE
157 208 = RPL_TRACENEWTYPE
159 210 = RPL_TRACERECONNECT
160 211 = RPL_STATSLINKINFO
161 212 = RPL_STATSCOMMANDS
165 235 = RPL_SERVLISTEND
166 242 = RPL_STATSUPTIME
168 251 = RPL_LUSERCLIENT
170 253 = RPL_LUSERUNKNOWN
171 254 = RPL_LUSERCHANNELS
186 312 = RPL_WHOISSERVER
187 313 = RPL_WHOISOPERATOR
192 319 = RPL_WHOISCHANNELS
196 324 = RPL_CHANNELMODEIS
203 347 = RPL_ENDOFINVITELIST
205 349 = RPL_ENDOFEXCEPTLIST
213 368 = RPL_ENDOFBANLIST
214 369 = RPL_ENDOFWHOWAS
222 383 = RPL_YOURESERVICE
230 instance toInt IRCReplies where
238 RPL_TRACECONNECTING = 201
239 RPL_TRACEHANDSHAKE = 202
240 RPL_TRACEUNKNOWN = 203
241 RPL_TRACEOPERATOR = 204
243 RPL_TRACESERVER = 206
244 RPL_TRACESERVICE = 207
245 RPL_TRACENEWTYPE = 208
247 RPL_TRACERECONNECT = 210
248 RPL_STATSLINKINFO = 211
249 RPL_STATSCOMMANDS = 212
253 RPL_SERVLISTEND = 234
254 RPL_STATSUPTIME = 242
256 RPL_LUSERCLIENT = 251
258 RPL_LUSERUNKNOWN = 253
259 RPL_LUSERCHANNELS = 254
274 RPL_WHOISSERVER = 312
275 RPL_WHOISOPERATOR = 313
280 RPL_WHOISCHANNELS = 319
284 RPL_CHANNELMODEIS = 324
291 RPL_ENDOFINVITELIST = 347
293 RPL_ENDOFEXCEPTLIST = 349
301 RPL_ENDOFBANLIST = 367
302 RPL_ENDOFWHOWAS = 369
310 RPL_YOURESERVICE = 383
318 instance fromInt IRCErrors where
319 fromInt r = case r of
321 402 = ERR_NOSUCHSERVER
322 403 = ERR_NOSUCHCHANNEL
323 404 = ERR_CANNOTSENDTOCHAN
324 405 = ERR_TOOMANYCHANNELS
325 406 = ERR_WASNOSUCHNICK
326 407 = ERR_TOOMANYTARGETS
327 408 = ERR_NOSUCHSERVICE
329 411 = ERR_NORECIPIENT
330 412 = ERR_NOTEXTTOSEND
332 414 = ERR_WILDTOPLEVEL
334 421 = ERR_UNKNOWNCOMMAND
336 423 = ERR_NOADMININFO
338 431 = ERR_NONICKNAMEGIVEN
339 432 = ERR_ERRONEUSNICKNAME
340 433 = ERR_NICKNAMEINUSE
341 436 = ERR_NICKCOLLISION
342 437 = ERR_UNAVAILRESOURCE
343 441 = ERR_USERNOTINCHANNEL
344 442 = ERR_NOTONCHANNEL
345 443 = ERR_USERONCHANNEL
347 445 = ERR_SUMMONDISABLED
348 446 = ERR_USERSDISABLED
349 451 = ERR_NOTREGISTERED
350 461 = ERR_NEEDMOREPARAMS
351 462 = ERR_ALREADYREGISTRED
352 463 = ERR_NOPERMFORHOST
353 464 = ERR_PASSWDMISMATCH
354 465 = ERR_YOUREBANNEDCREEP
355 466 = ERR_YOUWILLBEBANNED
357 471 = ERR_CHANNELISFULL
358 472 = ERR_UNKNOWNMODE
359 473 = ERR_INVITEONLYCHAN
360 474 = ERR_BANNEDFROMCHAN
361 475 = ERR_BADCHANNELKEY
362 476 = ERR_BADCHANMASK
363 477 = ERR_NOCHANMODES
364 478 = ERR_BANLISTFULL
365 481 = ERR_NOPRIVILEGES
366 482 = ERR_CHANOPRIVSNEEDED
367 483 = ERR_CANTKILLSERVER
369 485 = ERR_UNIQOPPRIVSNEEDED
371 501 = ERR_UMODEUNKNOWNFLAG
372 502 = ERR_USERSDONTMATCH
375 instance toInt IRCErrors where
378 ERR_NOSUCHSERVER = 402
379 ERR_NOSUCHCHANNEL = 403
380 ERR_CANNOTSENDTOCHAN = 404
381 ERR_TOOMANYCHANNELS = 405
382 ERR_WASNOSUCHNICK = 406
383 ERR_TOOMANYTARGETS = 407
384 ERR_NOSUCHSERVICE = 408
386 ERR_NORECIPIENT = 411
387 ERR_NOTEXTTOSEND = 412
389 ERR_WILDTOPLEVEL = 414
391 ERR_UNKNOWNCOMMAND = 421
393 ERR_NOADMININFO = 423
395 ERR_NONICKNAMEGIVEN = 431
396 ERR_ERRONEUSNICKNAME = 432
397 ERR_NICKNAMEINUSE = 433
398 ERR_NICKCOLLISION = 436
399 ERR_UNAVAILRESOURCE = 437
400 ERR_USERNOTINCHANNEL = 441
401 ERR_NOTONCHANNEL = 442
402 ERR_USERONCHANNEL = 443
404 ERR_SUMMONDISABLED = 445
405 ERR_USERSDISABLED = 446
406 ERR_NOTREGISTERED = 451
407 ERR_NEEDMOREPARAMS = 461
408 ERR_ALREADYREGISTRED = 462
409 ERR_NOPERMFORHOST = 463
410 ERR_PASSWDMISMATCH = 464
411 ERR_YOUREBANNEDCREEP = 465
412 ERR_YOUWILLBEBANNED = 466
414 ERR_CHANNELISFULL = 471
415 ERR_UNKNOWNMODE = 472
416 ERR_INVITEONLYCHAN = 473
417 ERR_BANNEDFROMCHAN = 474
418 ERR_BADCHANNELKEY = 475
419 ERR_BADCHANMASK = 476
420 ERR_NOCHANMODES = 477
421 ERR_BANLISTFULL = 478
422 ERR_NOPRIVILEGES = 481
423 ERR_CHANOPRIVSNEEDED = 482
424 ERR_CANTKILLSERVER = 483
426 ERR_UNIQOPPRIVSNEEDED = 485
428 ERR_UMODEUNKNOWNFLAG = 501
429 ERR_USERSDONTMATCH = 502