1 implementation module IRC
5 import Control.Applicative
6 import Control.Monad => qualified join
12 import Text.Parsers.Simple.Chars
13 import Text.Parsers.Simple.Core
17 derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
19 Start = (map (fmap toString) msgs, msgs)
22 [ parseIRCMessage ":clooglebot!~cloogle@dhcp-077-249-221-037.chello.nl QUIT\r\n"
23 , parseIRCMessage ":clooglebot!~cloogle QUIT\r\n"
24 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n"
25 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY test\r\n"
26 , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY :test with spaces\r\n"
27 , parseIRCMessage ":cherryh.freenode.net NOTICE * :*** Found your hostname\r\n"
28 , parseIRCMessage ":cherryh.freenode.net QUIT :hoi hoi\r\n"
29 , parseIRCMessage ":cherryh.freenode.net JOIN #cha,#ch-b #twilight\r\n"
30 , parseIRCMessage ":cherryh.freenode.net ISON a b c d e f :g h\r\n"
31 , parseIRCMessage ":wilhelm.freenode.net 001 clooglebot :Welcome to the freenode Internet Relay Chat Network clooglebot\r\n"
32 , parseIRCMessage "PING :orwell.freenode.net\r\n"
33 , parseIRCMessage ":ChanServ!ChanServ@services. MODE #cloogle +o frobnicator\r\n"
34 , parseIRCMessage ":qbot_v01!~qbot@ip-213-124-170-20.ip.prioritytelecom.net PRIVMSG ##chinees :[link] Cloogle - https://cloogle.org"
37 parseIRCMessage :: String -> Either [Error] IRCMessage
38 parseIRCMessage s = case runParser parsePrefix (fromString s) of
40 ([(prefix, rest):_], _)
41 //Try parsing a numeric reply
42 = case parse parseReply rest of
43 //Try a normal command
44 Left e = case parseCmd rest of
46 Right cmd = Right {IRCMessage | irc_prefix=prefix, irc_command=Right cmd}
47 Right repl = Right {IRCMessage | irc_prefix=prefix, irc_command=Left repl}
48 // Error parsing prefix
49 (_, es) = Left ["Error parsing prefix"]
52 parsePrefix :: Parser Char (Maybe (Either IRCUser String))
54 = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ')
56 parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
57 parseEither p q = Left <$> p <|> Right <$> q
59 parseUser :: Parser Char IRCUser
61 >>= \nick->optional (pToken '!' >>| parseUsr)
62 >>= \muser->optional (pToken '@' >>| parseHost)
63 >>= \mhost->pure {IRCUser
64 | irc_nick=nick, irc_user=muser, irc_host=mhost}
66 parseUsr :: Parser Char String
67 parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
69 parseNick :: Parser Char String
71 >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "_-[]\\`^{}"))
72 >>= \cs->pure (toString [c:cs])
74 parseHost :: Parser Char String
75 parseHost = join "." <$> (pSepBy parseName (pToken '.'))
76 >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s)
78 parseName :: Parser Char String
79 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/'])
82 parseCmd :: [Char] -> Either Error IRCCommand
83 parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
85 argfun :: [String] -> [String]
89 | x.[0] == ':' = [join " " $ [x % (1, size x):map rtrim xs]]
90 | otherwise = [x:argfun xs]
93 parseReply :: Parser Char IRCNumReply
94 parseReply = spaceParser
95 >>| (pMany (pToken '0') >>| pSome pDigit <* spaceParser)
96 >>= \rep->(toString <$> pSome (pNoneOf [' ':illegal]) <* spaceParser)
97 >>= \rec->(toString <$> pSome (pNoneOf illegal))
98 >>= \msg->pure {IRCNumReply
99 | irc_reply = fromInt $ toInt $ toString rep
100 , irc_recipient = rec
101 , irc_message = msg % (if (msg.[0] == ':') 1 0, size msg)
103 <* pToken '\r' <* pToken '\n'
105 spaceParser :: Parser Char [Char]
106 spaceParser = pMany $ pToken ' '
109 pNoneOf :: [a] -> Parser a a | Eq a
110 pNoneOf l = pSatisfy (not o flip isMember l)
113 illegal = ['\x00','\r','\n']
115 instance toString IRCNumReply where
116 toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+
117 m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message)
118 instance toString IRCMessage where
119 toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix
120 <+ either toString toString m.irc_command
121 instance toString IRCUser where
122 toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user
123 <+ maybe "" ((<+) "@") m.irc_host
124 instance toString IRCCommand where
125 toString m = join " " (gIRCPrint{|*|} m) +++ "\r\n"
126 instance toString IRCReplies where toString r = printToString r
127 instance toString IRCErrors where toString r = printToString r
129 (<+) infixr 5 :: a b -> String | toString a & toString b
130 (<+) a b = toString a +++ toString b
132 instance fromInt IRCReplies where
133 fromInt r = case r of
140 201 = RPL_TRACECONNECTING
141 202 = RPL_TRACEHANDSHAKE
142 203 = RPL_TRACEUNKNOWN
143 204 = RPL_TRACEOPERATOR
145 206 = RPL_TRACESERVER
146 207 = RPL_TRACESERVICE
147 208 = RPL_TRACENEWTYPE
149 210 = RPL_TRACERECONNECT
150 211 = RPL_STATSLINKINFO
151 212 = RPL_STATSCOMMANDS
155 235 = RPL_SERVLISTEND
156 242 = RPL_STATSUPTIME
158 251 = RPL_LUSERCLIENT
160 253 = RPL_LUSERUNKNOWN
161 254 = RPL_LUSERCHANNELS
176 312 = RPL_WHOISSERVER
177 313 = RPL_WHOISOPERATOR
182 319 = RPL_WHOISCHANNELS
186 324 = RPL_CHANNELMODEIS
193 347 = RPL_ENDOFINVITELIST
195 349 = RPL_ENDOFEXCEPTLIST
203 368 = RPL_ENDOFBANLIST
204 369 = RPL_ENDOFWHOWAS
212 383 = RPL_YOURESERVICE
220 instance toInt IRCReplies where
228 RPL_TRACECONNECTING = 201
229 RPL_TRACEHANDSHAKE = 202
230 RPL_TRACEUNKNOWN = 203
231 RPL_TRACEOPERATOR = 204
233 RPL_TRACESERVER = 206
234 RPL_TRACESERVICE = 207
235 RPL_TRACENEWTYPE = 208
237 RPL_TRACERECONNECT = 210
238 RPL_STATSLINKINFO = 211
239 RPL_STATSCOMMANDS = 212
243 RPL_SERVLISTEND = 234
244 RPL_STATSUPTIME = 242
246 RPL_LUSERCLIENT = 251
248 RPL_LUSERUNKNOWN = 253
249 RPL_LUSERCHANNELS = 254
264 RPL_WHOISSERVER = 312
265 RPL_WHOISOPERATOR = 313
270 RPL_WHOISCHANNELS = 319
274 RPL_CHANNELMODEIS = 324
281 RPL_ENDOFINVITELIST = 347
283 RPL_ENDOFEXCEPTLIST = 349
291 RPL_ENDOFBANLIST = 367
292 RPL_ENDOFWHOWAS = 369
300 RPL_YOURESERVICE = 383
308 instance fromInt IRCErrors where
309 fromInt r = case r of
311 402 = ERR_NOSUCHSERVER
312 403 = ERR_NOSUCHCHANNEL
313 404 = ERR_CANNOTSENDTOCHAN
314 405 = ERR_TOOMANYCHANNELS
315 406 = ERR_WASNOSUCHNICK
316 407 = ERR_TOOMANYTARGETS
317 408 = ERR_NOSUCHSERVICE
319 411 = ERR_NORECIPIENT
320 412 = ERR_NOTEXTTOSEND
322 414 = ERR_WILDTOPLEVEL
324 421 = ERR_UNKNOWNCOMMAND
326 423 = ERR_NOADMININFO
328 431 = ERR_NONICKNAMEGIVEN
329 432 = ERR_ERRONEUSNICKNAME
330 433 = ERR_NICKNAMEINUSE
331 436 = ERR_NICKCOLLISION
332 437 = ERR_UNAVAILRESOURCE
333 441 = ERR_USERNOTINCHANNEL
334 442 = ERR_NOTONCHANNEL
335 443 = ERR_USERONCHANNEL
337 445 = ERR_SUMMONDISABLED
338 446 = ERR_USERSDISABLED
339 451 = ERR_NOTREGISTERED
340 461 = ERR_NEEDMOREPARAMS
341 462 = ERR_ALREADYREGISTRED
342 463 = ERR_NOPERMFORHOST
343 464 = ERR_PASSWDMISMATCH
344 465 = ERR_YOUREBANNEDCREEP
345 466 = ERR_YOUWILLBEBANNED
347 471 = ERR_CHANNELISFULL
348 472 = ERR_UNKNOWNMODE
349 473 = ERR_INVITEONLYCHAN
350 474 = ERR_BANNEDFROMCHAN
351 475 = ERR_BADCHANNELKEY
352 476 = ERR_BADCHANMASK
353 477 = ERR_NOCHANMODES
354 478 = ERR_BANLISTFULL
355 481 = ERR_NOPRIVILEGES
356 482 = ERR_CHANOPRIVSNEEDED
357 483 = ERR_CANTKILLSERVER
359 485 = ERR_UNIQOPPRIVSNEEDED
361 501 = ERR_UMODEUNKNOWNFLAG
362 502 = ERR_USERSDONTMATCH
365 instance toInt IRCErrors where
368 ERR_NOSUCHSERVER = 402
369 ERR_NOSUCHCHANNEL = 403
370 ERR_CANNOTSENDTOCHAN = 404
371 ERR_TOOMANYCHANNELS = 405
372 ERR_WASNOSUCHNICK = 406
373 ERR_TOOMANYTARGETS = 407
374 ERR_NOSUCHSERVICE = 408
376 ERR_NORECIPIENT = 411
377 ERR_NOTEXTTOSEND = 412
379 ERR_WILDTOPLEVEL = 414
381 ERR_UNKNOWNCOMMAND = 421
383 ERR_NOADMININFO = 423
385 ERR_NONICKNAMEGIVEN = 431
386 ERR_ERRONEUSNICKNAME = 432
387 ERR_NICKNAMEINUSE = 433
388 ERR_NICKCOLLISION = 436
389 ERR_UNAVAILRESOURCE = 437
390 ERR_USERNOTINCHANNEL = 441
391 ERR_NOTONCHANNEL = 442
392 ERR_USERONCHANNEL = 443
394 ERR_SUMMONDISABLED = 445
395 ERR_USERSDISABLED = 446
396 ERR_NOTREGISTERED = 451
397 ERR_NEEDMOREPARAMS = 461
398 ERR_ALREADYREGISTRED = 462
399 ERR_NOPERMFORHOST = 463
400 ERR_PASSWDMISMATCH = 464
401 ERR_YOUREBANNEDCREEP = 465
402 ERR_YOUWILLBEBANNED = 466
404 ERR_CHANNELISFULL = 471
405 ERR_UNKNOWNMODE = 472
406 ERR_INVITEONLYCHAN = 473
407 ERR_BANNEDFROMCHAN = 474
408 ERR_BADCHANNELKEY = 475
409 ERR_BADCHANMASK = 476
410 ERR_NOCHANMODES = 477
411 ERR_BANLISTFULL = 478
412 ERR_NOPRIVILEGES = 481
413 ERR_CHANOPRIVSNEEDED = 482
414 ERR_CANTKILLSERVER = 483
416 ERR_UNIQOPPRIVSNEEDED = 485
418 ERR_UMODEUNKNOWNFLAG = 501
419 ERR_USERSDONTMATCH = 502