diff --git a/Network/IRC.hs b/Network/IRC.hs
--- a/Network/IRC.hs
+++ b/Network/IRC.hs
@@ -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
--
diff --git a/Network/IRC/Parser.hs b/Network/IRC/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Network/IRC/Parser.hs
@@ -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 .
+
+-- | 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
diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs
new file mode 100644
--- /dev/null
+++ b/Network/IRC/Types.hs
@@ -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 .
+
+-- | 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")
+ ]
diff --git a/irc.cabal b/irc.cabal
--- a/irc.cabal
+++ b/irc.cabal
@@ -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