import Text.Parsers.Simple.Chars
import Text.Parsers.Simple.Core
+import StdDebug
+
from Data.Functor import <$>
from Data.Func import $
-from StdMisc import undef
-from Text
- import class Text(trim,rtrim,split,indexOf,concat), instance Text String
+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
+derive gPrint IRCErrors, IRCReplies, Maybe, Either, IRCUser, IRCNumReply
Start = (map (fmap toString) msgs, msgs)
where
, 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 :: String -> Either [Error] IRCMessage
parseIRCMessage s = case runParser parsePrefix (fromString s) of
- ([(prefix, rest):_], _) = case parse parseReply rest of
- 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}
- (_, es) = Left ["couldn't parse prefix":es]
+ // 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"]
//Prefix
parsePrefix :: Parser Char (Maybe (Either IRCUser String))
parsePrefix
- = optional (pToken ':' >>| parseEither parseUser parseHost) <* pToken ' '
+ = 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
>>= \cs->pure (toString [c:cs])
parseHost :: Parser Char String
- parseHost = jon "." <$> pSepBy parseName (pToken '.')
+ 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 ['-'])
+ parseName = toString <$> pSome (pAlpha <|> pDigit <|> pOneOf ['-', '/'])
//Parse Cmd
parseCmd :: [Char] -> Either Error IRCCommand
| otherwise = [x:argfun xs]
//Reply
+
parseReply :: Parser Char IRCNumReply
-parseReply = (toString <$> pSome pDigit)
- >>= \rep->pMiddle
- >>= \recipient->spaceParser >>| (toString <$> pSome (pNoneOf illegal))
+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 rep
- , irc_recipient=recipient,irc_message=msg}
+ | irc_reply = fromInt $ toInt $ toString rep
+ , irc_recipient = rec
+ , irc_message = msg % (if (msg.[0] == ':') 1 0, size msg)
+ }
+ <* pToken '\r' <* pToken '\n'
where
- pMiddle :: Parser Char String
- pMiddle = fmap toString $ spaceParser >>| liftM2 (\x xs->[x:xs])
- (pSatisfy (not o ((==)':'))) (pMany $ pNoneOf [' ':illegal])
-
spaceParser :: Parser Char [Char]
spaceParser = pMany $ pToken ' '
illegal = ['\x00','\r','\n']
instance toString IRCNumReply where
- toString m = toInt m.irc_reply <+ " " <+
- m.irc_recipient <+ concat (gIRCPrint{|*|} m.irc_message)
+ 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
383 = RPL_YOURESERVICE; 391 = RPL_TIME;
392 = RPL_USERSSTART; 393 = RPL_USERS;
394 = RPL_ENDOFUSERS; 395 = RPL_NOUSERS;
- _ = undef
+ _ = abort $ "fromInt IRCReplies: " +++ toString r +++ " undef\n"
instance toInt IRCReplies where
toInt r = case r of