diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Revision history for irc-core +## 2.2.0.0 -- 2016-09-15 + +* `ircIson` packs all the nicks into a single argument +* `Eq` and `Ord` instances for `ReplyCode` +* Use `Text` for nickname targets in Irc.Commands + ## 2.1.1.1 -- 2016-08-28 * Added parsing tests diff --git a/irc-core.cabal b/irc-core.cabal --- a/irc-core.cabal +++ b/irc-core.cabal @@ -1,5 +1,5 @@ name: irc-core -version: 2.1.1.1 +version: 2.2.0.0 synopsis: IRC core library for glirc description: IRC core library for glirc . @@ -53,5 +53,6 @@ build-depends: irc-core, base, text, - HUnit >= 1.3 && < 1.4 + hashable, + HUnit >= 1.3 && < 1.4 default-language: Haskell2010 diff --git a/src/Irc/Codes.hs b/src/Irc/Codes.hs --- a/src/Irc/Codes.hs +++ b/src/Irc/Codes.hs @@ -24,16 +24,23 @@ -- | Type of numeric reply codes newtype ReplyCode = ReplyCode Word + deriving (Eq, Ord) +-- | Shows number instance Show ReplyCode where showsPrec p (ReplyCode x) = showsPrec p x +-- | Reads only the number +instance Read ReplyCode where + readsPrec p str = [ (ReplyCode x, xs) | (x,xs) <- readsPrec p str ] + -- | Categories for reply codes data ReplyType = ClientServerReply -- ^ 0-99 Messages between client and server | CommandReply -- ^ 200-399 Responses to commands | ErrorReply -- ^ 200-399 Errors | UnknownReply -- ^ Uncategorized + deriving (Eq, Ord, Read, Show) pattern RPL_WELCOME = ReplyCode 001 pattern RPL_YOURHOST = ReplyCode 002 @@ -432,11 +439,15 @@ pattern ERR_TEXTTOOSHORT = ReplyCode 983 pattern ERR_NUMERIC_ERR = ReplyCode 999 +-- | Information describing the category and human decipherable name of a +-- reply. data ReplyCodeInfo = ReplyCodeInfo - { replyCodeType :: !ReplyType - , replyCodeText :: !Text + { replyCodeType :: !ReplyType -- ^ category + , replyCodeText :: !Text -- ^ human-decipherable name } + deriving (Eq, Ord, Show, Read) +-- | Compute information for a reply code replyCodeInfo :: ReplyCode -> ReplyCodeInfo replyCodeInfo (ReplyCode w) = case replyCodeInfoTable Vector.!? i of @@ -445,9 +456,12 @@ where i = fromIntegral w +-- | Categorize a reply code using the unknown category and simply showing +-- the reply code's number as its name. defaultReplyCodeInfo :: Int -> ReplyCodeInfo defaultReplyCodeInfo = ReplyCodeInfo UnknownReply . Text.pack . show +-- | Information about reply codes as derived from Freenode's ircd-seven. replyCodeInfoTable :: Vector ReplyCodeInfo replyCodeInfoTable = Vector.accumulate diff --git a/src/Irc/Commands.hs b/src/Irc/Commands.hs --- a/src/Irc/Commands.hs +++ b/src/Irc/Commands.hs @@ -55,17 +55,17 @@ -- | PRIVMSG command ircPrivmsg :: - Identifier {- ^ target -} -> - Text {- ^ message -} -> + Text {- ^ target -} -> + Text {- ^ message -} -> RawIrcMsg -ircPrivmsg who msg = rawIrcMsg "PRIVMSG" [idText who, msg] +ircPrivmsg who msg = rawIrcMsg "PRIVMSG" [who, msg] -- | NOTICE command ircNotice :: - Identifier {- ^ target -} -> - Text {- ^ message -} -> + Text {- ^ target -} -> + Text {- ^ message -} -> RawIrcMsg -ircNotice who msg = rawIrcMsg "NOTICE" [idText who, msg] +ircNotice who msg = rawIrcMsg "NOTICE" [who, msg] -- | MODE command ircMode :: @@ -94,9 +94,9 @@ -- | NICK command ircNick :: - Identifier {- ^ nickname -} -> + Text {- ^ nickname -} -> RawIrcMsg -ircNick nick = rawIrcMsg "NICK" [idText nick] +ircNick nick = rawIrcMsg "NICK" [nick] -- | PART command ircPart :: @@ -175,9 +175,9 @@ -- | ISON command ircIson :: - [Text] {- ^ parameters -} -> + [Text] {- ^ nicknames -} -> RawIrcMsg -ircIson = rawIrcMsg "ISON" +ircIson nicks = rawIrcMsg "ISON" [Text.unwords nicks] -- | TIME command ircTime :: diff --git a/test/Main.hs b/test/Main.hs --- a/test/Main.hs +++ b/test/Main.hs @@ -12,21 +12,26 @@ module Main (main) where import qualified Data.Text as Text +import Data.Hashable import Data.Semigroup import Irc.RawIrcMsg import Irc.UserInfo +import Irc.Identifier import System.Exit import Test.HUnit +import Text.Read main :: IO a main = - do counts <- runTestTT tests - if errors counts == 0 && failures counts == 0 + do outcome <- runTestTT tests + if errors outcome == 0 && failures outcome == 0 then exitSuccess else exitFailure tests :: Test -tests = test [ irc0, irc2, irc15, ircWithPrefix, ircWithTags, userInfos, renderIrc ] +tests = test [ irc0, irc2, irc15, ircWithPrefix, ircWithTags, + parseUserInfos, renderUserInfos, renderIrc, + badRawMsgs, userInfoFields, identifierInstances ] -- | Check that we can handle commands without parameters irc0 :: Test @@ -109,10 +114,45 @@ ] -userInfos :: Test -userInfos = test +renderUserInfos :: Test +renderUserInfos = test [ assertEqual "missing user and hostname" + "glguy" + (renderUserInfo (UserInfo "glguy" "" "")) + + , assertEqual "freenode cloak" + "glguy!~glguy@haskell/developer/glguy" + (renderUserInfo (UserInfo "glguy" "~glguy" "haskell/developer/glguy")) + + , assertEqual "missing user" + "glguy@haskell/developer/glguy" + (renderUserInfo (UserInfo "glguy" "" "haskell/developer/glguy")) + + , assertEqual "missing host" + "glguy!~glguy" + (renderUserInfo (UserInfo "glguy" "~glguy" "")) + + , assertEqual "extra @ goes into host" + "nick!user@server@name" + (renderUserInfo (UserInfo "nick" "user" "server@name")) + + , assertEqual "servername in nick" + "morgan.freenode.net" + (renderUserInfo (UserInfo "morgan.freenode.net" "" "")) + ] + +userInfoFields :: Test +userInfoFields = test + [ assertEqual "nickfield" "nick" (userNick (UserInfo "nick" "user" "host")) + , assertEqual "userfield" "user" (userName (UserInfo "nick" "user" "host")) + , assertEqual "hostfield" "host" (userHost (UserInfo "nick" "user" "host")) + ] + +parseUserInfos :: Test +parseUserInfos = test + + [ assertEqual "missing user and hostname" (UserInfo "glguy" "" "") (parseUserInfo "glguy") @@ -174,4 +214,39 @@ { _msgTags = [TagEntry "time" "", TagEntry "magic" ""] }) + ] + +badRawMsgs :: Test +badRawMsgs = test + [ assertEqual "bad prefix" + Nothing + (parseRawIrcMsg ": CMD") + , assertEqual "empty string" + Nothing + (parseRawIrcMsg "") + , assertEqual "whitespace" + Nothing + (parseRawIrcMsg " ") + , assertEqual "only prefix" + Nothing + (parseRawIrcMsg ":glguy!glguy@glguy") + , assertEqual "only tags" + Nothing + (parseRawIrcMsg "@glguy=tester") + ] + +identifierInstances :: Test +identifierInstances = test + [ assertEqual "read" (Just ("GLGUY"::Identifier)) (readMaybe "\"glguy\"") + , assertEqual "read2" (Just ("Glguy"::Identifier)) (readMaybe "\"glguy\"") + , assertEqual "show1" "\"GLguy\"" (show ("GLguy"::Identifier)) + , assertEqual "show2" "\"glguy\"" (show ("glguy"::Identifier)) + , assertBool "hash" $ hash ("glguy"::Identifier) == + hash ("GLGUY"::Identifier) + , assertBool "lt1" $ "glguy" < ("tester" :: Identifier) + , assertBool "gt1" $ "tester" > ("glguy" :: Identifier) + , assertBool "lt2" $ "GLGUY" < ("tester" :: Identifier) + , assertBool "gt2" $ "TESTER" > ("glguy" :: Identifier) + , assertBool "pre" $ idPrefix "gl" "GLGUY" + , assertBool "pre" $ not $ idPrefix "glguy" "gl" ]