X-Git-Url: https://git.martlubbers.net/?p=cloogle-irc.git;a=blobdiff_plain;f=IRC.icl;h=f51bc8a2076b5b0fdb527290f644192e3264a912;hp=48542ff747ad29b787122f420f66d4faf7d13c56;hb=1547e1cacf063d05c1ae686e6a1047792e13ef60;hpb=7a2a0cc9ba44d6073ae1778b07738c8d425e9cb5

diff --git a/IRC.icl b/IRC.icl
index 48542ff..f51bc8a 100644
--- a/IRC.icl
+++ b/IRC.icl
@@ -14,16 +14,18 @@ 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
-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
@@ -37,23 +39,29 @@ 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
@@ -74,7 +82,8 @@ where
 		>>= \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 ['-'])
@@ -91,18 +100,19 @@ parseCmd cs = fst $ gIRCParse{|*|} $ argfun $ split " " $ toString cs
 		| 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 ' '
 
@@ -114,8 +124,8 @@ illegal :: [Char]
 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
@@ -174,7 +184,7 @@ instance fromInt IRCReplies where
 		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