irc 0.6.0.1 → 0.6.1.0
raw patch · 6 files changed
+229/−206 lines, 6 filesdep +HUnitdep +QuickCheckdep +ircPVP ok
version bump matches the API change (PVP)
Dependencies added: HUnit, QuickCheck, irc, test-framework, test-framework-hunit, test-framework-quickcheck2
API changes (from Hackage documentation)
Files
- Network/IRC/Base.hs +1/−8
- Network/IRC/Parser.hs +37/−32
- irc.cabal +12/−4
- tests/Main.hs +179/−0
- tests/Makefile +0/−14
- tests/Tests.hs +0/−148
Network/IRC/Base.hs view
@@ -23,7 +23,6 @@ import Data.Maybe import Data.Char-import Data.Word import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as B8@@ -78,9 +77,6 @@ bsConsAscii :: Char -> ByteString -> ByteString bsConsAscii c = BS.cons (fromIntegral . ord $ c) -asciiToWord8 :: Char -> Word8-asciiToWord8 = fromIntegral . ord- showPrefix :: Prefix -> ByteString showPrefix (Server s) = s showPrefix (NickName n u h) = BS.concat [n, showMaybe '!' u, showMaybe '@' h]@@ -89,10 +85,7 @@ showParameters :: [Parameter] -> ByteString showParameters [] = BS.empty showParameters params = BS.intercalate (B8.pack " ") (BS.empty : showp params)- where showp [p] | asciiToWord8 ' ' `BS.elem` p- || BS.null p- || BS.head p == asciiToWord8 ':' = [bsConsAscii ':' p]- | otherwise = [p]+ where showp [p] = [bsConsAscii ':' p] showp (p:ps) = p : showp ps showp [] = []
Network/IRC/Parser.hs view
@@ -21,9 +21,9 @@ import Data.Char import Data.Word-import Data.ByteString hiding (elem, map)+import Data.ByteString hiding (elem, map, empty) -import Control.Monad+import Control.Monad (void) import Control.Applicative import Data.Attoparsec.ByteString @@ -71,7 +71,7 @@ -- | Convert a parser that consumes all space after it tokenize :: Parser a -> Parser a-tokenize p = p >>= \x -> spaces >> return x+tokenize p = p <* spaces -- | Consume only spaces, tabs, or the bell character spaces :: Parser ()@@ -81,11 +81,13 @@ -- | Parse a Prefix prefix :: Parser Prefix-prefix = word8 wColon >> (try nicknamePrefix <|> serverPrefix)+prefix = word8 wColon *> (try nicknamePrefix <|> serverPrefix)+ <?> "prefix" -- | Parse a Server prefix serverPrefix :: Parser Prefix serverPrefix = Server <$> takeTill (== wSpace)+ <?> "serverPrefix" -- | optionMaybe p tries to apply parser p. If p fails without consuming input, -- | it return Nothing, otherwise it returns Just the value returned by p.@@ -96,17 +98,18 @@ nicknamePrefix :: Parser Prefix nicknamePrefix = do n <- takeTill (inClass " .!@\r\n")- p <- option False (word8 wDot >> return True)- when p (fail "")- u <- optionMaybe $ word8 wExcl >> takeTill (\w -> w == wSpace ||- w == wAt ||- w == wCR ||- w == wLF)- s <- optionMaybe $ word8 wAt >> takeTill (\w -> w == wSpace ||- w == wCR ||- w == wLF)- return $ NickName n u s-+ p <- peekWord8+ case p of+ Just c | c == wDot -> empty+ _ -> NickName n <$>+ optionMaybe (word8 wExcl *> takeTill (\w -> w == wSpace ||+ w == wAt ||+ w == wCR ||+ w == wLF))+ <*> optionMaybe (word8 wAt *> takeTill (\w -> w == wSpace ||+ w == wCR ||+ w == wLF))+ <?> "nicknamePrefix" isWordAsciiUpper :: Word8 -> Bool isWordAsciiUpper w = asciiToWord8 'A' <= w && w <= asciiToWord8 'Z'@@ -117,31 +120,33 @@ -- | Parse a command. Either a string of capital letters, or 3 digits. command :: Parser Command command = takeWhile1 isWordAsciiUpper- <|> do x <- digit- y <- digit- z <- digit- return (pack [x,y,z])+ <|> digitsToByteString <$>+ digit+ <*> digit+ <*> digit+ <?> "command"+ where digitsToByteString x y z = pack [x,y,z] -- | Parse a command parameter. parameter :: Parser Parameter-parameter = (word8 wColon >> takeTill (\w -> w == wCR ||+parameter = (word8 wColon *> takeTill (\w -> w == wCR || w == wLF))- <|> (takeTill (\w -> w == wSpace ||- w == wCR ||- w == wLF))+ <|> takeTill (\w -> w == wSpace ||+ w == wCR ||+ w == wLF)+ <?> "parameter" -- | Parse a cr lf crlf :: Parser ()-crlf = void (word8 wCR >> optional (word8 wLF))+crlf = void (word8 wCR *> optional (word8 wLF)) <|> void (word8 wLF) - -- | Parse a Message message :: Parser Message-message = do- p <- optionMaybe $ tokenize prefix- c <- command- ps <- many (spaces >> parameter)- _ <- optional crlf- endOfInput- return $ Message p c ps+message = Message <$>+ optionMaybe (tokenize prefix)+ <*> command+ <*> many (spaces *> parameter)+ <* optional crlf+ <* endOfInput+ <?> "message"
irc.cabal view
@@ -1,15 +1,13 @@ name: irc synopsis: A small library for parsing IRC messages. description: A set of combinators and types for parsing IRC messages.-version: 0.6.0.1+version: 0.6.1.0 category: Data, Network license: BSD3 license-file: LICENSE author: Trevor Elliott maintainer: trevor@geekgateway.com-extra-source-files: tests/Makefile,- tests/Tests.hs-cabal-version: >= 1.6.0+cabal-version: >= 1.10 build-type: Simple source-repository head@@ -18,8 +16,18 @@ library ghc-options: -Wall+ default-language: Haskell2010 build-depends: base == 4.*, attoparsec, bytestring exposed-Modules: Network.IRC, Network.IRC.Base, Network.IRC.Commands, Network.IRC.Parser++test-suite Main+ type: exitcode-stdio-1.0+ x-uses-tf: true+ build-depends: base == 4.*, HUnit >= 1.2 && < 2, QuickCheck >= 2.4, test-framework >= 0.4.1, test-framework-quickcheck2, test-framework-hunit, bytestring, irc+ ghc-options: -Wall+ hs-source-dirs: tests+ default-language: Haskell2010+ main-is: Main.hs
+ tests/Main.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE OverloadedStrings #-}+module Main+ (+ main+ ) where++import Network.IRC++import Data.ByteString (ByteString, append, pack)+import Data.Word (Word8)+import Data.Char (ord)++import Control.Applicative ((<$>), (<*>), liftA)++import Test.HUnit+import Test.QuickCheck++import Test.Framework as TF (defaultMain, testGroup, Test)+import Test.Framework.Providers.HUnit+import Test.Framework.Providers.QuickCheck2 (testProperty)++-- ---------------------------------------------------------+-- Helpful Wrappers++-- An identifier starts with a letter, and consists of interspersed numbers+-- and special characters+newtype Identifier = Identifier { unIdentifier :: ByteString }+ deriving (Read,Show,Eq)++instance Arbitrary Identifier where+ arbitrary = do+ l <- letter+ ls <- sized $ \n -> loop n+ return $ Identifier (pack (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 :: ByteString }++instance Arbitrary Host where+ arbitrary = do+ l <- identifier+ ls <- sized $ \n -> loop n+ js <- sized $ \n -> loop n+ e <- identifier+ return $ Host (pack (l:ls ++ (w8 '.':js) ++ [e]))+ where loop n | n <= 0 = return []+ | otherwise = do i <- host+ is <- loop (n-1)+ return (i:is)+++w8 :: Char -> Word8+w8 = fromIntegral . ord++letter :: Gen Word8+letter = frequency+ [ (50, choose (w8 'a', w8 'z'))+ , (50, choose (w8 'A', w8 'Z'))+ ]++digit :: Gen Word8+digit = choose (w8 '0', w8 '9')++special :: Gen Word8+special = elements [w8 '_', w8 '-']++identifier :: Gen Word8+identifier = frequency+ [ (50, letter)+ , (30, digit)+ , (10, special)+ ]++host :: Gen Word8+host = frequency+ [ (90, identifier)+ , (20, return (w8 '.'))+ ]++-- ---------------------------------------------------------+-- IRC Types++newtype Cmd = Cmd { unCmd :: ByteString }+ deriving (Read,Show,Eq)++instance Arbitrary Cmd where+ arbitrary =+ let c = (replyTable !!) <$> choose (0, length replyTable - 1)+ in Cmd . fst <$> c++instance Arbitrary Prefix where+ arbitrary = oneof+ [ NickName+ <$> fmap unIdentifier arbitrary+ <*> fmap (liftA unIdentifier) arbitrary+ <*> fmap (liftA unIdentifier) arbitrary+ , Server+ <$> fmap unHost arbitrary+ ]++instance Arbitrary Message where+ arbitrary =+ let params = map unIdentifier <$> sized vector+ cmd = unCmd <$> arbitrary+ in Message <$> arbitrary <*> cmd <*> params++-- ---------------------------------------------------------+-- Properties++prop_encodeDecode :: Message -> Bool+prop_encodeDecode msg = (decode . appendCRLF . encode $ msg)+ == Just msg+ where appendCRLF bs = append bs (pack [w8 '\r', w8 '\n'])++properties :: TF.Test+properties = testGroup "QuickCheck Network.IRC"+ [ testProperty "encodeDecode" prop_encodeDecode+ ]++-- ---------------------------------------------------------+-- Unit Tests++unitTests :: TF.Test+unitTests = testGroup "HUnit tests Network.IRC"+ [ -- Decoding tests+ testCase "PRIVMSG foo :bar baz"+ ( decode "PRIVMSG foo :bar baz"+ @=? Just (Message Nothing "PRIVMSG" ["foo", "bar baz"]))+ , testCase ":foo.bar NOTICE baz baz :baz baz"+ ( decode ":foo.bar NOTICE baz baz :baz baz"+ @=? Just (Message (Just (Server "foo.bar")) "NOTICE" ["baz", "baz", "baz baz"]))+ , testCase ":foo.bar 001 baz baz :baz baz"+ ( decode ":foo.bar 001 baz baz :baz baz"+ @=? Just (Message (Just (Server "foo.bar")) "001" ["baz", "baz", "baz baz"]))+ , testCase ":foo!bar@baz PRIVMSG #foo :bar baz"+ ( decode ":foo!bar@baz PRIVMSG #foo :bar baz"+ @=? Just (Message (Just (NickName "foo" (Just "bar") (Just "baz"))) "PRIVMSG" ["#foo", "bar baz"]))+ , testCase ":foo@baz PRIVMSG #foo :bar baz"+ ( decode ":foo@baz PRIVMSG #foo :bar baz"+ @=? Just (Message (Just (NickName "foo" Nothing (Just "baz"))) "PRIVMSG" ["#foo", "bar baz"]))+ , testCase ":foo!bar PRIVMSG #foo :bar baz"+ ( decode ":foo!bar PRIVMSG #foo :bar baz"+ @=? Just (Message (Just (NickName "foo" (Just "bar") Nothing)) "PRIVMSG" ["#foo", "bar baz"]))+ , testCase ":foo PRIVMSG #foo :bar baz"+ ( decode ":foo PRIVMSG #foo :bar baz"+ @=? Just (Message (Just (NickName "foo" Nothing Nothing)) "PRIVMSG" ["#foo", "bar baz"]))++ -- Decoding tests++ -- Initial colon encoding tests+ , testCase "Message Nothing \"PRIVMSG\" [\"#foo\", \":bar bas\"]"+ ( encode (Message Nothing "PRIVMSG" ["#foo", ":bar bas"])+ @?= "PRIVMSG #foo ::bar bas")+ , testCase "Message Nothing \"PRIVMSG\" [\"#foo\", \":bar\"]"+ ( encode (Message Nothing "PRIVMSG" ["#foo", ":bar"])+ @?= "PRIVMSG #foo ::bar")++ -- Corrected case+ , testCase ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n"+ ( decode ":talon.nl.eu.SwiftIRC.net 332 foo #bar :\n"+ @?= Just (Message (Just $ Server "talon.nl.eu.SwiftIRC.net") "332" ["foo","#bar",""]))+ ]++-- ---------------------------------------------------------+-- Test List++tests :: [TF.Test]+tests = [ properties+ , unitTests+ ]++main :: IO ()+main = defaultMain tests+
− tests/Makefile
@@ -1,14 +0,0 @@-ODIR = .ghc-TARGET = Tests--all : $(ODIR)- ghc --make -odir=$(ODIR) -hidir=$(ODIR) $(TARGET) -i../- ./$(TARGET)--$(ODIR) :- mkdir $(ODIR)--clean :- $(RM) -r $(ODIR) $(TARGET)--.PHONY: all clean
− tests/Tests.hs
@@ -1,148 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Main where---- Friends-import Network.IRC---- Libraries-import Control.Applicative-import Control.Monad-import Data.Char-import Data.Word-import Data.ByteString hiding (length, map, putStrLn, replicate)-import System.Random-import Test.QuickCheck-import Test.HUnit--- ------------------------------------------------------------ Helpful Wrappers---- An identifier starts with a letter, and consists of interspersed numbers--- and special characters-newtype Identifier = Identifier { unIdentifier :: ByteString }- deriving (Read,Show,Eq)--instance Arbitrary Identifier where- arbitrary = do- l <- letter- ls <- sized $ \n -> loop n- return $ Identifier (pack (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 :: ByteString }--instance Arbitrary Host where- arbitrary = do- l <- identifier- ls <- sized $ \n -> loop n- js <- sized $ \n -> loop n- e <- identifier- return $ Host (pack (l:ls ++ (w8 '.':js) ++ [e]))- where loop n | n <= 0 = return []- | otherwise = do i <- host- is <- loop (n-1)- return (i:is)---w8 :: Char -> Word8-w8 = fromIntegral . ord--letter :: Gen Word8-letter = frequency- [ (50, choose (w8 'a', w8 'z'))- , (50, choose (w8 'A', w8 'Z'))- ]--digit :: Gen Word8-digit = choose (w8 '0', w8 '9')--special :: Gen Word8-special = elements [w8 '_', w8 '-']--identifier :: Gen Word8-identifier = frequency- [ (50, letter)- , (30, digit)- , (10, special)- ]--host :: Gen Word8-host = frequency- [ (90, identifier)- , (20, return (w8 '.'))- ]---- ------------------------------------------------------------ IRC Types--newtype Cmd = Cmd { unCmd :: ByteString }- deriving (Read,Show,Eq)--instance Arbitrary Cmd where- arbitrary =- let c = (replyTable !!) <$> choose (0, length replyTable - 1)- in Cmd . fst <$> c---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- ]---instance Arbitrary Message where- arbitrary =- let params = map unIdentifier <$> sized vector- cmd = unCmd <$> arbitrary- in Message <$> arbitrary <*> cmd <*> params----- ------------------------------------------------------------ Properties--prop_ircId :: Message -> Bool-prop_ircId msg = (decode . appendCRLF . encode $ msg)- == Just msg- where appendCRLF bs = append bs (pack [w8 '\r', w8 '\n'])----- ------------------------------------------------------------ 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