irc 0.2.3 → 0.4

raw patch · 8 files changed

+490/−324 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Network/IRC.hs +8/−4
• Network/IRC/Base.hs +228/−0
• Network/IRC/Commands.hs +43/−0
• Network/IRC/Parser.hs +26/−24
• Network/IRC/Types.hs +0/−283
• irc.cabal +21/−13
• tests/Makefile +14/−0
• tests/Tests.hs +150/−0

@@ -20,7 +20,7 @@ -- -- Maintainer  : trevor@geekgateway.com -- Stability   : experimental--- Portability : non-portable (GADT's)+-- Portability : non-portable -- -- library for parsing IRC messages --@@ -28,9 +28,13 @@     -- * Parsers     module Network.IRC.Parser -    -- * Types-  , module Network.IRC.Types+    -- * Base+  , module Network.IRC.Base+  +    -- * Message API+  , module Network.IRC.Commands   ) where  import Network.IRC.Parser-import Network.IRC.Types+import Network.IRC.Base+import Network.IRC.Commands

@@ -0,0 +1,228 @@+-- 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.Base (+    -- * Type Synonyms+    Parameter+  , ServerName+  , UserName+  , RealName+  , Command++    -- * IRC Datatypes+  , Prefix(Server, NickName)+  , Message(Message)++    -- * Formatting functions+  , encode         -- :: Message -> String+  , showMessage, showPrefix, showParameters+  , translateReply -- :: String -> String+  , replyTable     -- :: [(String,String)]++    -- * Deprecated+  , render+  ) where++import Data.Maybe++-- ---------------------------------------------------------+-- Data Types++type Parameter  = String+type ServerName = String+type UserName   = String+type RealName   = String+type Command    = String+++-- | IRC messages are parsed as:+--   [ ':' prefix space ] command { space param } crlf+data Message+  = -- | IRC Message+    Message (Maybe Prefix) Command [Parameter]+    deriving (Show,Read,Eq)+++-- | The optional beginning of an IRC messages+data Prefix+  = -- | Server Prefix+    Server ServerName+  | -- | Nickname Prefix+    NickName String (Maybe UserName) (Maybe ServerName)+    deriving (Show,Read,Eq)+++-- ---------------------------------------------------------+-- Formatting+++-- | Encode a message to its string representation+encode :: Message -> String+encode m = showMessage m++-- | This is the deprecated version of encode+render :: Message -> String+render  = encode++showMessage :: Message -> String+showMessage (Message p c ps) = showMaybe p ++ c ++ showParameters ps+  where showMaybe = maybe "" ((++ " ") . (':':) . showPrefix)++showPrefix :: Prefix -> String+showPrefix (Server s)       = s+showPrefix (NickName n u h) = n ++ showMaybe '!' u ++ showMaybe '@' h+  where showMaybe c e = maybe "" (c:) e++showParameters :: [Parameter] -> String+showParameters [] = []+showParameters ps = " " ++ (unwords $ showp ps)+  where showp [] = []+        showp p@(x:xs) | ' ' `elem` x = [':' : unwords p]+                       | otherwise    = x : showp xs+++-- ---------------------------------------------------------+-- Message Translation++-- | Translate a reply into its text description.+--   If no text 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")+  ]

@@ -0,0 +1,43 @@+module Network.IRC.Commands (+    -- * Types+    Channel+  , Password++    -- * IRC Functions+  , nick+  , user+  , joinChan+  , part+  , quit+  , privmsg+  ) where++import Network.IRC.Base++type Channel    = String+type Password   = String++mkMessage           :: String -> [Parameter] -> Message+mkMessage cmd params = Message Nothing cmd params+++++nick  :: UserName -> Message+nick u = mkMessage "NICK" [u]++user        :: UserName -> ServerName -> ServerName -> RealName -> Message+user u h s r = mkMessage "USER" [u,h,s,r]++joinChan  :: Channel -> Message+joinChan c = mkMessage "JOIN" [c]++part  :: Channel -> Message+part c = mkMessage "PART" [c]++quit :: Maybe String -> Message+quit (Just m) = mkMessage "QUIT" [m]+quit Nothing  = mkMessage "QUIT" []++privmsg    :: String -> String -> Message+privmsg c m = mkMessage "PRIVMSG" [c,m]

@@ -16,42 +16,44 @@ -- | Parsec parsers and a general parsing interface for IRC messages module Network.IRC.Parser (     -- * Parsing and Formatting Functions-    parseMessage   -- :: String -> Maybe Message+    decode -- :: 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 ()+  , 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++    -- * Deprecated Functions+  , parseMessage   ) where +import Network.IRC.Base+ 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 "")+decode :: String        -- ^ Message string+       -> Maybe Message -- ^ Parsed message+decode = (either (const Nothing) Just) . (parse message "") +-- | The deprecated version of decode+parseMessage :: String -> Maybe Message+parseMessage  = decode+ -- | 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)+takeUntil s = anyChar `manyTill` (lookAhead (oneOf s))  -- | Convert a parser that consumes all space after it tokenize  :: CharParser st a -> CharParser st a@@ -75,13 +77,13 @@   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"+  u <- optionMaybe $ char '!' >> takeUntil " @\r\n"+  s <- optionMaybe $ 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+command  = (many1 upper)         <|> do x <- digit                y <- digit                z <- digit@@ -99,7 +101,7 @@ -- | Parse a Message message :: CharParser st Message message  = do-  p <- maybeP $ tokenize prefix+  p <- optionMaybe $ tokenize prefix   c <- command   ps <- many (spaces >> parameter)   crlf >> eof

@@ -1,283 +0,0 @@--- 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,Read,Eq)---- | The optional beginning of an IRC messages-data Prefix-  = -- | Server Prefix-    Server ServerName-  | -- | Nickname Prefix-    NickName String (Maybe UserName) (Maybe ServerName)-    deriving (Show,Read,Eq)---- | 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")-  ]

@@ -1,13 +1,21 @@-name:                   irc-synopsis:               A small library for parsing IRC messages.-description:            A set of combinators and types for parsing IRC messages.-version:                0.2.3-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, Network.IRC.Parser, Network.IRC.Types-ghc-options:            -Wall -fglasgow-exts+name:               irc+synopsis:           A small library for parsing IRC messages.+description:        A set of combinators and types for parsing IRC messages.+version:            0.4+category:           Data+license:            LGPL+license-file:       COPYING+author:             Trevor Elliott+maintainer:         trevor@geekgateway.com+extra-source-files: COPYING.LESSER,+                    tests/Makefile,+                    tests/Tests.hs+cabal-version:      >= 1.2.0++library+  ghc-options:     -Wall+  build-depends:   base, parsec >= 2.0+  exposed-Modules: Network.IRC,+                   Network.IRC.Base,+                   Network.IRC.Commands,+                   Network.IRC.Parser

@@ -0,0 +1,14 @@+ODIR   = .ghc+TARGET = Tests++all : $(ODIR)+	ghc --make -odir=$(ODIR) -hidir=$(ODIR) $(TARGET)+	./$(TARGET)++$(ODIR) :+	mkdir $(ODIR)++clean :+	$(RM) -r $(ODIR) $(TARGET)++.PHONY: all clean

@@ -0,0 +1,150 @@+module Main where++-- Friends+import Network.IRC++-- Libraries+import Control.Applicative+import Control.Monad+import System.Random+import Test.QuickCheck+import Test.HUnit+++instance Applicative Gen where+  (<*>) = ap+  pure  = return++-- ---------------------------------------------------------+-- Helpful Wrappers++-- An identifier starts with a letter, and consists of interspersed numbers+-- and special characters+newtype Identifier = Identifier { unIdentifier :: String }+  deriving (Read,Show,Eq)++instance Arbitrary Identifier where+  coarbitrary = undefined+  arbitrary   = do+      l  <- letter+      ls <- sized $ \n -> loop n+      return $ Identifier (l:ls)+    where loop n | n <= 0    = return []+                 | otherwise = do i  <- identifier+                                  is <- loop (n-1)+                                  return (i:is)++-- A hostname is a string that starts and ends with an identifier, and has+-- periods peppered in the middle.+newtype Host = Host { unHost :: String }++instance Arbitrary Host where+  coarbitrary = undefined+  arbitrary   = do+      l  <- identifier+      ls <- sized $ \n -> loop n+      js <- sized $ \n -> loop n+      e  <- identifier+      return $ Host (l:ls ++ ('.':js) ++ [e])+    where loop n | n <= 0    = return []+                 | otherwise = do i  <- host+                                  is <- loop (n-1)+                                  return (i:is)+++letter :: Gen Char+letter  = frequency+  [ (50, choose ('a','z'))+  , (50, choose ('A','Z'))+  ]++digit :: Gen Char+digit  = choose ('0','9')++special :: Gen Char+special  = elements ['_','-']++identifier :: Gen Char+identifier  = frequency+  [ (50, letter)+  , (30, digit)+  , (10, special)+  ]++host :: Gen Char+host  = frequency+  [ (90, identifier)+  , (20, return '.')+  ]++-- ---------------------------------------------------------+-- IRC Types++newtype Cmd = Cmd { unCmd :: String }+  deriving (Read,Show,Eq)++instance Arbitrary Cmd where+  arbitrary   =+      let c = (replyTable !!) <$> choose (0, length replyTable - 1)+       in Cmd . fst <$> c+  coarbitrary = undefined+++instance Arbitrary Prefix where+  arbitrary   = oneof+      [ do name <- unIdentifier <$> arbitrary+           user <- (liftM unIdentifier) <$> arbitrary+           host <- (liftM unIdentifier) <$> arbitrary+           return $ NickName name user host+      , do host <- unHost <$> arbitrary+           return $ Server host+      ]+  coarbitrary = undefined+++instance Arbitrary Message where+  arbitrary   =+      let params = map unIdentifier <$> sized vector+          cmd    = unCmd <$> arbitrary+       in Message <$> arbitrary <*> cmd <*> params+  coarbitrary = undefined+++-- ---------------------------------------------------------+-- Properties++prop_ircId    :: Message -> Bool+prop_ircId msg = (decode . (++ "\r\n") . encode $ msg) == Just msg+++-- ---------------------------------------------------------+-- Unit Tests++tests :: Test+tests  = TestList $ map TestCase+  -- Initial colon encoding tests+  [ encode (Message Nothing "PRIVMSG" ["#foo", ":bar bas"]) @?=+    "PRIVMSG #foo ::bar bas"+  , encode (Message Nothing "PRIVMSG" ["#foo", ":bar"]) @?=+    "PRIVMSG #foo :bar"++  -- Corrected case+  , decode ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n" @?=+    Just (Message (Just $ Server "talon.nl.eu.SwiftIRC.net")+            "332" ["foo","#bar",""])+  ]+++-- ---------------------------------------------------------+-- Test Running++header :: String -> IO ()+header s = putStrLn "" >> putStrLn s >> putStrLn (replicate 60 '*')++main :: IO Counts+main  = do+  header "Checking irc encode/decode identity"+  quickCheck prop_ircId++  header "Checking individual test cases"+  runTestTT tests