diff --git a/Network/IRC.hs b/Network/IRC.hs --- a/Network/IRC.hs +++ b/Network/IRC.hs @@ -23,275 +23,14 @@ -- Portability : non-portable (not tested) -- -- library for parsing IRC messages +-- module Network.IRC ( - -- * Type Synonyms - Parameter - , ServerName - , UserName - , RealName - , Command - - -- * IRC Datatypes - , Prefix(Server, NickName) - , Message(Message) - - -- * Parsing and Formatting Functions - , parseMessage -- :: String -> Maybe Message - , formatMessage -- :: Message -> String - , translateReply -- :: String -> String - - -- * Parsec Combinators for Parsing IRC messages - , prefix -- :: CharParser st Prefix - , server -- :: CharParser st Prefix - , nickname -- :: CharParser st Prefix - , command -- :: CharParser st Command - , parameter -- :: CharParser st Parameter - , message -- :: CharParser st Message - , crlf -- :: CharParser st () - , spaces -- :: CharParser st () + -- * Parsers + module Network.IRC.Parser - -- * 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 + -- * Types + , module Network.IRC.Types ) where -import Control.Monad -import Data.Maybe -import Text.ParserCombinators.Parsec hiding (spaces) - -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) - --- | 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 nickname <|> server) - --- | Parse a Server prefix -server :: CharParser st Prefix -server = takeUntil " " >>= return . Server - --- | Parse a NickName prefix -nickname :: CharParser st Prefix -nickname = do - n <- takeUntil " .!@" - p <- option False (char '.' >> return True) - when p (fail "") - u <- maybeP $ char '!' >> takeUntil " @" - s <- maybeP $ char '@' >> takeUntil " " - 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 = string "\r\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 - --- | Message formatting -formatMessage :: Message -- ^ IRC Message - -> String -- ^ Formatted message -formatMessage m@(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 - -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 - -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") - ] - +import Network.IRC.Parser +import Network.IRC.Types diff --git a/irc.cabal b/irc.cabal --- a/irc.cabal +++ b/irc.cabal @@ -1,11 +1,13 @@ -Name: irc -Synopsis: A small library for parsing IRC messages -Version: 0.1 -Category: Data -License: LGPL -License-File: COPYING -Author: Trevor Elliott -Maintainer: trevor@geekgateway.com -Extra-source-files: COPYING.LESSER -Build-depends: base, mtl, parsec >= 2.0 -Exposed-Modules: Network.IRC +name: irc +synopsis: A small library for parsing IRC messages. +description: A set of combinators and types for parsing IRC messages. +version: 0.2 +category: Data +license: LGPL +license-file: COPYING +author: Trevor Elliott +maintainer: trevor@geekgateway.com +extra-source-files: COPYING.LESSER +build-depends: base, parsec >= 2.0 +exposed-Modules: Network.IRC +ghc-options: -Wall -fglasgow-exts