X-Git-Url: https://git.martlubbers.net/?p=cloogle-irc.git;a=blobdiff_plain;f=IRC.icl;h=5601e9a61e5e9cae0cafd20dd9476fa624c39902;hp=4f20623992cf315c92a9859ee089bc402719dffb;hb=f828f3a79cfcfb21c6c7a7773905cc210a739f75;hpb=d0094022a0169765678e500d2713db15433248bd diff --git a/IRC.icl b/IRC.icl index 4f20623..5601e9a 100644 --- a/IRC.icl +++ b/IRC.icl @@ -1,12 +1,159 @@ implementation module IRC +import StdList import GenPrint import StdOverloaded +import Data.Maybe +import Data.Either +import StdFunc +import StdString +import StdChar + +import Text.Parsers.Simple.Core +import Text.Parsers.Simple.Chars +import Control.Monad +import Control.Applicative +from Data.Functor import <$> + +from Data.Func import $ +from Text import class Text(concat), instance Text String +import qualified Text from StdMisc import undef -derive gPrint IRCCommands, IRCReplies, IRCErrors +jon :== 'Text'.join + +derive gPrint IRCCommands, IRCReplies, IRCErrors, (,), Maybe, (), Either + +:: IRCMessage = + { irc_prefix :: Maybe (Either String IRCUser) + , irc_command :: IRCCommands + } + +:: IRCUser = + { irc_nick :: String + , irc_user :: Maybe String + , irc_host :: Maybe String + } + +//Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 PRIVMSG #cloogle :!query ^_^\r\n" +Start = runParser parseMessage $ fromString ":frobnicator!~frobnicat@92.110.128.124 QUIT\r\n" + +(<+) infixr 5 :: a b -> String | toString a & toString b +(<+) a b = toString a +++ toString b + +parseIRCMessage :: (String -> Either [Error] IRCMessage) +parseIRCMessage = parse parseMessage o fromString + +parseMessage :: Parser Char IRCMessage +parseMessage = optional (parseEither parseHost parseUser) <* spaceParser + >>= \mprefix->parseCommand + <* pToken '\r' <* pToken '\n' + >>= \cmd->pure {IRCMessage | irc_prefix=mprefix, irc_command=cmd} + +pCommand :: String -> Parser Char [Char] +pCommand s = pList (map pToken $ fromString s) <* spaceParser + +parseCommand :: Parser Char IRCCommands +parseCommand = pFail//pCommand "QUIT" >>| QUIT <$> optional (pure "") + + +spaceParser :: Parser Char [Char] +spaceParser = pMany $ pToken ' ' + +parseServer :: Parser Char String +parseServer = pFail + +parseEither :: (Parser a b) (Parser a c) -> Parser a (Either b c) +parseEither p q = Left <$> p <|> Right <$> q + +parseUser :: Parser Char IRCUser +parseUser = pToken ':' >>| 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 (pSatisfy (not o flip isMember [' ', '\x00', '\x0d', '\x0a', '@'])) + +parseNick :: Parser Char String +parseNick = pAlpha >>= \c->pMany (pAlpha <|> pDigit <|> pSpecial) + >>= \cs->pure (toString [c:cs]) + +pSpecial :: Parser Char Char +pSpecial = pOneOf ['-', '[', ']', '\\', '\`', '^', '{', '}'] + +parseHost :: Parser Char String +parseHost = parseName + >>= \nm->pMany (pToken '.' >>| parseName) + >>= \nms->pure (concat [nm:nms]) + where + parseName :: Parser Char String + parseName = toString <$> pSome (pAlpha <|> pDigit <|> pToken '.') + +IRCCommandParser :: Parser Char IRCCommands +IRCCommandParser = pFail + +instance toString IRCMessage where + toString m = maybe "" (\s->either id ((<+) ":") s <+ " ") m.irc_prefix <+ m.irc_command + +instance toString IRCUser where + toString m = m.irc_nick <+ maybe "" ((<+) "!") m.irc_user + <+ maybe "" ((<+) "@") m.irc_host + +instance toString IRCCommands where + toString r = flip (+++) "\r\n" case r of + //ADMIN (Maybe String) + //AWAY String + //CONNECT String Int (Maybe String) + //DIE + //ERROR String + //INFO (Maybe String) + //INVITE String String + //ISON [String] + JOIN chs = "JOIN " +++ (if (isEmpty chs) "0" + (jon ", " [jon " " [ch:maybeToList mk]\\(ch, mk)<-chs])) + //KICK String String (Maybe String) + //KILL String String + //LINKS (Maybe (Maybe String, String)) + //LIST [String] + //LUSERS (Maybe (String, Maybe String)) + //MODE String + //MOTD (Maybe String) + //NAMES [String] + NICK n = jon " " ["NICK", n] + //NJOIN + //NOTICE String String + //OPER String String + //PART [String] + //PASS String + PING a mb = jon " " ["PING",a:maybeToList mb] + PONG a mb = jon " " ["PONG",a:maybeToList mb] + PRIVMSG dest msg = jon " " ["PRIVMSG", dest, ":"+++msg] + QUIT msg = jon " " ["QUIT":maybeToList msg] + //REHASH + //RESTART + //SERVER + //SERVICE String String String String + //SERVLIST (Maybe (String, Maybe String)) + //SQUERY String String + //SQUIRT + //SQUIT String String + //STATS (Maybe (String, Maybe String)) + //SUMMON String (Maybe (String, Maybe String)) + //TIME (Maybe String) + //TOPIC String (Maybe String) + //TRACE (Maybe String) + USER login mode rn = jon " " ["USER", login, toString mode, "*", ":"+++rn] + //USERHOST [String] + //USERS (Maybe String) + //VERSION (Maybe String) + //WALLOPS String + //WHO (Maybe String) + //WHOIS (Maybe String) [String] + //WHOWAS (Maybe String) [String] + _ = printToString r + -instance toString IRCCommands where toString r = printToString r instance toString IRCReplies where toString r = printToString r instance toString IRCErrors where toString r = printToString r @@ -33,7 +180,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 +228,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