1 implementation module IRC
12 import Text.Parsers.Simple.Core
13 import Text.Parsers.Simple.Chars
16 import Control.Applicative
17 from Data.Functor import <$>
19 from Data.Func import $
20 from Text import class Text(concat), instance Text String
22 from StdMisc import undef
26 derive gPrint IRCCommand, IRCReplies, IRCErrors, (,), Maybe, (), Either
28 //Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n"
29 //Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 AWAY test\r\n"
30 Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 AWAY test with spaces\r\n"
32 (<+) infixr 5 :: a b -> String | toString a & toString b
33 (<+) a b = toString a +++ toString b
35 parseIRCMessage :: (String -> Either [Error] IRCMessage)
36 parseIRCMessage = parse parseMessage o fromString
38 parseMessage :: Parser Char IRCMessage
39 parseMessage = optional (parseEither parseHost parseUser) <* spaceParser
40 >>= \mprefix->parseCommand
41 <* pToken '\r' <* pToken '\n'
42 >>= \cmd->pure {IRCMessage | irc_prefix=mprefix, irc_command=cmd}
44 spaceParser :: Parser Char [Char]
45 spaceParser = pMany $ pToken ' '
47 parseServer :: Parser Char String
50 parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
51 parseEither p q = Left <$> p <|> Right <$> q
53 parseUser :: Parser Char IRCUser
54 parseUser = pToken ':' >>| parseNick
55 >>= \nick->optional (pToken '!' >>| parseUsr)
56 >>= \muser->optional (pToken '@' >>| parseHost)
57 >>= \mhost->pure {IRCUser | irc_nick=nick, irc_user=muser, irc_host=mhost}
59 parseUsr :: Parser Char String
60 parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
62 parseNick :: Parser Char String
63 parseNick = pAlpha >>= \c->pMany (pAlpha <|> pDigit <|> pSpecial)
64 >>= \cs->pure (toString [c:cs])
66 pSpecial :: Parser Char Char
67 pSpecial = pOneOf ['-', '[', ']', '\\', '\`', '^', '{', '}']
69 parseHost :: Parser Char String
71 >>= \nm->pMany (pToken '.' >>| parseName)
72 >>= \nms->pure (concat [nm:nms])
74 parseName :: Parser Char String
75 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pToken '.')
77 instance toString IRCMessage where
78 toString m = maybe "" (\s->either id ((<+) ":") s <+ " ") m.irc_prefix <+ m.irc_command
80 instance toString IRCUser where
81 toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
82 <+ maybe "" ((<+) "@") m.irc_host
87 pMiddle :: Parser Char String
88 pMiddle = fmap toString $
89 spaceParser >>| pToken ':' >>| pMany (pNoneOf illegal)
91 pTrailing :: Parser Char String
92 pTrailing = fmap toString $
93 spaceParser >>| liftM2 cons (pNotSatisfy ((==)':')) (pMany $ pNoneOf [' ':illegal])
95 pParam :: Parser Char String
96 pParam = pMiddle <|> pTrailing
98 pNoneOf :: [a] -> Parser a a | Eq a
99 pNoneOf l = pSatisfy (not o flip isMember l)
101 pNotSatisfy :: (a -> Bool) -> Parser a a | Eq a
102 pNotSatisfy f = pSatisfy (not o f)
104 pInt :: Parser Char Int
105 pInt = toInt o toString <$> (spaceParser >>| pSome pDigit)
108 illegal = ['\x00','\r','\n']
110 pCommand :: String -> Parser Char [Char]
111 pCommand s = pList (map pToken $ fromString s)
113 pCommand0 :: String IRCCommand -> Parser Char IRCCommand
114 pCommand0 s c = pCommand s >>| pure c
116 pCommand1 :: String (Parser Char a) (a -> IRCCommand) -> Parser Char IRCCommand
117 pCommand1 s p c = pCommand s >>| liftM c p
119 pCommand2 :: String (Parser Char a) (Parser Char b) (a b -> IRCCommand) -> Parser Char IRCCommand
120 pCommand2 s p q c = pCommand s >>| liftM2 c p q
122 pCommand3 :: String (Parser Char a) (Parser Char b) (Parser Char c) (a b c -> IRCCommand) -> Parser Char IRCCommand
123 pCommand3 s p q r c = pCommand s >>| liftM3 c p q r
125 parseCommand :: Parser Char IRCCommand
127 pCommand1 "ADMIN" (optional pMiddle) ADMIN
128 <|> pCommand1 "AWAY" pParam AWAY
129 <|> pCommand2 "CONNECT" pParam (optional $ liftM2 tuple pInt (optional pParam)) CONNECT
130 <|> pCommand0 "DIE" DIE
131 <|> pCommand1 "ERROR" pParam ERROR
132 <|> pCommand1 "INFO" (optional pParam) INFO
133 <|> pCommand2 "INVITE" pMiddle pMiddle INVITE
134 <|> pCommand1 "ISON" (pSome pMiddle) ISON
135 <|> pCommand1 "JOIN" (pSepBy (liftM2 tuple pMiddle $ optional pMiddle) pComma) JOIN
136 <|> pCommand3 "KICK" pMiddle pMiddle (optional pParam) KICK
137 <|> pCommand2 "KILL" pMiddle pParam KILL
138 <|> pCommand1 "LINKS" (optional (liftM2 tuple (optional pMiddle) pMiddle)) LINKS
139 //<|> pCommand "QUIT" (optional pParam))
141 instance toString IRCCommand where
142 toString r = flip (+++) "\r\n" case r of
143 //ADMIN (Maybe String)
145 //CONNECT String (Maybe (Int, Maybe String))
148 //INFO (Maybe String)
149 //INVITE String String
151 JOIN chs = "JOIN " +++ (if (isEmpty chs) "0"
152 (jon ", " [jon " " [ch:maybeToList mk]\\(ch, mk)<-chs]))
153 //KICK String String (Maybe String)
155 //LINKS (Maybe (Maybe String, String))
157 //LUSERS (Maybe (String, Maybe String))
159 //MOTD (Maybe String)
161 NICK n = jon " " ["NICK", n]
163 //NOTICE String String
167 PING a mb = jon " " ["PING",a:maybeToList mb]
168 PONG a mb = jon " " ["PONG",a:maybeToList mb]
169 PRIVMSG dest msg = jon " " ["PRIVMSG", dest, ":"+++msg]
170 QUIT msg = jon " " ["QUIT":maybeToList msg]
174 //SERVICE String String String String
175 //SERVLIST (Maybe (String, Maybe String))
176 //SQUERY String String
178 //SQUIT String String
179 //STATS (Maybe (String, Maybe String))
180 //SUMMON String (Maybe (String, Maybe String))
181 //TIME (Maybe String)
182 //TOPIC String (Maybe String)
183 //TRACE (Maybe String)
184 USER login mode rn = jon " " ["USER", login, toString mode, "*", ":"+++rn]
186 //USERS (Maybe String)
187 //VERSION (Maybe String)
190 //WHOIS (Maybe String) [String]
191 //WHOWAS (Maybe String) [String]
195 instance toString IRCReplies where toString r = printToString r
196 instance toString IRCErrors where toString r = printToString r
198 instance fromInt IRCReplies where
199 fromInt r = case r of
206 201 = RPL_TRACECONNECTING
207 202 = RPL_TRACEHANDSHAKE
208 203 = RPL_TRACEUNKNOWN
209 204 = RPL_TRACEOPERATOR
211 206 = RPL_TRACESERVER
212 207 = RPL_TRACESERVICE
213 208 = RPL_TRACENEWTYPE
215 210 = RPL_TRACERECONNECT
216 211 = RPL_STATSLINKINFO
217 212 = RPL_STATSCOMMANDS
221 235 = RPL_SERVLISTEND
222 242 = RPL_STATSUPTIME
224 251 = RPL_LUSERCLIENT
226 253 = RPL_LUSERUNKNOWN
227 254 = RPL_LUSERCHANNELS
242 312 = RPL_WHOISSERVER
243 313 = RPL_WHOISOPERATOR
248 319 = RPL_WHOISCHANNELS
252 324 = RPL_CHANNELMODEIS
259 347 = RPL_ENDOFINVITELIST
261 349 = RPL_ENDOFEXCEPTLIST
269 368 = RPL_ENDOFBANLIST
270 369 = RPL_ENDOFWHOWAS
278 383 = RPL_YOURESERVICE
286 instance toInt IRCReplies where
294 RPL_TRACECONNECTING = 201
295 RPL_TRACEHANDSHAKE = 202
296 RPL_TRACEUNKNOWN = 203
297 RPL_TRACEOPERATOR = 204
299 RPL_TRACESERVER = 206
300 RPL_TRACESERVICE = 207
301 RPL_TRACENEWTYPE = 208
303 RPL_TRACERECONNECT = 210
304 RPL_STATSLINKINFO = 211
305 RPL_STATSCOMMANDS = 212
309 RPL_SERVLISTEND = 234
310 RPL_STATSUPTIME = 242
312 RPL_LUSERCLIENT = 251
314 RPL_LUSERUNKNOWN = 253
315 RPL_LUSERCHANNELS = 254
330 RPL_WHOISSERVER = 312
331 RPL_WHOISOPERATOR = 313
336 RPL_WHOISCHANNELS = 319
340 RPL_CHANNELMODEIS = 324
347 RPL_ENDOFINVITELIST = 347
349 RPL_ENDOFEXCEPTLIST = 349
357 RPL_ENDOFBANLIST = 367
358 RPL_ENDOFWHOWAS = 369
366 RPL_YOURESERVICE = 383
373 instance fromInt IRCErrors where
374 fromInt r = case r of
376 402 = ERR_NOSUCHSERVER
377 403 = ERR_NOSUCHCHANNEL
378 404 = ERR_CANNOTSENDTOCHAN
379 405 = ERR_TOOMANYCHANNELS
380 406 = ERR_WASNOSUCHNICK
381 407 = ERR_TOOMANYTARGETS
382 408 = ERR_NOSUCHSERVICE
384 411 = ERR_NORECIPIENT
385 412 = ERR_NOTEXTTOSEND
387 414 = ERR_WILDTOPLEVEL
389 421 = ERR_UNKNOWNCOMMAND
391 423 = ERR_NOADMININFO
393 431 = ERR_NONICKNAMEGIVEN
394 432 = ERR_ERRONEUSNICKNAME
395 433 = ERR_NICKNAMEINUSE
396 436 = ERR_NICKCOLLISION
397 437 = ERR_UNAVAILRESOURCE
398 441 = ERR_USERNOTINCHANNEL
399 442 = ERR_NOTONCHANNEL
400 443 = ERR_USERONCHANNEL
402 445 = ERR_SUMMONDISABLED
403 446 = ERR_USERSDISABLED
404 451 = ERR_NOTREGISTERED
405 461 = ERR_NEEDMOREPARAMS
406 462 = ERR_ALREADYREGISTRED
407 463 = ERR_NOPERMFORHOST
408 464 = ERR_PASSWDMISMATCH
409 465 = ERR_YOUREBANNEDCREEP
410 466 = ERR_YOUWILLBEBANNED
412 471 = ERR_CHANNELISFULL
413 472 = ERR_UNKNOWNMODE
414 473 = ERR_INVITEONLYCHAN
415 474 = ERR_BANNEDFROMCHAN
416 475 = ERR_BADCHANNELKEY
417 476 = ERR_BADCHANMASK
418 477 = ERR_NOCHANMODES
419 478 = ERR_BANLISTFULL
420 481 = ERR_NOPRIVILEGES
421 482 = ERR_CHANOPRIVSNEEDED
422 483 = ERR_CANTKILLSERVER
424 485 = ERR_UNIQOPPRIVSNEEDED
426 501 = ERR_UMODEUNKNOWNFLAG
427 502 = ERR_USERSDONTMATCH
429 instance toInt IRCErrors where
432 ERR_NOSUCHSERVER = 402
433 ERR_NOSUCHCHANNEL = 403
434 ERR_CANNOTSENDTOCHAN = 404
435 ERR_TOOMANYCHANNELS = 405
436 ERR_WASNOSUCHNICK = 406
437 ERR_TOOMANYTARGETS = 407
438 ERR_NOSUCHSERVICE = 408
440 ERR_NORECIPIENT = 411
441 ERR_NOTEXTTOSEND = 412
443 ERR_WILDTOPLEVEL = 414
445 ERR_UNKNOWNCOMMAND = 421
447 ERR_NOADMININFO = 423
449 ERR_NONICKNAMEGIVEN = 431
450 ERR_ERRONEUSNICKNAME = 432
451 ERR_NICKNAMEINUSE = 433
452 ERR_NICKCOLLISION = 436
453 ERR_UNAVAILRESOURCE = 437
454 ERR_USERNOTINCHANNEL = 441
455 ERR_NOTONCHANNEL = 442
456 ERR_USERONCHANNEL = 443
458 ERR_SUMMONDISABLED = 445
459 ERR_USERSDISABLED = 446
460 ERR_NOTREGISTERED = 451
461 ERR_NEEDMOREPARAMS = 461
462 ERR_ALREADYREGISTRED = 462
463 ERR_NOPERMFORHOST = 463
464 ERR_PASSWDMISMATCH = 464
465 ERR_YOUREBANNEDCREEP = 465
466 ERR_YOUWILLBEBANNED = 466
468 ERR_CHANNELISFULL = 471
469 ERR_UNKNOWNMODE = 472
470 ERR_INVITEONLYCHAN = 473
471 ERR_BANNEDFROMCHAN = 474
472 ERR_BADCHANNELKEY = 475
473 ERR_BADCHANMASK = 476
474 ERR_NOCHANMODES = 477
475 ERR_BANLISTFULL = 478
476 ERR_NOPRIVILEGES = 481
477 ERR_CHANOPRIVSNEEDED = 482
478 ERR_CANTKILLSERVER = 483
480 ERR_UNIQOPPRIVSNEEDED = 485
482 ERR_UMODEUNKNOWNFLAG = 501
483 ERR_USERSDONTMATCH = 502