X-Git-Url: https://git.martlubbers.net/?p=cloogle-irc.git;a=blobdiff_plain;f=IRC.icl;h=48a58008307f5bc304065f77b399b31f336efcf1;hp=4f20623992cf315c92a9859ee089bc402719dffb;hb=38119fcb7be8437bc535665f20af8b641ee67e64;hpb=d0094022a0169765678e500d2713db15433248bd diff --git a/IRC.icl b/IRC.icl index 4f20623..48a5800 100644 --- a/IRC.icl +++ b/IRC.icl @@ -1,15 +1,145 @@ implementation module IRC +import StdList, StdTuple, StdOverloaded, StdFunc, StdString, StdChar, StdBool +import _SystemArray + import GenPrint -import StdOverloaded -from StdMisc import undef +import GenIRC + +import Control.Applicative +import Control.Monad +import Data.Either +import Data.Maybe +import Data.Tuple +import Text.Parsers.Simple.Chars +import Text.Parsers.Simple.Core + +import StdDebug + +from Data.Functor import <$> +from Data.Func import $ +from StdMisc import undef, abort +from Text import class Text(lpad,trim,rtrim,split,indexOf,concat), + instance Text String +import qualified Text + +jon :== 'Text'.join + +derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply + +Start = (map (fmap toString) msgs, msgs) +where + msgs = + [ parseIRCMessage ":clooglebot!~cloogle@dhcp-077-249-221-037.chello.nl QUIT\r\n" + , parseIRCMessage ":clooglebot!~cloogle QUIT\r\n" + , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n" + , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY test\r\n" + , parseIRCMessage ":frobnicator!~frobnicat@92.110.128.124 AWAY :test with spaces\r\n" + , parseIRCMessage ":cherryh.freenode.net NOTICE * :*** Found your hostname\r\n" + , parseIRCMessage ":cherryh.freenode.net QUIT :hoi hoi\r\n" + , parseIRCMessage ":cherryh.freenode.net JOIN #cha,#ch-b #twilight\r\n" + , parseIRCMessage ":cherryh.freenode.net ISON a b c d e f :g h\r\n" + , parseIRCMessage ":wilhelm.freenode.net 001 clooglebot :Welcome to the freenode Internet Relay Chat Network clooglebot\r\n" + , parseIRCMessage "PING :orwell.freenode.net\r\n" + , parseIRCMessage ":ChanServ!ChanServ@services. MODE #cloogle +o frobnicator\r\n" + , parseIRCMessage ":qbot_v01!~qbot@ip-213-124-170-20.ip.prioritytelecom.net PRIVMSG ##chinees :[link] Cloogle - https://cloogle.org" + ] + +parseIRCMessage :: String -> Either [Error] IRCMessage +parseIRCMessage s = case runParser parsePrefix (fromString s) of + // Prefix is parsed + ([(prefix, rest):_], _) + //Try parsing a numeric reply + = case parse parseReply rest of + //Try a normal command + Left e = case parseCmd rest of + Left e2 = Left [e2:e] + Right cmd = Right {IRCMessage | irc_prefix=prefix, irc_command=Right cmd} + Right repl = Right {IRCMessage | irc_prefix=prefix, irc_command=Left repl} + // Error parsing prefix + (_, es) = Left ["Error parsing prefix"] -derive gPrint IRCCommands, IRCReplies, IRCErrors +//Prefix +parsePrefix :: Parser Char (Maybe (Either IRCUser String)) +parsePrefix + = optional (pToken ':' >>| parseEither parseUser parseHost <* pToken ' ') +where + parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c) + parseEither p q = Left <$> p <|> Right <$> q -instance toString IRCCommands where toString r = printToString r + parseUser :: Parser Char IRCUser + parseUser = parseNick + >>= \nick->optional (pToken '!' >>| parseUsr) + >>= \muser->optional (pToken '@' >>| parseHost) + >>= \mhost->pure {IRCUser + | irc_nick=nick, irc_user=muser, irc_host=mhost} + + parseUsr :: Parser Char String + parseUsr = toString <$> pSome (pNoneOf [' ', '@':illegal]) + + parseNick :: Parser Char String + parseNick = pAlpha + >>= \c ->pMany (pAlpha <|> pDigit <|> pOneOf (fromString "_-[]\\`^{}")) + >>= \cs->pure (toString [c:cs]) + + parseHost :: Parser Char String + parseHost = jon "." <$> (pSepBy parseName (pToken '.')) + >>= \s->optional (pToken '.') >>= pure o maybe s (\p->s+++toString s) + where + parseName :: Parser Char String + parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/']) + +//Parse Cmd +parseCmd :: [Char] -> Either Error IRCCommand +parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs + where + argfun :: [String] -> [String] + argfun [] = [] + argfun [x:xs] + # x = trim x + | x.[0] == ':' = [jon " " $ [x % (1, size x):map rtrim xs]] + | otherwise = [x:argfun xs] + +//Reply +parseReply :: Parser Char IRCNumReply +parseReply = spaceParser + >>| (pMany (pToken '0') >>| pSome pDigit <* spaceParser) + >>= \rep->(toString <$> pSome (pNoneOf [' ':illegal]) <* spaceParser) + >>= \rec->(toString <$> pSome (pNoneOf illegal)) + >>= \msg->pure {IRCNumReply + | irc_reply = fromInt $ toInt $ toString rep + , irc_recipient = rec + , irc_message = msg % (if (msg.[0] == ':') 1 0, size msg) + } + <* pToken '\r' <* pToken '\n' + where + spaceParser :: Parser Char [Char] + spaceParser = pMany $ pToken ' ' + +//Common parsers +pNoneOf :: [a] -> Parser a a | Eq a +pNoneOf l = pSatisfy (not o flip isMember l) + +illegal :: [Char] +illegal = ['\x00','\r','\n'] + +instance toString IRCNumReply where + toString m = lpad (toString $ toInt m.irc_reply) 3 '0' <+ " " <+ + m.irc_recipient <+ " " <+ concat (gIRCPrint{|*|} m.irc_message) +instance toString IRCMessage where + toString m = maybe "" (\s->either ((<+) ":") id s <+ " ") m.irc_prefix + <+ either toString toString m.irc_command +instance toString IRCUser where + toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user + <+ maybe "" ((<+) "@") m.irc_host +instance toString IRCCommand where + toString m = jon " " (gIRCPrint{|*|} m) +++ "\r\n" instance toString IRCReplies where toString r = printToString r instance toString IRCErrors where toString r = printToString r +(<+) infixr 5 :: a b -> String | toString a & toString b +(<+) a b = toString a +++ toString b + instance fromInt IRCReplies where fromInt r = case r of 1 = RPL_WELCOME @@ -33,7 +163,7 @@ instance fromInt IRCReplies where 219 = RPL_ENDOFSTATS 221 = RPL_UMODEIS 234 = RPL_SERVLIST - 234 = RPL_SERVLISTEND + 235 = RPL_SERVLISTEND 242 = RPL_STATSUPTIME 243 = RPL_STATSOLINE 251 = RPL_LUSERCLIENT @@ -81,7 +211,7 @@ instance fromInt IRCReplies where 365 = RPL_ENDOFLINKS 366 = RPL_ENDOFNAMES 367 = RPL_BANLIST - 367 = RPL_ENDOFBANLIST + 368 = RPL_ENDOFBANLIST 369 = RPL_ENDOFWHOWAS 371 = RPL_INFO 372 = RPL_MOTD @@ -96,7 +226,7 @@ instance fromInt IRCReplies where 393 = RPL_USERS 394 = RPL_ENDOFUSERS 395 = RPL_NOUSERS - _ = undef + _ = RPL_UNKNOWN instance toInt IRCReplies where toInt r = case r of @@ -184,6 +314,7 @@ instance toInt IRCReplies where RPL_USERS = 393 RPL_ENDOFUSERS = 394 RPL_NOUSERS = 395 + RPL_UNKNOWN = 998 instance fromInt IRCErrors where fromInt r = case r of @@ -240,6 +371,7 @@ instance fromInt IRCErrors where 491 = ERR_NOOPERHOST 501 = ERR_UMODEUNKNOWNFLAG 502 = ERR_USERSDONTMATCH + _ = ERR_UNKNOWN instance toInt IRCErrors where toInt r = case r of @@ -296,3 +428,4 @@ instance toInt IRCErrors where ERR_NOOPERHOST = 491 ERR_UMODEUNKNOWNFLAG = 501 ERR_USERSDONTMATCH = 502 + ERR_UNKNOWN = 999