irc-0.1: Network/IRC.hs
-- 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/>.
-- |
-- Module : Network.IRC
-- Copyright : (c) Trevor Elliott 2007
-- License : LGPL
--
-- Maintainer : trevor@geekgateway.com
-- Stability : experimental
-- 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 ()
-- * 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)
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")
]