irc-core 2.2.1 → 2.3.0

raw patch · 5 files changed

+192/−37 lines, 5 filesdep ~basedep ~timePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, time

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• irc-core.cabal +1/−1
• src/Irc/Codes.hs +1/−1
• src/Irc/Commands.hs +136/−21
• src/Irc/Identifier.hs +48/−14

@@ -1,5 +1,11 @@ # Revision history for irc-core +## 2.3.0 -- 2017-06-02++* Change type of `idDenote` to save a bit of memory+* Add more commands to `Irc.Commands`+* Fix comments+ ## 2.2.1 -- 2017-05-13  * Prettier reply code text

@@ -1,5 +1,5 @@ name:                irc-core-version:             2.2.1+version:             2.3.0 synopsis:            IRC core library for glirc description:         IRC core library for glirc                      .

@@ -38,7 +38,7 @@ data ReplyType   = ClientServerReply -- ^ 0-99 Messages between client and server   | CommandReply      -- ^ 200-399 Responses to commands-  | ErrorReply        -- ^ 200-399 Errors+  | ErrorReply        -- ^ 400-599 Errors   | UnknownReply      -- ^ Uncategorized   deriving (Eq, Ord, Read, Show) 

@@ -9,23 +9,35 @@ This module provides smart constructors for IRC commands. -} module Irc.Commands-  ( ircAway+  ( ircAdmin+  , ircAway   , ircCapEnd   , ircCapLs   , ircCapReq+  , ircCnotice+  , ircCprivmsg+  , ircInfo   , ircInvite   , ircIson   , ircJoin   , ircKick+  , ircKill+  , ircKnock   , ircLinks+  , ircList+  , ircLusers+  , ircMap   , ircMode+  , ircMotd   , ircNick   , ircNotice+  , ircOper   , ircPart   , ircPass   , ircPing   , ircPong   , ircPrivmsg+  , ircRules   , ircQuit   , ircRemove   , ircStats@@ -36,6 +48,7 @@   , ircWho   , ircWhois   , ircWhowas+  , ircVersion    -- * ZNC support   , ircZnc@@ -53,6 +66,9 @@ import qualified Data.Text.Encoding as Text import qualified Data.ByteString.Base64 as Enc +nonempty :: Text -> [Text]+nonempty txt = filter (not . Text.null) [txt]+ -- | PRIVMSG command ircPrivmsg ::   Text {- ^ target  -} ->@@ -60,6 +76,35 @@   RawIrcMsg ircPrivmsg who msg = rawIrcMsg "PRIVMSG" [who, msg] +-- | CPRIVMSG command+--+-- > CPRIVMSG <nickname> <channel> :<message>+ircCprivmsg ::+  Text {- ^ nickname -} ->+  Text {- ^ channel  -} ->+  Text {- ^ message  -} ->+  RawIrcMsg+ircCprivmsg nick chan msg = rawIrcMsg "CPRIVMSG" [nick, chan, msg]++-- | CNOTICE command+--+-- > CNOTICE <nickname> <channel> :<message>+ircCnotice ::+  Text {- ^ nickname -} ->+  Text {- ^ channel  -} ->+  Text {- ^ message  -} ->+  RawIrcMsg+ircCnotice nick chan msg = rawIrcMsg "CNOTICE" [nick, chan, msg]++-- | KNOCK command+--+-- > KNOCK <channel> [<message>]+ircKnock ::+  Text {- ^ channel  -} ->+  Text {- ^ message  -} ->+  RawIrcMsg+ircKnock chan msg = rawIrcMsg "KNOCK" (chan : nonempty msg)+ -- | NOTICE command ircNotice ::   Text {- ^ target  -} ->@@ -92,6 +137,12 @@   RawIrcMsg ircWhowas = rawIrcMsg "WHOWAS" +-- | WALLOPS command+ircWallops ::+  Text {- ^ message -} ->+  RawIrcMsg+ircWallops msg = rawIrcMsg "WALLOPS" [msg]+ -- | NICK command ircNick ::   Text {- ^ nickname -} ->@@ -103,9 +154,7 @@   Identifier {- ^ channel -} ->   Text       {- ^ message -} ->   RawIrcMsg-ircPart chan msg-  | Text.null msg = rawIrcMsg "PART" [idText chan]-  | otherwise     = rawIrcMsg "PART" [idText chan, msg]+ircPart chan msg = rawIrcMsg "PART" (idText chan : nonempty msg)  -- | JOIN command ircJoin ::@@ -127,9 +176,7 @@   Identifier {- ^ channel -} ->   Text       {- ^ topic   -} ->   RawIrcMsg-ircTopic chan msg-  | Text.null msg = rawIrcMsg "TOPIC" [idText chan]-  | otherwise     = rawIrcMsg "TOPIC" [idText chan, msg]+ircTopic chan msg = rawIrcMsg "TOPIC" (idText chan : nonempty msg)  -- | KICK command ircKick ::@@ -137,30 +184,37 @@   Text       {- ^ nickname -} ->   Text       {- ^ message  -} ->   RawIrcMsg-ircKick chan who msg-  | Text.null msg = rawIrcMsg "KICK" [idText chan, who]-  | otherwise     = rawIrcMsg "KICK" [idText chan, who, msg]+ircKick chan who msg = rawIrcMsg "KICK" (idText chan : who : nonempty msg) +-- | KILL command+ircKill ::+  Text {- ^ client  -} ->+  Text {- ^ message -} ->+  RawIrcMsg+ircKill who msg = rawIrcMsg "KILL" (who : nonempty msg)+ -- | REMOVE command ircRemove ::   Identifier {- ^ channel  -} ->   Text       {- ^ nickname -} ->   Text       {- ^ message  -} ->   RawIrcMsg-ircRemove chan who msg-  | Text.null msg = rawIrcMsg "REMOVE" [idText chan, who]-  | otherwise     = rawIrcMsg "REMOVE" [idText chan, who, msg]+ircRemove chan who msg = rawIrcMsg "REMOVE" (idText chan : who : nonempty msg)  -- | QUIT command ircQuit :: Text {- ^ quit message -} -> RawIrcMsg-ircQuit msg-  | Text.null msg = rawIrcMsg "QUIT" []-  | otherwise     = rawIrcMsg "QUIT" [msg]+ircQuit = rawIrcMsg "QUIT" . nonempty  -- | PASS command ircPass :: Text {- ^ password -} -> RawIrcMsg ircPass pass = rawIrcMsg "PASS" [pass] +-- | LIST command+ircList ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircList = rawIrcMsg "LIST"+ -- | PING command ircPing ::   [Text] {- ^ parameters -} ->@@ -181,9 +235,9 @@  -- | TIME command ircTime ::-  [Text] {- ^ parameters -} ->+  Text {- ^ servername -} ->   RawIrcMsg-ircTime = rawIrcMsg "TIME"+ircTime = rawIrcMsg "TIME" . nonempty  -- | USERHOST command ircUserhost ::@@ -191,12 +245,31 @@   RawIrcMsg ircUserhost = rawIrcMsg "USERHOST" +-- | USERIP command+ircUserip ::+  [Text] {- ^ parameters -} ->+  RawIrcMsg+ircUserip = rawIrcMsg "USERIP"++-- | USERS command+ircUsers ::+  Text {- ^ server -} ->+  RawIrcMsg+ircUsers = rawIrcMsg "USERS" . nonempty+ -- | STATS command ircStats ::   [Text] {- ^ parameters -} ->   RawIrcMsg ircStats = rawIrcMsg "STATS" +-- | OPER command+ircOper ::+  Text {- ^ username -} ->+  Text {- ^ password -} ->+  RawIrcMsg+ircOper u p = rawIrcMsg "OPER" [u,p]+ -- | LINKS command ircLinks ::   [Text] {- ^ parameters -} ->@@ -207,9 +280,51 @@ ircAway ::   Text {- ^ message -} ->   RawIrcMsg-ircAway msg-  | Text.null msg = rawIrcMsg "AWAY" []-  | otherwise     = rawIrcMsg "AWAY" [msg]+ircAway = rawIrcMsg "AWAY" . nonempty++-- | MAP command+ircMap :: RawIrcMsg+ircMap = rawIrcMsg "MAP" []++-- | INFO command+ircInfo :: RawIrcMsg+ircInfo = rawIrcMsg "INFO" []++-- | RULES command+ircRules ::+  Text {- ^ servername -} ->+  RawIrcMsg+ircRules = rawIrcMsg "RULES" . nonempty++-- | VERSION command+ircVersion ::+  Text {- ^ server -} ->+  RawIrcMsg+ircVersion = rawIrcMsg "VERSION" . nonempty++-- | LUSERS command+--+-- > LUSERS [<mask> [<server>]]+ircLusers ::+  [Text] {- ^ params -} ->+  RawIrcMsg+ircLusers = rawIrcMsg "LUSERS"++-- | MOTD command+--+-- > MOTD [<server>]+ircMotd ::+  Text {- ^ server -} ->+  RawIrcMsg+ircMotd = rawIrcMsg "MOTD" . nonempty++-- | ADMIN command+--+-- > ADMIN [<target>]+ircAdmin ::+  Text {- ^ target -} ->+  RawIrcMsg+ircAdmin = rawIrcMsg "ADMIN" . nonempty  -- | USER command ircUser ::

@@ -16,50 +16,69 @@   , idDenote   , mkId   , idText+  , idTextNorm   , idPrefix   ) where +import           Control.Monad.ST import           Data.ByteString (ByteString) import qualified Data.ByteString as B import           Data.Char+import           Data.Foldable import           Data.Function import           Data.Hashable+import           Data.Monoid import           Data.Primitive.ByteArray import           Data.String import           Data.Text (Text)+import qualified Data.Text as Text import qualified Data.Text.Encoding as Text import qualified Data.Vector.Primitive as PV+import qualified Data.Primitive.ByteArray as BA+import           Data.Primitive.ByteArray (ByteArray) import           Data.Word  -- | Identifier representing channels and nicknames data Identifier = Identifier {-# UNPACK #-} !Text-                             {-# UNPACK #-} !(PV.Vector Word8)+                             {-# UNPACK #-} !ByteArray +-- | This indexing function exists to specialize the type+-- of 'BA.indexByteArray'.+indexWord8 :: ByteArray -> Int -> Word8+indexWord8 = BA.indexByteArray+ -- | Equality on normalized identifier instance Eq Identifier where-  (==) = (==) `on` idDenote+  Identifier _ x == Identifier _ y =+    BA.sizeofByteArray x == BA.sizeofByteArray y &&+    all (\i -> indexWord8 x i == indexWord8 y i)+        [0 .. BA.sizeofByteArray x - 1] +-- | Show as string literal instance Show Identifier where   show = show . idText +-- | Read as string literal 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+  compare (Identifier _ x) (Identifier _ y) =+    mconcat [ indexWord8 x i `compare` indexWord8 y i | i <- [0..n-1]]+      <> (BA.sizeofByteArray x `compare` BA.sizeofByteArray y)+    where+      n = min (BA.sizeofByteArray x) (BA.sizeofByteArray y)  -- | Hash on normalized identifier instance Hashable Identifier where-  hashWithSalt s = hashPV8WithSalt s . idDenote+  hashWithSalt salt (Identifier _ b@(ByteArray arr)) =+    hashByteArrayWithSalt arr 0 (BA.sizeofByteArray b) salt +-- | @'fromString' = 'mkId' . 'fromString' instance IsString Identifier where   fromString = mkId . fromString -hashPV8WithSalt :: Int -> PV.Vector Word8 -> Int-hashPV8WithSalt salt (PV.Vector off len (ByteArray arr)) =-  hashByteArrayWithSalt arr off len salt- -- | Construct an 'Identifier' from a 'ByteString' mkId :: Text -> Identifier mkId x = Identifier x (ircFoldCase (Text.encodeUtf8 x))@@ -68,19 +87,34 @@ idText :: Identifier -> Text idText (Identifier x _) = x --- | Returns the case-normalized 'ByteString' of an 'Identifier'--- which is suitable for comparison or hashing.-idDenote :: Identifier -> PV.Vector Word8+-- | Returns a 'ByteArray' of an 'Identifier'+-- which is suitable for comparison or hashing+-- which has been normalized for case.+idDenote :: Identifier -> ByteArray idDenote (Identifier _ x) = x +-- | Returns the case-normalized 'Text' for an identifier.+idTextNorm :: Identifier -> Text+idTextNorm (Identifier _ x) =+  Text.decodeUtf8+    (B.pack [ indexWord8 x i | i <- [0 .. BA.sizeofByteArray x - 1]])+ -- | Returns 'True' when the first argument is a prefix of the second. idPrefix :: Identifier -> Identifier -> Bool-idPrefix (Identifier _ x) (Identifier _ y) = x == PV.take (PV.length x) y+idPrefix (Identifier _ x) (Identifier _ y) =+  BA.sizeofByteArray x <= BA.sizeofByteArray y &&+  all (\i -> indexWord8 x i == indexWord8 y i)+      [0 .. BA.sizeofByteArray x - 1]  -- | Capitalize a string according to RFC 2812 -- Latin letters are capitalized and {|}~ are mapped to [\]^-ircFoldCase :: ByteString -> PV.Vector Word8-ircFoldCase = PV.fromList . map (\i -> casemap PV.! fromIntegral i) . B.unpack+ircFoldCase :: ByteString -> ByteArray+ircFoldCase bs = runST $+  do let n = B.length bs+     a <- BA.newByteArray n+     for_ [0..n-1] $ \i ->+       BA.writeByteArray a i (casemap PV.! fromIntegral (B.index bs i))+     BA.unsafeFreezeByteArray a  casemap :: PV.Vector Word8 casemap