irc 0.2 → 0.2.1
raw patch · 4 files changed
+392/−3 lines, 4 files
Files
- Network/IRC.hs +1/−1
- Network/IRC/Parser.hs +106/−0
- Network/IRC/Types.hs +283/−0
- irc.cabal +2/−2
Network/IRC.hs view
@@ -20,7 +20,7 @@ -- -- Maintainer : trevor@geekgateway.com -- Stability : experimental--- Portability : non-portable (not tested)+-- Portability : non-portable (GADT's) -- -- library for parsing IRC messages --
+ Network/IRC/Parser.hs view
@@ -0,0 +1,106 @@+-- This file is part of irc.++-- irc is free software; you can redistribute it and/or modify+-- it under the terms of the GNU Lesser General Public License as published by+-- the Free Software Foundation; either version 3 of the License, or+-- (at your option) any later version.++-- irc is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU Lesser General Public License for more details.++-- You should have received a copy of the GNU Lesser General Public License+-- along with this program. If not, see <http://www.gnu.org/licenses/>.++-- | Parsec parsers and a general parsing interface for IRC messages+module Network.IRC.Parser (+ -- * Parsing and Formatting Functions+ parseMessage -- :: String -> Maybe Message++ -- * Parsec Combinators for Parsing IRC messages+ , prefix -- :: CharParser st Prefix+ , serverPrefix -- :: CharParser st Prefix+ , nicknamePrefix -- :: CharParser st Prefix+ , command -- :: CharParser st Command+ , parameter -- :: CharParser st Parameter+ , message -- :: CharParser st Message+ , crlf -- :: CharParser st ()+ , spaces -- :: CharParser st ()++ -- * Other Parser Combinators+ , maybeP -- :: GenParser tok st a -> GenParser tok st (Maybe a)+ , tokenize -- :: CharParser st a -> CharParser st a+ , takeUntil -- :: String -> CharParser st String+ ) where++import Control.Monad+import Data.Maybe+import Text.ParserCombinators.Parsec hiding (spaces)++import Network.IRC.Types++-- | Parse a String into a Message.+parseMessage :: String -- ^ Message string+ -> Maybe Message -- ^ Parsed message+parseMessage = (either (const Nothing) Just) . (parse message "")++-- | Take all tokens until one character from a given string is found+takeUntil :: String -> CharParser st String+takeUntil = many1 . noneOf++-- | Convert a parser into an optional one that returns a Maybe+maybeP :: GenParser tok st a -> GenParser tok st (Maybe a)+maybeP p = option Nothing (liftM Just p)++-- | Convert a parser that consumes all space after it+tokenize :: CharParser st a -> CharParser st a+tokenize p = p >>= \x -> spaces >> return x++-- | Consume only spaces tabs or the bell character+spaces :: CharParser st ()+spaces = skipMany1 (oneOf " \t\b")++-- | Parse a Prefix+prefix :: CharParser st Prefix+prefix = char ':' >> (try nicknamePrefix <|> serverPrefix)++-- | Parse a Server prefix+serverPrefix :: CharParser st Prefix+serverPrefix = takeUntil " " >>= return . Server++-- | Parse a NickName prefix+nicknamePrefix :: CharParser st Prefix+nicknamePrefix = do+ n <- takeUntil " .!@\r\n"+ p <- option False (char '.' >> return True)+ when p (fail "")+ u <- maybeP $ char '!' >> takeUntil " @\r\n"+ s <- maybeP $ char '@' >> takeUntil " \r\n"+ return $ NickName n u s++-- | Parse a command. Either a string of capital letters, or 3 digits.+command :: CharParser st Command+command = many1 upper+ <|> do x <- digit+ y <- digit+ z <- digit+ return [x,y,z]++-- | Parse a command parameter.+parameter :: CharParser st Parameter+parameter = (char ':' >> takeUntil "\r\n")+ <|> (takeUntil " \r\n")++-- | Parse a cr lf+crlf :: CharParser st ()+crlf = optional (char '\r') >> char '\n' >> return ()++-- | Parse a Message+message :: CharParser st Message+message = do+ p <- maybeP $ tokenize prefix+ c <- command+ ps <- many (spaces >> parameter)+ crlf >> eof+ return $ Message p c ps
+ Network/IRC/Types.hs view
@@ -0,0 +1,283 @@+-- This file is part of irc.++-- irc is free software; you can redistribute it and/or modify+-- it under the terms of the GNU Lesser General Public License as published by+-- the Free Software Foundation; either version 3 of the License, or+-- (at your option) any later version.++-- irc is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU Lesser General Public License for more details.++-- You should have received a copy of the GNU Lesser General Public License+-- along with this program. If not, see <http://www.gnu.org/licenses/>.++-- | Datatypes for representing IRC messages, as well as formatting them.+module Network.IRC.Types (+ -- * Type Synonyms+ Parameter+ , ServerName+ , UserName+ , RealName+ , Command++ -- * Properties+ , Prop(renderProp)+ , Mode(Add, Remove)+ , UserProp(..)+ , ChanProp(..)++ -- * IRC Datatypes+ , Prefix(Server, NickName)+ , Message(Message)++ -- * Formatting functions+ , render -- :: Message -> String+ , renderMode -- :: (Prop p) => Mode p -> String+ , translateReply -- :: String -> String+ ) where++import Data.Maybe++type Command = String+type Parameter = String+type ServerName = String+type UserName = String+type RealName = String++-- | IRC messages are parsed as:+-- [ ':' prefix space ] command { space param } crlf+data Message+ = -- | IRC Message+ Message (Maybe Prefix) Command [Parameter]+ deriving (Show)++-- | The optional beginning of an IRC messages+data Prefix+ = -- | Server Prefix+ Server ServerName+ | -- | Nickname Prefix+ NickName String (Maybe UserName) (Maybe ServerName)+ deriving (Show)++-- | IRC Modes+data Mode p where+ Add :: (Prop p) => [p] -> Mode p+ Remove :: (Prop p) => [p] -> Mode p++instance Show p => Show (Mode p) where+ show (Add ps) = "Add " ++ show ps+ show (Remove ps) = "Remove " ++ show ps++-- Render a mode string+renderMode :: (Prop p) => Mode p -> String+renderMode (Add ps) = "+" ++ (concat $ map renderProp ps)+renderMode (Remove ps) = "-" ++ (concat $ map renderProp ps)++-- | Property class+class Prop a where+ renderProp :: a -> String++-- | User properties+data UserProp+ = UserOp+ | Invisible+ | ServerNotices+ | Wallops+ deriving (Show,Eq)++instance Prop UserProp where+ renderProp p = fromMaybe "" (p `lookup` userPropTable)++userPropTable :: [(UserProp,String)]+userPropTable =+ [ (UserOp, "o")+ , (Invisible, "i")+ , (ServerNotices, "s")+ , (Wallops, "w")+ ]++-- | Channel properties+data ChanProp+ = ChanOp+ | Private+ | Secret+ | InviteOnly+ | TopicOpOnly+ | NoOutsideMessages+ | Moderated+ | UserLimit+ | BanMask+ | Speak+ | Password+ deriving (Show,Eq)++instance Prop ChanProp where+ renderProp p = fromMaybe "" (p `lookup` chanPropTable)++chanPropTable :: [(ChanProp,String)]+chanPropTable =+ [ (ChanOp, "o")+ , (Private, "p")+ , (Secret, "s")+ , (InviteOnly, "i")+ , (TopicOpOnly, "t")+ , (NoOutsideMessages, "n")+ , (Moderated, "m")+ , (UserLimit, "l")+ , (BanMask, "b")+ , (Speak, "v")+ , (Password, "k")+ ]++-- | Message rendering+render :: Message -- ^ IRC Message+ -> String -- ^ Rendered message+render (Message p c args) =+ (maybe "" (\p' -> formatPrefix p' ++ " ") p) ++ c ++ " "+ ++ formatArgs args+ +formatPrefix :: Prefix -> String+formatPrefix (Server n) = ":" ++ n+formatPrefix (NickName n u s) = ":" ++ n+ ++ maybe "" (\u' -> "!" ++ u') u+ ++ maybe "" (\s' -> "@" ++ s') s++-- Format a parameter string+formatArgs :: [Parameter] -> String+formatArgs = unwords . formatArgs' . filter ((>0) . length)++formatArgs' :: [Parameter] -> [String]+formatArgs' [] = []+formatArgs' l@(p:ps) | elem ' ' p = [":" ++ unwords l]+ | otherwise = p : formatArgs' ps++-- | Translate a reply into the text version of the reply.+-- If no text version is available, the argument is returned.+translateReply :: Command -- ^ Reply+ -> String -- ^ Text translation+translateReply r = fromMaybe r $ lookup r replyTable++-- One big lookup table of codes and errors+replyTable :: [(String,String)]+replyTable =+ [ ("401","ERR_NOSUCHNICK")+ , ("402","ERR_NOSUCHSERVER")+ , ("403","ERR_NOSUCHCHANNEL")+ , ("404","ERR_CANNOTSENDTOCHAN")+ , ("405","ERR_TOOMANYCHANNELS")+ , ("406","ERR_WASNOSUCHNICK")+ , ("407","ERR_TOOMANYTARGETS")+ , ("409","ERR_NOORIGIN")+ , ("411","ERR_NORECIPIENT")+ , ("412","ERR_NOTEXTTOSEND")+ , ("413","ERR_NOTOPLEVEL")+ , ("414","ERR_WILDTOPLEVEL")+ , ("421","ERR_UNKNOWNCOMMAND")+ , ("422","ERR_NOMOTD")+ , ("423","ERR_NOADMININFO")+ , ("424","ERR_FILEERROR")+ , ("431","ERR_NONICKNAMEGIVEN")+ , ("432","ERR_ERRONEUSNICKNAME")+ , ("433","ERR_NICKNAMEINUSE")+ , ("436","ERR_NICKCOLLISION")+ , ("441","ERR_USERNOTINCHANNEL")+ , ("442","ERR_NOTONCHANNEL")+ , ("443","ERR_USERONCHANNEL")+ , ("444","ERR_NOLOGIN")+ , ("445","ERR_SUMMONDISABLED")+ , ("446","ERR_USERSDISABLED")+ , ("451","ERR_NOTREGISTERED")+ , ("461","ERR_NEEDMOREPARAMS")+ , ("462","ERR_ALREADYREGISTRED")+ , ("463","ERR_NOPERMFORHOST")+ , ("464","ERR_PASSWDMISMATCH")+ , ("465","ERR_YOUREBANNEDCREEP")+ , ("467","ERR_KEYSET")+ , ("471","ERR_CHANNELISFULL")+ , ("472","ERR_UNKNOWNMODE")+ , ("473","ERR_INVITEONLYCHAN")+ , ("474","ERR_BANNEDFROMCHAN")+ , ("475","ERR_BADCHANNELKEY")+ , ("481","ERR_NOPRIVILEGES")+ , ("482","ERR_CHANOPRIVSNEEDED")+ , ("483","ERR_CANTKILLSERVER")+ , ("491","ERR_NOOPERHOST")+ , ("501","ERR_UMODEUNKNOWNFLAG")+ , ("502","ERR_USERSDONTMATCH")+ , ("300","RPL_NONE")+ , ("302","RPL_USERHOST")+ , ("303","RPL_ISON")+ , ("301","RPL_AWAY")+ , ("305","RPL_UNAWAY")+ , ("306","RPL_NOWAWAY")+ , ("311","RPL_WHOISUSER")+ , ("312","RPL_WHOISSERVER")+ , ("313","RPL_WHOISOPERATOR")+ , ("317","RPL_WHOISIDLE")+ , ("318","RPL_ENDOFWHOIS")+ , ("319","RPL_WHOISCHANNELS")+ , ("314","RPL_WHOWASUSER")+ , ("369","RPL_ENDOFWHOWAS")+ , ("321","RPL_LISTSTART")+ , ("322","RPL_LIST")+ , ("323","RPL_LISTEND")+ , ("324","RPL_CHANNELMODEIS")+ , ("331","RPL_NOTOPIC")+ , ("332","RPL_TOPIC")+ , ("341","RPL_INVITING")+ , ("342","RPL_SUMMONING")+ , ("351","RPL_VERSION")+ , ("352","RPL_WHOREPLY")+ , ("315","RPL_ENDOFWHO")+ , ("353","RPL_NAMREPLY")+ , ("366","RPL_ENDOFNAMES")+ , ("364","RPL_LINKS")+ , ("365","RPL_ENDOFLINKS")+ , ("367","RPL_BANLIST")+ , ("368","RPL_ENDOFBANLIST")+ , ("371","RPL_INFO")+ , ("374","RPL_ENDOFINFO")+ , ("375","RPL_MOTDSTART")+ , ("372","RPL_MOTD")+ , ("376","RPL_ENDOFMOTD")+ , ("381","RPL_YOUREOPER")+ , ("382","RPL_REHASHING")+ , ("391","RPL_TIME")+ , ("392","RPL_USERSSTART")+ , ("393","RPL_USERS")+ , ("394","RPL_ENDOFUSERS")+ , ("395","RPL_NOUSERS")+ , ("200","RPL_TRACELINK")+ , ("201","RPL_TRACECONNECTING")+ , ("202","RPL_TRACEHANDSHAKE")+ , ("203","RPL_TRACEUNKNOWN")+ , ("204","RPL_TRACEOPERATOR")+ , ("205","RPL_TRACEUSER")+ , ("206","RPL_TRACESERVER")+ , ("208","RPL_TRACENEWTYPE")+ , ("261","RPL_TRACELOG")+ , ("211","RPL_STATSLINKINFO")+ , ("212","RPL_STATSCOMMANDS")+ , ("213","RPL_STATSCLINE")+ , ("214","RPL_STATSNLINE")+ , ("215","RPL_STATSILINE")+ , ("216","RPL_STATSKLINE")+ , ("218","RPL_STATSYLINE")+ , ("219","RPL_ENDOFSTATS")+ , ("241","RPL_STATSLLINE")+ , ("242","RPL_STATSUPTIME")+ , ("243","RPL_STATSOLINE")+ , ("244","RPL_STATSHLINE")+ , ("221","RPL_UMODEIS")+ , ("251","RPL_LUSERCLIENT")+ , ("252","RPL_LUSEROP")+ , ("253","RPL_LUSERUNKNOWN")+ , ("254","RPL_LUSERCHANNELS")+ , ("255","RPL_LUSERME")+ , ("256","RPL_ADMINME")+ , ("257","RPL_ADMINLOC1")+ , ("258","RPL_ADMINLOC2")+ , ("259","RPL_ADMINEMAIL")+ ]
irc.cabal view
@@ -1,7 +1,7 @@ name: irc synopsis: A small library for parsing IRC messages. description: A set of combinators and types for parsing IRC messages.-version: 0.2+version: 0.2.1 category: Data license: LGPL license-file: COPYING@@ -9,5 +9,5 @@ maintainer: trevor@geekgateway.com extra-source-files: COPYING.LESSER build-depends: base, parsec >= 2.0-exposed-Modules: Network.IRC+exposed-Modules: Network.IRC, Network.IRC.Parser, Network.IRC.Types ghc-options: -Wall -fglasgow-exts