packages feed

irc-client 0.4.1.1 → 0.4.2.0

raw patch · 5 files changed

+66/−25 lines, 5 filesdep −data-default-class

Dependencies removed: data-default-class

Files

Network/IRC/Client.hs view
@@ -136,7 +136,7 @@   , _realname      = n   , _password      = Nothing   , _channels      = []-  , _ctcpVer       = "irc-client-0.4.1.1"+  , _ctcpVer       = "irc-client-0.4.2.0"   , _eventHandlers = defaultEventHandlers   , _ignore        = []   }
Network/IRC/Client/Internal.hs view
@@ -10,13 +10,13 @@  import Control.Applicative        ((<$>)) import Control.Concurrent         (forkIO)-import Control.Concurrent.STM     (atomically, readTVar, retry)+import Control.Concurrent.STM     (atomically, readTVar, retry, writeTVar) import Control.Exception          (SomeException, catch, throwIO) import Control.Monad              (unless) import Control.Monad.IO.Class     (MonadIO, liftIO) import Control.Monad.Trans.Reader (runReaderT) import Data.ByteString            (ByteString)-import Data.Conduit               (Producer, Conduit, Consumer, (=$=), ($=), (=$), awaitForever, toProducer, yield)+import Data.Conduit               (Producer, Conduit, Consumer, (=$=), ($=), (=$), await, awaitForever, toProducer, yield) import Data.Conduit.TMChan        (closeTBMChan, isEmptyTBMChan, newTBMChanIO, sourceTBMChan, writeTBMChan) import Data.Text.Encoding         (decodeUtf8, encodeUtf8) import Data.Time.Clock            (NominalDiffTime, getCurrentTime)@@ -77,6 +77,7 @@    -- Initialise the IRC session   let initialise = flip runReaderT state $ do+        liftIO . atomically $ writeTVar (_connState state) Connected         mapM_ (\p -> sendBS $ rawMessage "PASS" [encodeUtf8 p]) password         sendBS $ rawMessage "USER" [encodeUtf8 theUser, "-", "-", encodeUtf8 theReal]         _onconnect =<< connectionConfig@@ -117,13 +118,17 @@ -- | Block on receiving a message and invoke all matching handlers -- concurrently. eventSink :: MonadIO m => IRCState s -> Consumer IrcEvent m ()-eventSink ircstate = awaitForever $ \event -> do+eventSink ircstate = await >>= maybe (return ()) (\event -> do   let event'  = decodeUtf8 <$> event   ignored <- isIgnored ircstate event'   unless ignored $ do     handlers <- getHandlersFor event' . _eventHandlers <$> getInstanceConfig' ircstate     liftIO $ mapM_ (\h -> forkIO $ runReaderT (h event') ircstate) handlers +  -- If disconnected, do not loop.+  disconnected <- (==Disconnected) <$> getConnState ircstate+  unless disconnected (eventSink ircstate))+ -- | Check if an event is ignored or not. isIgnored :: MonadIO m => IRCState s -> UnicodeEvent -> m Bool isIgnored ircstate ev = do@@ -195,18 +200,31 @@ -- (if there is one). disconnect :: StatefulIRC s () disconnect = do-  queueS <- _sendqueue <$> connectionConfig+  s <- ircState -  -- Wait for all messages to be sent-  liftIO . atomically $ do-    empty <- isEmptyTBMChan queueS-    unless empty retry+  connState <- liftIO . atomically . readTVar $ _connState s+  case connState of+    Connected -> do+      -- Set the state to @Disconnecting@+      liftIO . atomically $ writeTVar (_connState s) Disconnecting -  -- Then close the connection-  disconnectNow+      -- Wait for all messages to be sent+      queueS <- _sendqueue <$> connectionConfig+      liftIO . atomically $ do+        empty <- isEmptyTBMChan queueS+        unless empty retry +      -- Then close the connection+      disconnectNow++    -- If already disconnected, or disconnecting, do nothing.+    _ -> pure ()+ -- | Disconnect immediately, without waiting for messages to be sent. disconnectNow :: StatefulIRC s () disconnectNow = do   queueS <- _sendqueue <$> connectionConfig   liftIO . atomically $ closeTBMChan queueS++  s <- ircState+  liftIO . atomically $ writeTVar (_connState s) Disconnected
Network/IRC/Client/Types.hs view
@@ -42,18 +42,26 @@                            -- ^Mutable user state                            , _instanceConfig   :: TVar (InstanceConfig s)                            -- ^Mutable instance configuration in STM+                           , _connState :: TVar ConnectionState+                           -- ^State of the connection.                            } +-- | The state of the connection.+data ConnectionState = Connected | Disconnecting | Disconnected+  deriving (Bounded, Enum, Eq, Ord, Read, Show)+ -- | Construct a new IRC state newIRCState :: MonadIO m => ConnectionConfig s -> InstanceConfig s -> s -> m (IRCState s) newIRCState cconf iconf ustate = do   ustvar <- liftIO . atomically . newTVar $ ustate   ictvar <- liftIO . atomically . newTVar $ iconf+  cstvar <- liftIO . atomically . newTVar $ Disconnected    return IRCState     { _connectionConfig = cconf     , _userState        = ustvar     , _instanceConfig   = ictvar+    , _connState        = cstvar     }  -- | Access the client state.@@ -71,6 +79,10 @@ -- | Extract the user state from an IRC state getUserState :: IRCState s -> TVar s getUserState = _userState++-- | Extract the connection state from an IRC state.+getConnState :: MonadIO m => IRCState s -> m ConnectionState+getConnState = liftIO . atomically . readTVar . _connState  -- | Extract the current snapshot of the instance configuration from -- an IRC state
Network/IRC/Client/Utils.hs view
@@ -64,3 +64,15 @@ -- | Construct a @NOTICE@ containing a CTCP ctcpReply :: Text -> Text -> [Text] -> UnicodeMessage ctcpReply t command args = Notice t . Left $ toCTCP command args++-- | Check if the client is connected.+isConnected :: StatefulIRC s Bool+isConnected = (==Connected) <$> (getConnState =<< ircState)++-- | Check if the client is in the process of disconnecting.+isDisconnecting :: StatefulIRC s Bool+isDisconnecting = (==Disconnecting) <$> (getConnState =<< ircState)++-- | Check if the client is disconnected+isDisconnected :: StatefulIRC s Bool+isDisconnected = (==Disconnected) <$> (getConnState =<< ircState)
irc-client.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.4.1.1+version:             0.4.2.0  -- A short (one-line) description of the package. synopsis:            An IRC client library.@@ -82,18 +82,17 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       base               >=4.7   && <5-                     , bytestring         >=0.10  && <0.11-                     , conduit            >=1.2   && <1.3-                     , data-default-class >=0.0.1 && <0.1-                     , irc-conduit        >=0.1.1 && <0.3-                     , irc-ctcp           >=0.1.2 && <0.2-                     , old-locale         >=1.0   && <1.1-                     , stm                >=2.4   && <2.5-                     , stm-conduit        >=2.5   && <3.1-                     , text               >=1.1   && <1.3-                     , time               >=1.4   && <1.7-                     , transformers       >=0.3   && <0.6+  build-depends:       base         >=4.7   && <5+                     , bytestring   >=0.10  && <0.11+                     , conduit      >=1.2   && <1.3+                     , irc-conduit  >=0.1.1 && <0.3+                     , irc-ctcp     >=0.1.2 && <0.2+                     , old-locale   >=1.0   && <1.1+                     , stm          >=2.4   && <2.5+                     , stm-conduit  >=2.5   && <3.1+                     , text         >=1.1   && <1.3+                     , time         >=1.4   && <1.7+                     , transformers >=0.3   && <0.6      -- Directories containing source files.   -- hs-source-dirs:      @@ -108,4 +107,4 @@ source-repository this   type:     git   location: https://github.com/barrucadu/irc-client.git-  tag:      0.4.1.1+  tag:      0.4.2.0