irc 0.5.1.0 → 0.6.0.0
raw patch · 5 files changed
+174/−95 lines, 5 filesdep +attoparsecdep +bytestringdep −parsec
Dependencies added: attoparsec, bytestring
Dependencies removed: parsec
Files
- Network/IRC/Base.hs +36/−21
- Network/IRC/Commands.hs +14/−6
- Network/IRC/Parser.hs +97/−44
- irc.cabal +2/−2
- tests/Tests.hs +25/−22
Network/IRC/Base.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ -- | Datatypes for representing IRC messages, as well as formatting them. module Network.IRC.Base ( -- * Type Synonyms@@ -22,15 +24,19 @@ ) where import Data.Maybe+import Data.Char+import Data.Word+import Data.ByteString+import qualified Data.ByteString as BS -- --------------------------------------------------------- -- Data Types -type Parameter = String-type ServerName = String-type UserName = String-type RealName = String-type Command = String+type Parameter = ByteString+type ServerName = ByteString+type UserName = ByteString+type RealName = ByteString+type Command = ByteString -- | IRC messages are parsed as:@@ -47,7 +53,7 @@ = -- | Server Prefix Server ServerName | -- | Nickname Prefix- NickName String (Maybe UserName) (Maybe ServerName)+ NickName ByteString (Maybe UserName) (Maybe ServerName) deriving (Show,Read,Eq) @@ -56,26 +62,35 @@ -- | Encode a message to its string representation-encode :: Message -> String-encode m = showMessage m+encode :: Message -> ByteString+encode = showMessage -- | This is the deprecated version of encode-render :: Message -> String+render :: Message -> ByteString render = encode -showMessage :: Message -> String-showMessage (Message p c ps) = showMaybe p ++ c ++ showParameters ps- where showMaybe = maybe "" ((++ " ") . (':':) . showPrefix)+showMessage :: Message -> ByteString+showMessage (Message p c ps) = showMaybe p `BS.append` c `BS.append` showParameters ps+ where showMaybe Nothing = BS.empty+ showMaybe (Just prefix) = BS.concat [":", showPrefix prefix, " "] -showPrefix :: Prefix -> String+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) = n ++ showMaybe '!' u ++ showMaybe '@' h- where showMaybe c e = maybe "" (c:) e+showPrefix (NickName n u h) = BS.concat [n, showMaybe '!' u, showMaybe '@' h]+ where showMaybe c e = maybe "" (bsConsAscii c) e -showParameters :: [Parameter] -> String-showParameters [] = []-showParameters params = " " ++ (unwords $ showp params)- where showp [p] | ' ' `elem` p || null p || head p == ':' = [':' : p]+showParameters :: [Parameter] -> ByteString+showParameters [] = BS.empty+showParameters params = BS.intercalate " " (BS.empty : showp params)+ where showp [p] | asciiToWord8 ' ' `BS.elem` p+ || BS.null p+ || BS.head p == asciiToWord8 ':' = [bsConsAscii ':' p] | otherwise = [p] showp (p:ps) = p : showp ps showp [] = []@@ -86,12 +101,12 @@ -- | Translate a reply into its text description. -- If no text is available, the argument is returned. translateReply :: Command -- ^ Reply- -> String -- ^ Text translation+ -> ByteString -- ^ Text translation translateReply r = fromMaybe r $ lookup r replyTable -- One big lookup table of codes and errors-replyTable :: [(String,String)]+replyTable :: [(ByteString, ByteString)] replyTable = [ ("401","ERR_NOSUCHNICK") , ("402","ERR_NOSUCHSERVER")
Network/IRC/Commands.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Network.IRC.Commands ( -- * Types Channel@@ -11,15 +13,18 @@ , quit , privmsg , kick+ , pong ) where +import Data.ByteString+ import Network.IRC.Base -type Channel = String-type Password = String-type Reason = String+type Channel = ByteString+type Password = ByteString+type Reason = ByteString -mkMessage :: String -> [Parameter] -> Message+mkMessage :: ByteString -> [Parameter] -> Message mkMessage cmd params = Message Nothing cmd params @@ -41,9 +46,12 @@ part :: Channel -> Message part c = mkMessage "PART" [c] -quit :: Maybe String -> Message+quit :: Maybe ByteString -> Message quit (Just m) = mkMessage "QUIT" [m] quit Nothing = mkMessage "QUIT" [] -privmsg :: String -> String -> Message+privmsg :: ByteString -> ByteString -> Message privmsg c m = mkMessage "PRIVMSG" [c,m]++pong :: ServerName -> Message+pong s = mkMessage "PONG" [s]
Network/IRC/Parser.hs view
@@ -4,18 +4,14 @@ 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 ()-- -- * Other Parser Combinators- , tokenize -- :: CharParser st a -> CharParser st a- , takeUntil -- :: String -> CharParser st String+ , prefix -- :: Parser Prefix+ , serverPrefix -- :: Parser Prefix+ , nicknamePrefix -- :: Parser Prefix+ , command -- :: Parser Command+ , parameter -- :: Parser Parameter+ , message -- :: Parser Message+ , crlf -- :: Parser ()+ , spaces -- :: Parser () -- * Deprecated Functions , parseMessage@@ -23,72 +19,129 @@ import Network.IRC.Base +import Data.Char+import Data.Word+import Data.ByteString hiding (elem, map)+ import Control.Monad-import Text.ParserCombinators.Parsec hiding (spaces)+import Control.Applicative+import Data.Attoparsec.ByteString +-- | Casts a character (assumed to be ASCII) to its corresponding byte.+asciiToWord8 :: Char -> Word8+asciiToWord8 = fromIntegral . ord++wSpace :: Word8+wSpace = asciiToWord8 ' '++wTab :: Word8+wTab = asciiToWord8 '\t'++wBell :: Word8+wBell = asciiToWord8 '\b'++wDot :: Word8+wDot = asciiToWord8 '.'++wExcl :: Word8+wExcl = asciiToWord8 '!'++wAt :: Word8+wAt = asciiToWord8 '@'++wCR :: Word8+wCR = asciiToWord8 '\r'++wLF :: Word8+wLF = asciiToWord8 '\n'++wColon :: Word8+wColon = asciiToWord8 ':'+ -- | Parse a String into a Message.-decode :: String -- ^ Message string+decode :: ByteString -- ^ Message string -> Maybe Message -- ^ Parsed message-decode = (either (const Nothing) Just) . (parse message "")+decode str = case parseOnly message str of+ Left _ -> Nothing+ Right r -> Just r -- | The deprecated version of decode-parseMessage :: String -> Maybe Message+parseMessage :: ByteString -> Maybe Message parseMessage = decode --- | Take all tokens until one character from a given string is found-takeUntil :: String -> CharParser st String-takeUntil s = anyChar `manyTill` (lookAhead (oneOf s))- -- | Convert a parser that consumes all space after it-tokenize :: CharParser st a -> CharParser st a+tokenize :: Parser a -> Parser a tokenize p = p >>= \x -> spaces >> return x --- | Consume only spaces tabs or the bell character-spaces :: CharParser st ()-spaces = skipMany1 (oneOf " \t\b")+-- | Consume only spaces, tabs, or the bell character+spaces :: Parser ()+spaces = skip (\w -> w == wSpace ||+ w == wTab ||+ w == wBell) -- | Parse a Prefix-prefix :: CharParser st Prefix-prefix = char ':' >> (try nicknamePrefix <|> serverPrefix)+prefix :: Parser Prefix+prefix = word8 wColon >> (try nicknamePrefix <|> serverPrefix) -- | Parse a Server prefix-serverPrefix :: CharParser st Prefix-serverPrefix = takeUntil " " >>= return . Server+serverPrefix :: Parser Prefix+serverPrefix = Server <$> takeTill (== wSpace) +-- | 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.+optionMaybe :: Parser a -> Parser (Maybe a)+optionMaybe p = option Nothing (Just <$> p)+ -- | Parse a NickName prefix-nicknamePrefix :: CharParser st Prefix+nicknamePrefix :: Parser Prefix nicknamePrefix = do- n <- takeUntil " .!@\r\n"- p <- option False (char '.' >> return True)+ n <- takeTill (inClass " .!@\r\n")+ p <- option False (word8 wDot >> return True) when p (fail "")- u <- optionMaybe $ char '!' >> takeUntil " @\r\n"- s <- optionMaybe $ char '@' >> takeUntil " \r\n"+ 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 ++isWordAsciiUpper :: Word8 -> Bool+isWordAsciiUpper w = asciiToWord8 'A' <= w && w <= asciiToWord8 'Z'++digit :: Parser Word8+digit = satisfy (\w -> asciiToWord8 '0' <= w && w <= asciiToWord8 '9')+ -- | Parse a command. Either a string of capital letters, or 3 digits.-command :: CharParser st Command-command = (many1 upper)+command :: Parser Command+command = takeWhile1 isWordAsciiUpper <|> do x <- digit y <- digit z <- digit- return [x,y,z]+ return (pack [x,y,z]) -- | Parse a command parameter.-parameter :: CharParser st Parameter-parameter = (char ':' >> takeUntil "\r\n")- <|> (takeUntil " \r\n")+parameter :: Parser Parameter+parameter = (word8 wColon >> takeTill (\w -> w == wCR ||+ w == wLF))+ <|> (takeTill (\w -> w == wSpace ||+ w == wCR ||+ w == wLF)) -- | Parse a cr lf-crlf :: CharParser st ()-crlf = (char '\r' >> optional (char '\n'))- <|> (char '\n' >> return () )+crlf :: Parser ()+crlf = void (word8 wCR >> optional (word8 wLF))+ <|> void (word8 wLF) -- | Parse a Message-message :: CharParser st Message+message :: Parser Message message = do p <- optionMaybe $ tokenize prefix c <- command ps <- many (spaces >> parameter)- crlf >> eof+ _ <- optional crlf+ endOfInput return $ Message p c ps
irc.cabal view
@@ -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.5.1.0+version: 0.6.0.0 category: Data, Network license: BSD3 license-file: LICENSE@@ -18,7 +18,7 @@ library ghc-options: -Wall- build-depends: base == 4.*, parsec >= 2.1 && < 3.2+ build-depends: base == 4.*, attoparsec, bytestring exposed-Modules: Network.IRC, Network.IRC.Base, Network.IRC.Commands,
tests/Tests.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} module Main where -- Friends@@ -6,28 +7,25 @@ -- 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---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 }+newtype Identifier = Identifier { unIdentifier :: ByteString } deriving (Read,Show,Eq) instance Arbitrary Identifier where arbitrary = do l <- letter ls <- sized $ \n -> loop n- return $ Identifier (l:ls)+ return $ Identifier (pack (l:ls)) where loop n | n <= 0 = return [] | otherwise = do i <- identifier is <- loop (n-1)@@ -35,7 +33,7 @@ -- A hostname is a string that starts and ends with an identifier, and has -- periods peppered in the middle.-newtype Host = Host { unHost :: String }+newtype Host = Host { unHost :: ByteString } instance Arbitrary Host where arbitrary = do@@ -43,42 +41,45 @@ ls <- sized $ \n -> loop n js <- sized $ \n -> loop n e <- identifier- return $ Host (l:ls ++ ('.':js) ++ [e])+ 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) -letter :: Gen Char+w8 :: Char -> Word8+w8 = fromIntegral . ord++letter :: Gen Word8 letter = frequency- [ (50, choose ('a','z'))- , (50, choose ('A','Z'))+ [ (50, choose (w8 'a', w8 'z'))+ , (50, choose (w8 'A', w8 'Z')) ] -digit :: Gen Char-digit = choose ('0','9')+digit :: Gen Word8+digit = choose (w8 '0', w8 '9') -special :: Gen Char-special = elements ['_','-']+special :: Gen Word8+special = elements [w8 '_', w8 '-'] -identifier :: Gen Char+identifier :: Gen Word8 identifier = frequency [ (50, letter) , (30, digit) , (10, special) ] -host :: Gen Char+host :: Gen Word8 host = frequency [ (90, identifier)- , (20, return '.')+ , (20, return (w8 '.')) ] -- --------------------------------------------------------- -- IRC Types -newtype Cmd = Cmd { unCmd :: String }+newtype Cmd = Cmd { unCmd :: ByteString } deriving (Read,Show,Eq) instance Arbitrary Cmd where@@ -109,7 +110,9 @@ -- Properties prop_ircId :: Message -> Bool-prop_ircId msg = (decode . (++ "\r\n") . encode $ msg) == Just msg+prop_ircId msg = (decode . appendCRLF . encode $ msg)+ == Just msg+ where appendCRLF bs = append bs (pack [w8 '\r', w8 '\n']) -- ---------------------------------------------------------