-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])
+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 :: 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"]
+
+//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
+
+ 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'