1 implementation module IRC
12 import Text.Parsers.Simple.Core
13 import Text.Parsers.Simple.Chars
15 import Control.Applicative
16 from Data.Functor import <$>
18 from Data.Func import $
19 from Text import class Text(concat), instance Text String
21 from StdMisc import undef
25 derive gPrint IRCCommands, IRCReplies, IRCErrors, (,), Maybe, (), Either
28 { irc_prefix :: Maybe (Either String IRCUser)
29 , irc_command :: IRCCommands
34 , irc_user :: Maybe String
35 , irc_host :: Maybe String
38 //Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 PRIVMSG #cloogle :!query ^_^\r\n"
39 Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n"
41 (<+) infixr 5 :: a b -> String | toString a & toString b
42 (<+) a b = toString a +++ toString b
44 parseIRCMessage :: (String -> Either [Error] IRCMessage)
45 parseIRCMessage = parse parseMessage o fromString
47 parseMessage :: Parser Char IRCMessage
48 parseMessage = optional (parseEither parseHost parseUser) <* spaceParser
49 >>= \mprefix->parseCommand
50 <* pToken '\r' <* pToken '\n'
51 >>= \cmd->pure {IRCMessage | irc_prefix=mprefix, irc_command=cmd}
53 pCommand :: String -> Parser Char [Char]
54 pCommand s = pList (map pToken $ fromString s) <* spaceParser
56 parseCommand :: Parser Char IRCCommands
57 parseCommand = pFail//pCommand "QUIT" >>| QUIT <$> optional (pure "")
60 spaceParser :: Parser Char [Char]
61 spaceParser = pMany $ pToken ' '
63 parseServer :: Parser Char String
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
70 parseUser = pToken ':' >>| parseNick
71 >>= \nick->optional (pToken '!' >>| parseUsr)
72 >>= \muser->optional (pToken '@' >>| parseHost)
73 >>= \mhost->pure {IRCUser | irc_nick=nick, irc_user=muser, irc_host=mhost}
75 parseUsr :: Parser Char String
76 parseUsr = toString <$> pSome (pSatisfy (not o flip isMember [' ', '\x00', '\x0d', '\x0a', '@']))
78 parseNick :: Parser Char String
79 parseNick = pAlpha >>= \c->pMany (pAlpha <|> pDigit <|> pSpecial)
80 >>= \cs->pure (toString [c:cs])
82 pSpecial :: Parser Char Char
83 pSpecial = pOneOf ['-', '[', ']', '\\', '\`', '^', '{', '}']
85 parseHost :: Parser Char String
87 >>= \nm->pMany (pToken '.' >>| parseName)
88 >>= \nms->pure (concat [nm:nms])
90 parseName :: Parser Char String
91 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pToken '.')
93 IRCCommandParser :: Parser Char IRCCommands
94 IRCCommandParser = pFail
96 instance toString IRCMessage where
97 toString m = maybe "" (\s->either id ((<+) ":") s <+ " ") m.irc_prefix <+ m.irc_command
99 instance toString IRCUser where
100 toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
101 <+ maybe "" ((<+) "@") m.irc_host
103 instance toString IRCCommands where
104 toString r = flip (+++) "\r\n" case r of
105 //ADMIN (Maybe String)
107 //CONNECT String Int (Maybe String)
110 //INFO (Maybe String)
111 //INVITE String String
113 JOIN chs = "JOIN " +++ (if (isEmpty chs) "0"
114 (jon ", " [jon " " [ch:maybeToList mk]\\(ch, mk)<-chs]))
115 //KICK String String (Maybe String)
117 //LINKS (Maybe (Maybe String, String))
119 //LUSERS (Maybe (String, Maybe String))
121 //MOTD (Maybe String)
123 NICK n = jon " " ["NICK", n]
125 //NOTICE String String
129 PING a mb = jon " " ["PING",a:maybeToList mb]
130 PONG a mb = jon " " ["PONG",a:maybeToList mb]
131 PRIVMSG dest msg = jon " " ["PRIVMSG", dest, ":"+++msg]
132 QUIT msg = jon " " ["QUIT":maybeToList msg]
136 //SERVICE String String String String
137 //SERVLIST (Maybe (String, Maybe String))
138 //SQUERY String String
140 //SQUIT String String
141 //STATS (Maybe (String, Maybe String))
142 //SUMMON String (Maybe (String, Maybe String))
143 //TIME (Maybe String)
144 //TOPIC String (Maybe String)
145 //TRACE (Maybe String)
146 USER login mode rn = jon " " ["USER", login, toString mode, "*", ":"+++rn]
148 //USERS (Maybe String)
149 //VERSION (Maybe String)
152 //WHOIS (Maybe String) [String]
153 //WHOWAS (Maybe String) [String]
157 instance toString IRCReplies where toString r = printToString r
158 instance toString IRCErrors where toString r = printToString r
160 instance fromInt IRCReplies where
161 fromInt r = case r of
168 201 = RPL_TRACECONNECTING
169 202 = RPL_TRACEHANDSHAKE
170 203 = RPL_TRACEUNKNOWN
171 204 = RPL_TRACEOPERATOR
173 206 = RPL_TRACESERVER
174 207 = RPL_TRACESERVICE
175 208 = RPL_TRACENEWTYPE
177 210 = RPL_TRACERECONNECT
178 211 = RPL_STATSLINKINFO
179 212 = RPL_STATSCOMMANDS
183 235 = RPL_SERVLISTEND
184 242 = RPL_STATSUPTIME
186 251 = RPL_LUSERCLIENT
188 253 = RPL_LUSERUNKNOWN
189 254 = RPL_LUSERCHANNELS
204 312 = RPL_WHOISSERVER
205 313 = RPL_WHOISOPERATOR
210 319 = RPL_WHOISCHANNELS
214 324 = RPL_CHANNELMODEIS
221 347 = RPL_ENDOFINVITELIST
223 349 = RPL_ENDOFEXCEPTLIST
231 368 = RPL_ENDOFBANLIST
232 369 = RPL_ENDOFWHOWAS
240 383 = RPL_YOURESERVICE
248 instance toInt IRCReplies where
256 RPL_TRACECONNECTING = 201
257 RPL_TRACEHANDSHAKE = 202
258 RPL_TRACEUNKNOWN = 203
259 RPL_TRACEOPERATOR = 204
261 RPL_TRACESERVER = 206
262 RPL_TRACESERVICE = 207
263 RPL_TRACENEWTYPE = 208
265 RPL_TRACERECONNECT = 210
266 RPL_STATSLINKINFO = 211
267 RPL_STATSCOMMANDS = 212
271 RPL_SERVLISTEND = 234
272 RPL_STATSUPTIME = 242
274 RPL_LUSERCLIENT = 251
276 RPL_LUSERUNKNOWN = 253
277 RPL_LUSERCHANNELS = 254
292 RPL_WHOISSERVER = 312
293 RPL_WHOISOPERATOR = 313
298 RPL_WHOISCHANNELS = 319
302 RPL_CHANNELMODEIS = 324
309 RPL_ENDOFINVITELIST = 347
311 RPL_ENDOFEXCEPTLIST = 349
319 RPL_ENDOFBANLIST = 367
320 RPL_ENDOFWHOWAS = 369
328 RPL_YOURESERVICE = 383
335 instance fromInt IRCErrors where
336 fromInt r = case r of
338 402 = ERR_NOSUCHSERVER
339 403 = ERR_NOSUCHCHANNEL
340 404 = ERR_CANNOTSENDTOCHAN
341 405 = ERR_TOOMANYCHANNELS
342 406 = ERR_WASNOSUCHNICK
343 407 = ERR_TOOMANYTARGETS
344 408 = ERR_NOSUCHSERVICE
346 411 = ERR_NORECIPIENT
347 412 = ERR_NOTEXTTOSEND
349 414 = ERR_WILDTOPLEVEL
351 421 = ERR_UNKNOWNCOMMAND
353 423 = ERR_NOADMININFO
355 431 = ERR_NONICKNAMEGIVEN
356 432 = ERR_ERRONEUSNICKNAME
357 433 = ERR_NICKNAMEINUSE
358 436 = ERR_NICKCOLLISION
359 437 = ERR_UNAVAILRESOURCE
360 441 = ERR_USERNOTINCHANNEL
361 442 = ERR_NOTONCHANNEL
362 443 = ERR_USERONCHANNEL
364 445 = ERR_SUMMONDISABLED
365 446 = ERR_USERSDISABLED
366 451 = ERR_NOTREGISTERED
367 461 = ERR_NEEDMOREPARAMS
368 462 = ERR_ALREADYREGISTRED
369 463 = ERR_NOPERMFORHOST
370 464 = ERR_PASSWDMISMATCH
371 465 = ERR_YOUREBANNEDCREEP
372 466 = ERR_YOUWILLBEBANNED
374 471 = ERR_CHANNELISFULL
375 472 = ERR_UNKNOWNMODE
376 473 = ERR_INVITEONLYCHAN
377 474 = ERR_BANNEDFROMCHAN
378 475 = ERR_BADCHANNELKEY
379 476 = ERR_BADCHANMASK
380 477 = ERR_NOCHANMODES
381 478 = ERR_BANLISTFULL
382 481 = ERR_NOPRIVILEGES
383 482 = ERR_CHANOPRIVSNEEDED
384 483 = ERR_CANTKILLSERVER
386 485 = ERR_UNIQOPPRIVSNEEDED
388 501 = ERR_UMODEUNKNOWNFLAG
389 502 = ERR_USERSDONTMATCH
391 instance toInt IRCErrors where
394 ERR_NOSUCHSERVER = 402
395 ERR_NOSUCHCHANNEL = 403
396 ERR_CANNOTSENDTOCHAN = 404
397 ERR_TOOMANYCHANNELS = 405
398 ERR_WASNOSUCHNICK = 406
399 ERR_TOOMANYTARGETS = 407
400 ERR_NOSUCHSERVICE = 408
402 ERR_NORECIPIENT = 411
403 ERR_NOTEXTTOSEND = 412
405 ERR_WILDTOPLEVEL = 414
407 ERR_UNKNOWNCOMMAND = 421
409 ERR_NOADMININFO = 423
411 ERR_NONICKNAMEGIVEN = 431
412 ERR_ERRONEUSNICKNAME = 432
413 ERR_NICKNAMEINUSE = 433
414 ERR_NICKCOLLISION = 436
415 ERR_UNAVAILRESOURCE = 437
416 ERR_USERNOTINCHANNEL = 441
417 ERR_NOTONCHANNEL = 442
418 ERR_USERONCHANNEL = 443
420 ERR_SUMMONDISABLED = 445
421 ERR_USERSDISABLED = 446
422 ERR_NOTREGISTERED = 451
423 ERR_NEEDMOREPARAMS = 461
424 ERR_ALREADYREGISTRED = 462
425 ERR_NOPERMFORHOST = 463
426 ERR_PASSWDMISMATCH = 464
427 ERR_YOUREBANNEDCREEP = 465
428 ERR_YOUWILLBEBANNED = 466
430 ERR_CHANNELISFULL = 471
431 ERR_UNKNOWNMODE = 472
432 ERR_INVITEONLYCHAN = 473
433 ERR_BANNEDFROMCHAN = 474
434 ERR_BADCHANNELKEY = 475
435 ERR_BADCHANMASK = 476
436 ERR_NOCHANMODES = 477
437 ERR_BANLISTFULL = 478
438 ERR_NOPRIVILEGES = 481
439 ERR_CHANOPRIVSNEEDED = 482
440 ERR_CANTKILLSERVER = 483
442 ERR_UNIQOPPRIVSNEEDED = 485
444 ERR_UMODEUNKNOWNFLAG = 501
445 ERR_USERSDONTMATCH = 502