Merge pull request #20 from clean-cloogle/gitlab-move
[cloogle-irc.git] / IRC.icl
1 implementation module IRC
2
3 import StdEnv
4
5 import Control.Applicative
6 import Control.Monad => qualified join
7 import Data.Either
8 import Data.Func
9 import Data.Maybe
10 import Text
11 import Text.GenPrint
12 import Text.Parsers.Simple.Chars
13 import Text.Parsers.Simple.Core
14
15 import GenIRC
16
17 derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
18
19 Start = (map (fmap toString) msgs, msgs)
20 where
21 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"
35 ]
36
37 parseIRCMessage :: String -> Either [Error] IRCMessage
38 parseIRCMessage s = case runParser parsePrefix (fromString s) of
39 // Prefix is parsed
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
45 Left e2 = Left [e2:e]
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"]
50
51 //Prefix
52 parsePrefix :: Parser Char (Maybe (Either IRCUser String))
53 parsePrefix
54 = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ')
55 where
56 parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c)
57 parseEither p q = Left <$> p <|> Right <$> q
58
59 parseUser :: Parser Char IRCUser
60 parseUser = parseNick
61 >>= \nick->optional (pToken '!' >>| parseUsr)
62 >>= \muser->optional (pToken '@' >>| parseHost)
63 >>= \mhost->pure {IRCUser
64 | irc_nick=nick, irc_user=muser, irc_host=mhost}
65
66 parseUsr :: Parser Char String
67 parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal])
68
69 parseNick :: Parser Char String
70 parseNick = pAlpha
71 >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "_-[]\\`^{}"))
72 >>= \cs->pure (toString [c:cs])
73
74 parseHost :: Parser Char String
75 parseHost = join "." <$> (pSepBy parseName (pToken '.'))
76 >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s)
77 where
78 parseName :: Parser Char String
79 parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/'])
80
81 //Parse Cmd
82 parseCmd :: [Char] -> Either Error IRCCommand
83 parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
84 where
85 argfun :: [String] -> [String]
86 argfun [] = []
87 argfun [x:xs]
88 # x = trim x
89 | x.[0] == ':' = [join " " $ [x % (1, size x):map rtrim xs]]
90 | otherwise = [x:argfun xs]
91
92 //Reply
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)
102 }
103 <* pToken '\r' <* pToken '\n'
104 where
105 spaceParser :: Parser Char [Char]
106 spaceParser = pMany $ pToken ' '
107
108 //Common parsers
109 pNoneOf :: [a] -> Parser a a | Eq a
110 pNoneOf l = pSatisfy (not o flip isMember l)
111
112 illegal :: [Char]
113 illegal = ['\x00','\r','\n']
114
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
128
129 (<+) infixr 5 :: a b -> String | toString a & toString b
130 (<+) a b = toString a +++ toString b
131
132 instance fromInt IRCReplies where
133 fromInt r = case r of
134 1 = RPL_WELCOME
135 2 = RPL_YOURHOST
136 3 = RPL_CREATED
137 4 = RPL_MYINFO
138 5 = RPL_BOUNCE
139 200 = RPL_TRACELINK
140 201 = RPL_TRACECONNECTING
141 202 = RPL_TRACEHANDSHAKE
142 203 = RPL_TRACEUNKNOWN
143 204 = RPL_TRACEOPERATOR
144 205 = RPL_TRACEUSER
145 206 = RPL_TRACESERVER
146 207 = RPL_TRACESERVICE
147 208 = RPL_TRACENEWTYPE
148 209 = RPL_TRACECLASS
149 210 = RPL_TRACERECONNECT
150 211 = RPL_STATSLINKINFO
151 212 = RPL_STATSCOMMANDS
152 219 = RPL_ENDOFSTATS
153 221 = RPL_UMODEIS
154 234 = RPL_SERVLIST
155 235 = RPL_SERVLISTEND
156 242 = RPL_STATSUPTIME
157 243 = RPL_STATSOLINE
158 251 = RPL_LUSERCLIENT
159 252 = RPL_LUSEROP
160 253 = RPL_LUSERUNKNOWN
161 254 = RPL_LUSERCHANNELS
162 255 = RPL_LUSERME
163 256 = RPL_ADMINME
164 257 = RPL_ADMINLOC1
165 258 = RPL_ADMINLOC2
166 259 = RPL_ADMINEMAIL
167 261 = RPL_TRACELOG
168 262 = RPL_TRACEEND
169 263 = RPL_TRYAGAIN
170 301 = RPL_AWAY
171 302 = RPL_USERHOST
172 303 = RPL_ISON
173 304 = RPL_UNAWAY
174 305 = RPL_NOWAWAY
175 311 = RPL_WHOISUSER
176 312 = RPL_WHOISSERVER
177 313 = RPL_WHOISOPERATOR
178 314 = RPL_WHOWASUSER
179 315 = RPL_ENDOFWHO
180 317 = RPL_WHOISIDLE
181 318 = RPL_ENDOFWHOIS
182 319 = RPL_WHOISCHANNELS
183 321 = RPL_LISTSTART
184 322 = RPL_LIST
185 323 = RPL_LISTEND
186 324 = RPL_CHANNELMODEIS
187 325 = RPL_UNIQOPIS
188 331 = RPL_NOTOPIC
189 332 = RPL_TOPIC
190 341 = RPL_INVITING
191 342 = RPL_SUMMONING
192 346 = RPL_INVITELIST
193 347 = RPL_ENDOFINVITELIST
194 348 = RPL_EXCEPTLIST
195 349 = RPL_ENDOFEXCEPTLIST
196 351 = RPL_VERSION
197 352 = RPL_WHOREPLY
198 353 = RPL_NAMREPLY
199 364 = RPL_LINKS
200 365 = RPL_ENDOFLINKS
201 366 = RPL_ENDOFNAMES
202 367 = RPL_BANLIST
203 368 = RPL_ENDOFBANLIST
204 369 = RPL_ENDOFWHOWAS
205 371 = RPL_INFO
206 372 = RPL_MOTD
207 374 = RPL_ENDOFINFO
208 375 = RPL_MOTDSTART
209 376 = RPL_ENDOFMOTD
210 381 = RPL_YOUREOPER
211 382 = RPL_REHASHING
212 383 = RPL_YOURESERVICE
213 391 = RPL_TIME
214 392 = RPL_USERSSTART
215 393 = RPL_USERS
216 394 = RPL_ENDOFUSERS
217 395 = RPL_NOUSERS
218 _ = RPL_UNKNOWN
219
220 instance toInt IRCReplies where
221 toInt r = case r of
222 RPL_WELCOME = 1
223 RPL_YOURHOST = 2
224 RPL_CREATED = 3
225 RPL_MYINFO = 4
226 RPL_BOUNCE = 5
227 RPL_TRACELINK = 200
228 RPL_TRACECONNECTING = 201
229 RPL_TRACEHANDSHAKE = 202
230 RPL_TRACEUNKNOWN = 203
231 RPL_TRACEOPERATOR = 204
232 RPL_TRACEUSER = 205
233 RPL_TRACESERVER = 206
234 RPL_TRACESERVICE = 207
235 RPL_TRACENEWTYPE = 208
236 RPL_TRACECLASS = 209
237 RPL_TRACERECONNECT = 210
238 RPL_STATSLINKINFO = 211
239 RPL_STATSCOMMANDS = 212
240 RPL_ENDOFSTATS = 219
241 RPL_UMODEIS = 221
242 RPL_SERVLIST = 234
243 RPL_SERVLISTEND = 234
244 RPL_STATSUPTIME = 242
245 RPL_STATSOLINE = 243
246 RPL_LUSERCLIENT = 251
247 RPL_LUSEROP = 252
248 RPL_LUSERUNKNOWN = 253
249 RPL_LUSERCHANNELS = 254
250 RPL_LUSERME = 255
251 RPL_ADMINME = 256
252 RPL_ADMINLOC1 = 257
253 RPL_ADMINLOC2 = 258
254 RPL_ADMINEMAIL = 259
255 RPL_TRACELOG = 261
256 RPL_TRACEEND = 262
257 RPL_TRYAGAIN = 263
258 RPL_AWAY = 301
259 RPL_USERHOST = 302
260 RPL_ISON = 303
261 RPL_UNAWAY = 304
262 RPL_NOWAWAY = 305
263 RPL_WHOISUSER = 311
264 RPL_WHOISSERVER = 312
265 RPL_WHOISOPERATOR = 313
266 RPL_WHOWASUSER = 314
267 RPL_ENDOFWHO = 315
268 RPL_WHOISIDLE = 317
269 RPL_ENDOFWHOIS = 318
270 RPL_WHOISCHANNELS = 319
271 RPL_LISTSTART = 321
272 RPL_LIST = 322
273 RPL_LISTEND = 323
274 RPL_CHANNELMODEIS = 324
275 RPL_UNIQOPIS = 325
276 RPL_NOTOPIC = 331
277 RPL_TOPIC = 332
278 RPL_INVITING = 341
279 RPL_SUMMONING = 342
280 RPL_INVITELIST = 346
281 RPL_ENDOFINVITELIST = 347
282 RPL_EXCEPTLIST = 348
283 RPL_ENDOFEXCEPTLIST = 349
284 RPL_VERSION = 351
285 RPL_WHOREPLY = 352
286 RPL_NAMREPLY = 353
287 RPL_LINKS = 364
288 RPL_ENDOFLINKS = 365
289 RPL_ENDOFNAMES = 366
290 RPL_BANLIST = 367
291 RPL_ENDOFBANLIST = 367
292 RPL_ENDOFWHOWAS = 369
293 RPL_INFO = 371
294 RPL_MOTD = 372
295 RPL_ENDOFINFO = 374
296 RPL_MOTDSTART = 375
297 RPL_ENDOFMOTD = 376
298 RPL_YOUREOPER = 381
299 RPL_REHASHING = 382
300 RPL_YOURESERVICE = 383
301 RPL_TIME = 391
302 RPL_USERSSTART = 392
303 RPL_USERS = 393
304 RPL_ENDOFUSERS = 394
305 RPL_NOUSERS = 395
306 RPL_UNKNOWN = 998
307
308 instance fromInt IRCErrors where
309 fromInt r = case r of
310 401 = ERR_NOSUCHNICK
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
318 409 = ERR_NOORIGIN
319 411 = ERR_NORECIPIENT
320 412 = ERR_NOTEXTTOSEND
321 413 = ERR_NOTOPLEVEL
322 414 = ERR_WILDTOPLEVEL
323 415 = ERR_BADMASK
324 421 = ERR_UNKNOWNCOMMAND
325 422 = ERR_NOMOTD
326 423 = ERR_NOADMININFO
327 424 = ERR_FILEERROR
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
336 444 = ERR_NOLOGIN
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
346 467 = ERR_KEYSET
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
358 484 = ERR_RESTRICTED
359 485 = ERR_UNIQOPPRIVSNEEDED
360 491 = ERR_NOOPERHOST
361 501 = ERR_UMODEUNKNOWNFLAG
362 502 = ERR_USERSDONTMATCH
363 _ = ERR_UNKNOWN
364
365 instance toInt IRCErrors where
366 toInt r = case r of
367 ERR_NOSUCHNICK = 401
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
375 ERR_NOORIGIN = 409
376 ERR_NORECIPIENT = 411
377 ERR_NOTEXTTOSEND = 412
378 ERR_NOTOPLEVEL = 413
379 ERR_WILDTOPLEVEL = 414
380 ERR_BADMASK = 415
381 ERR_UNKNOWNCOMMAND = 421
382 ERR_NOMOTD = 422
383 ERR_NOADMININFO = 423
384 ERR_FILEERROR = 424
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
393 ERR_NOLOGIN = 444
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
403 ERR_KEYSET = 467
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
415 ERR_RESTRICTED = 484
416 ERR_UNIQOPPRIVSNEEDED = 485
417 ERR_NOOPERHOST = 491
418 ERR_UMODEUNKNOWNFLAG = 501
419 ERR_USERSDONTMATCH = 502
420 ERR_UNKNOWN = 999