irc-core 2.1.0.0 → 2.1.1.0

raw patch · 9 files changed

+248/−17 lines, 9 filesdep +HUnitdep +irc-coredep −lensdep ~basedep ~textPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: HUnit, irc-core

Dependencies removed: lens

Dependency ranges changed: base, text

API changes (from Hackage documentation)

Files

• ChangeLog.md +7/−0
• irc-core.cabal +13/−3
• src/Irc/Identifier.hs +10/−1
• src/Irc/Message.hs +1/−1
• src/Irc/Modes.hs +22/−4
• src/Irc/RawIrcMsg.hs +18/−5
• src/Irc/UserInfo.hs +2/−3
• src/View.hs +15/−0
• test/Main.hs +160/−0

@@ -1,5 +1,12 @@ # Revision history for irc-core +## 2.1.1.0  -- 2016-08-13++* Add `Eq` instances to `UserInfo` and `RawIrcMsg`+* Add `IsString` instance to `Identifier`+* Remove `lens` dependency (functionality preserved)+* Show and Read instances for `Identifier` render the text version as a string literal+ ## 2.1.0.0  -- 2016-08-13  * Add BatchStart and BatchEnd messages

@@ -1,9 +1,9 @@ name:                irc-core-version:             2.1.0.0+version:             2.1.1.0 synopsis:            IRC core library for glirc description:         IRC core library for glirc                      .-                     The glirc client has been split off into https://hackage.haskell.org/package/glirc+                     The glirc client has been split off into <https://hackage.haskell.org/package/glirc> homepage:            https://github.com/glguy/irc-core license:             ISC license-file:        LICENSE@@ -31,12 +31,12 @@                        Irc.RateLimit                        Irc.RawIrcMsg                        Irc.UserInfo+  other-modules:       View    build-depends:       base       >=4.9  && <4.10,                        attoparsec >=0.13 && <0.14,                        bytestring >=0.10 && <0.11,                        hashable   >=1.2  && <1.3,-                       lens       >=4.14 && <4.15,                        memory     >=0.13 && <0.14,                        primitive  >=0.6  && <0.7,                        text       >=1.2  && <1.3,@@ -44,4 +44,14 @@                        vector     >=0.11 && <0.12    hs-source-dirs:      src+  default-language:    Haskell2010++test-suite test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  hs-source-dirs: test+  build-depends:       irc-core,+                       base,+                       text,+                       HUnit      >= 1.3 && < 1.4   default-language:    Haskell2010

@@ -25,6 +25,7 @@ import           Data.Function import           Data.Hashable import           Data.Primitive.ByteArray+import           Data.String import           Data.Text (Text) import qualified Data.Text.Encoding as Text import qualified Data.Vector.Primitive as PV@@ -33,12 +34,17 @@ -- | Identifier representing channels and nicknames data Identifier = Identifier {-# UNPACK #-} !Text                              {-# UNPACK #-} !(PV.Vector Word8)-  deriving (Read, Show)  -- | Equality on normalized identifier instance Eq Identifier where   (==) = (==) `on` idDenote +instance Show Identifier where+  show = show . idText++instance Read Identifier where+  readsPrec p x = [ (mkId t, rest) | (t,rest) <- readsPrec p x]+ -- | Comparison on normalized identifier instance Ord Identifier where   compare = compare `on` idDenote@@ -46,6 +52,9 @@ -- | Hash on normalized identifier instance Hashable Identifier where   hashWithSalt s = hashPV8WithSalt s . idDenote++instance IsString Identifier where+  fromString = mkId . fromString  hashPV8WithSalt :: Int -> PV.Vector Word8 -> Int hashPV8WithSalt salt (PV.Vector off len (ByteArray arr)) =

@@ -30,7 +30,6 @@   , computeMaxMessageLength   ) where -import           Control.Lens import           Control.Monad import           Data.Function import           Data.Maybe@@ -41,6 +40,7 @@ import           Irc.RawIrcMsg import           Irc.UserInfo import           Irc.Codes+import           View  -- | High-level IRC message representation data IrcMsg

@@ -1,4 +1,3 @@-{-# Language TemplateHaskell #-} {-# Language BangPatterns #-}  {-|@@ -29,9 +28,9 @@   , unsplitModes   ) where -import           Control.Lens import           Data.Text (Text) import qualified Data.Text as Text+import           View  -- | Settings that describe how to interpret channel modes data ModeTypes = ModeTypes@@ -43,8 +42,27 @@   }   deriving Show -makeLenses ''ModeTypes+-- | Lens for '_modesList'+modesLists :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes+modesLists f m = (\x -> m { _modesLists = x }) <$> f (_modesLists m) +-- | Lens for '_modesAlwaysArg'+modesAlwaysArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes+modesAlwaysArg f m = (\x -> m { _modesAlwaysArg = x }) <$> f (_modesAlwaysArg m)++-- | Lens for '_modesSetArg'+modesSetArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes+modesSetArg f m = (\x -> m { _modesSetArg = x }) <$> f (_modesSetArg m)++-- | Lens for '_modesNeverArg'+modesNeverArg :: Functor f => ([Char] -> f [Char]) -> ModeTypes -> f ModeTypes+modesNeverArg f m = (\x -> m { _modesNeverArg = x }) <$> f (_modesNeverArg m)+++-- | Lens for '_modesPrefixModes'+modesPrefixModes :: Functor f => ([(Char,Char)] -> f [(Char,Char)]) -> ModeTypes -> f ModeTypes+modesPrefixModes f m = (\x -> m { _modesPrefixModes = x }) <$> f (_modesPrefixModes m)+ -- | The channel modes used by Freenode defaultModeTypes :: ModeTypes defaultModeTypes = ModeTypes@@ -97,7 +115,7 @@                     case args of                       []   -> (Text.empty,[])                       x:xs -> (x,xs)-           in cons (polarity,m,arg) <$> computeMode polarity ms args'+           in ((polarity,m,arg):) <$> computeMode polarity ms args'          | not polarity && m `elem` view modesSetArg icm        ||                 m `elem` view modesNeverArg icm ->

@@ -1,6 +1,5 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE OverloadedStrings #-}-{-# Language TemplateHaskell #-}  {-| Module      : Irc.RawIrcMsg@@ -36,7 +35,6 @@   ) where  import           Control.Applicative-import           Control.Lens import           Data.Attoparsec.Text as P import           Data.ByteString (ByteString) import qualified Data.ByteString as B@@ -53,6 +51,7 @@ import qualified Data.Vector as Vector  import           Irc.UserInfo+import           View  -- | 'RawIrcMsg' breaks down the IRC protocol into its most basic parts. -- The "trailing" parameter indicated in the IRC protocol with a leading@@ -72,15 +71,29 @@   , _msgCommand    :: !Text -- ^ command   , _msgParams     :: [Text] -- ^ command parameters   }-  deriving (Read, Show)+  deriving (Eq, Read, Show)  -- | Key value pair representing an IRCv3.2 message tag. -- The value in this pair has had the message tag unescape -- algorithm applied. data TagEntry = TagEntry {-# UNPACK #-} !Text {-# UNPACK #-} !Text-  deriving (Read, Show)+  deriving (Eq, Read, Show) -makeLenses ''RawIrcMsg+-- | Lens for '_msgTags'+msgTags :: Functor f => ([TagEntry] -> f [TagEntry]) -> RawIrcMsg -> f RawIrcMsg+msgTags f m = (\x -> m { _msgTags = x }) <$> f (_msgTags m)++-- | Lens for '_msgPrefix'+msgPrefix :: Functor f => (Maybe UserInfo -> f (Maybe UserInfo)) -> RawIrcMsg -> f RawIrcMsg+msgPrefix f m = (\x -> m { _msgPrefix = x }) <$> f (_msgPrefix m)++-- | Lens for '_msgCommand'+msgCommand :: Functor f => (Text -> f Text) -> RawIrcMsg -> f RawIrcMsg+msgCommand f m = (\x -> m { _msgCommand = x }) <$> f (_msgCommand m)++-- | Lens for '_msgParams'+msgParams :: Functor f => ([Text] -> f [Text]) -> RawIrcMsg -> f RawIrcMsg+msgParams f m = (\x -> m { _msgParams = x }) <$> f (_msgParams m)  -- | Attempt to split an IRC protocol message without its trailing newline -- information into a structured message.

@@ -23,7 +23,6 @@ import qualified Data.Text      as Text import           Irc.Identifier import           Data.Monoid ((<>))-import           Control.Lens  -- | 'UserInfo' packages a nickname along with the username and hsotname -- if they are known in the current context.@@ -32,10 +31,10 @@   , userName :: {-# UNPACK #-} !Text -- ^ username, empty when missing   , userHost :: {-# UNPACK #-} !Text -- ^ hostname, empty when missing   }-  deriving (Read, Show)+  deriving (Eq, Read, Show)  -- | 'Lens' into 'userNick' field.-uiNick :: Lens' UserInfo Identifier+uiNick :: Functor f => (Identifier -> f Identifier) -> UserInfo -> f UserInfo uiNick f ui@UserInfo{userNick = n} = (\n' -> ui{userNick = n'}) <$> f n  -- | Render 'UserInfo' as @nick!username\@hostname@

@@ -0,0 +1,15 @@+{-|+Module      : View+Description : Local definition of view+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++-}+module View (view) where++import Data.Functor.Const++-- | Local definition of lens package's view.+view :: ((a -> Const a a) -> s -> Const a s) -> s -> a+view l x = getConst (l Const x)

@@ -0,0 +1,160 @@+{-# Language OverloadedStrings #-}+{-|+Module      : Main+Description : Tests for the irc-core library+Copyright   : (c) Eric Mertens, 2016+License     : ISC+Maintainer  : emertens@gmail.com++This module test IRC message parsing.++-}+module Main (main) where++import qualified Data.Text as Text+import           Data.Semigroup+import           Irc.RawIrcMsg+import           Irc.UserInfo+import           System.Exit+import           Test.HUnit++main :: IO a+main =+  do counts <- runTestTT tests+     if errors counts == 0 && failures counts == 0+       then exitSuccess+       else exitFailure++tests :: Test+tests = test [ irc0, irc2, irc15, ircWithPrefix, ircWithTags, userInfos, renderIrc ]++-- | Check that we can handle commands without parameters+irc0 :: Test+irc0 = test [ assertEqual "" goal (parseRawIrcMsg alt) | alt <- alternatives ]+  where+    goal = Just (rawIrcMsg "COMMAND" [])+    alternatives =+      [ "COMMAND"+      , "COMMAND "+      , "COMMAND  "+      ]++-- | Check that we can handle commands with two parameters and an assortment of spacing+irc2 :: Test+irc2 = test [ assertEqual "" goal (parseRawIrcMsg alt) | alt <- alternatives ]+  where+    goal = Just (rawIrcMsg "COMMAND" ["param1","param2"])+    alternatives =+      [ "COMMAND param1 param2"+      , "COMMAND   param1 param2"+      , "COMMAND   param1   param2"+      , "COMMAND param1   param2"+      , "COMMAND param1   param2   "+      , "COMMAND param1   :param2"+      , "COMMAND param1 :param2"+      ]++-- | Check that we max out at 15 parameters+irc15 :: Test+irc15 = test+  [ assertEqual "" goal (parseRawIrcMsg raw1)+  , assertEqual "" goal (parseRawIrcMsg raw2)+  ]+  where+    goal   = Just (rawIrcMsg "001" (params ++ ["last  two"]))+    params = map (Text.pack . show) [1 .. 14 :: Int]+    raw1 = "001 " <> Text.unwords params <> " last  two"+    raw2 = "001 " <> Text.unwords params <> "  :last  two"++ircWithPrefix :: Test+ircWithPrefix = test+  [ assertEqual ""+      (Just (rawIrcMsg "254" ["glguytest", "57555", "channels formed"])+            { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") })+      (parseRawIrcMsg ":morgan.freenode.net 254 glguytest 57555 :channels formed")+  ]++ircWithTags :: Test+ircWithTags = test+  [ assertEqual "without prefix"+      (Just (rawIrcMsg "CMD" [])+            { _msgTags = [TagEntry "time" "value"] })+      (parseRawIrcMsg "@time=value CMD")++  , assertEqual "with prefix"+      (Just (rawIrcMsg "CMD" [])+            { _msgTags = [TagEntry "time" "value"]+            , _msgPrefix = Just (UserInfo "prefix" "user" "host") })+      (parseRawIrcMsg "@time=value :prefix!user@host CMD")++  , assertEqual "two tags"+      (Just (rawIrcMsg "CMD" [])+            { _msgTags = [TagEntry "time" "value", TagEntry "this" "\n\rand\\ ;that"] })+      (parseRawIrcMsg "@time=value;this=\\n\\rand\\\\\\s\\:that CMD")++  , assertEqual "don't escape keys"+      (Just (rawIrcMsg "CMD" [])+            { _msgTags = [TagEntry "this\\s" "value"] })+      (parseRawIrcMsg "@this\\s=value CMD")++  ]++userInfos :: Test+userInfos = test++  [ assertEqual "missing user and hostname"+      (UserInfo "glguy" "" "")+      (parseUserInfo "glguy")++  , assertEqual "freenode cloak"+      (UserInfo "glguy" "~glguy" "haskell/developer/glguy")+      (parseUserInfo "glguy!~glguy@haskell/developer/glguy")++  , assertEqual "missing user"+      (UserInfo "glguy" "" "haskell/developer/glguy")+      (parseUserInfo "glguy@haskell/developer/glguy")++  , assertEqual "missing host"+      (UserInfo "glguy" "~glguy" "")+      (parseUserInfo "glguy!~glguy")++  , assertEqual "extra @ goes into host"+      (UserInfo "nick" "user" "server@name")+      (parseUserInfo "nick!user@server@name")++  , assertEqual "servername in nick"+      (UserInfo "morgan.freenode.net" "" "")+      (parseUserInfo "morgan.freenode.net")+  ]++renderIrc :: Test+renderIrc = test+  [ assertEqual ""+      ":morgan.freenode.net 254 glguytest 57555 :channels formed\r\n"+      (renderRawIrcMsg+          (rawIrcMsg "254" ["glguytest", "57555", "channels formed"])+          { _msgPrefix = Just (UserInfo "morgan.freenode.net" "" "") })++  , assertEqual ""+      "254 glguytest 57555 :channels formed\r\n"+      (renderRawIrcMsg+          (rawIrcMsg "254" ["glguytest", "57555", "channels formed"]))++  , assertEqual ""+      "CMD param:with:colon\r\n"+      (renderRawIrcMsg (rawIrcMsg "CMD" ["param:with:colon"]))++  , assertEqual ""+      "CMD ::param\r\n"+      (renderRawIrcMsg (rawIrcMsg "CMD" [":param"]))++  , assertEqual ""+      "CMD\r\n"+      (renderRawIrcMsg (rawIrcMsg "CMD" []))++  , assertEqual "two tags"+      "@time=value;this=\\n\\rand\\\\\\s\\:that CMD\r\n"+      (renderRawIrcMsg (rawIrcMsg "CMD" [])+            { _msgTags = [TagEntry "time" "value", TagEntry "this" "\n\rand\\ ;that"] })++  ]