diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -162,30 +162,30 @@ , C.toByteString ) where -import Control.Concurrent.STM (newTVarIO) -import Control.Concurrent.STM.TBMChan (newTBMChanIO) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.ByteString (ByteString) -import qualified Data.Conduit.Network.TLS as TLS -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T -import Data.Version (showVersion) -import qualified Data.X509 as X -import qualified Data.X509.CertificateStore as X -import qualified Data.X509.Validation as X -import Network.Connection as TLS (TLSSettings(..)) -import qualified Network.IRC.Conduit as C -import qualified Network.TLS as TLS +import Control.Concurrent.STM (newTVarIO) +import Control.Concurrent.STM.TBMChan (newTBMChanIO) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString (ByteString) +import qualified Data.Conduit.Network.TLS as TLS +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import Data.Version (showVersion) +import qualified Data.X509 as X +import qualified Data.X509.CertificateStore as X +import qualified Data.X509.Validation as X +import Network.Connection as TLS (TLSSettings(..)) +import qualified Network.IRC.Conduit as C +import qualified Network.TLS as TLS -import Network.IRC.Client.Events -import Network.IRC.Client.Internal -import Network.IRC.Client.Lens +import Network.IRC.Client.Events +import Network.IRC.Client.Internal +import Network.IRC.Client.Lens -- I think exporting 'fork' with 'Disconnect' gives better documentation. -import Network.IRC.Client.Utils hiding (fork) -import qualified Network.IRC.Client.Utils as U +import Network.IRC.Client.Utils hiding (fork) +import qualified Network.IRC.Client.Utils as U -import qualified Paths_irc_client as Paths +import qualified Paths_irc_client as Paths ------------------------------------------------------------------------------- diff --git a/Network/IRC/Client/Events.hs b/Network/IRC/Client/Events.hs --- a/Network/IRC/Client/Events.hs +++ b/Network/IRC/Client/Events.hs @@ -44,31 +44,33 @@ , module Network.IRC.Conduit.Lens ) where -import Control.Applicative ((<$>), (<|>)) -import Control.Concurrent.STM (atomically, readTVar, modifyTVar) -import Control.Monad.Catch (SomeException, fromException, throwM) -import Control.Monad.IO.Class (liftIO) -import Data.Char (isAlphaNum) -import Data.Maybe (fromMaybe) -import Data.Monoid ((<>)) -import Data.Text (Text, breakOn, takeEnd, toUpper) -import Data.Time.Clock (getCurrentTime) -import Data.Time.Format (formatTime) -import Network.IRC.Conduit (Event(..), Message(..), Source(..)) -import Network.IRC.CTCP (fromCTCP) -import Network.IRC.Conduit.Lens +import Control.Applicative ((<$>), (<|>)) +import Control.Concurrent.STM (atomically, modifyTVar, readTVar) +import Control.Monad.Catch (SomeException, fromException, + throwM) +import Control.Monad.IO.Class (liftIO) +import Data.Char (isAlphaNum) +import Data.Maybe (fromMaybe) +import Data.Monoid ((<>)) +import Data.Text (Text, breakOn, takeEnd, toUpper) +import Data.Time.Clock (getCurrentTime) +import Data.Time.Format (formatTime) +import Network.IRC.Conduit (Event(..), Message(..), + Source(..)) +import Network.IRC.Conduit.Lens +import Network.IRC.CTCP (fromCTCP) #if MIN_VERSION_time(1,5,0) -import Data.Time.Format (defaultTimeLocale) +import Data.Time.Format (defaultTimeLocale) #else -import System.Locale (defaultTimeLocale) +import System.Locale (defaultTimeLocale) #endif -import qualified Data.Text as T +import qualified Data.Text as T -import Network.IRC.Client.Internal -import Network.IRC.Client.Lens -import Network.IRC.Client.Utils +import Network.IRC.Client.Internal +import Network.IRC.Client.Lens +import Network.IRC.Client.Utils ------------------------------------------------------------------------------- diff --git a/Network/IRC/Client/Internal.hs b/Network/IRC/Client/Internal.hs --- a/Network/IRC/Client/Internal.hs +++ b/Network/IRC/Client/Internal.hs @@ -22,34 +22,46 @@ , module Network.IRC.Client.Internal.Types ) where -import Control.Applicative ((<$>)) -import Control.Concurrent (forkIO, killThread, myThreadId, threadDelay, throwTo) -import Control.Concurrent.STM (STM, atomically, readTVar, readTVarIO, writeTVar) -import Control.Concurrent.STM.TBMChan (TBMChan, closeTBMChan, isClosedTBMChan, isEmptyTBMChan, readTBMChan, writeTBMChan, newTBMChan) -import Control.Monad (forM_, unless, void, when) -import Control.Monad.Catch (SomeException, catch) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Reader (ask, runReaderT) -import Data.ByteString (ByteString) -import Data.Conduit (ConduitM, (.|), await, awaitForever, yield) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import qualified Data.Set as S -import Data.Text (Text) -import Data.Text.Encoding (decodeUtf8, encodeUtf8) -import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, diffUTCTime, getCurrentTime) -import Data.Time.Format (formatTime) -import Data.Void (Void) -import Network.IRC.Conduit (Event(..), Message(..), Source(..), floodProtector, rawMessage, toByteString) +import Control.Applicative ((<$>)) +import Control.Concurrent (forkIO, killThread, + myThreadId, threadDelay, + throwTo) +import Control.Concurrent.STM (STM, atomically, readTVar, + readTVarIO, writeTVar) +import Control.Concurrent.STM.TBMChan (TBMChan, closeTBMChan, + isClosedTBMChan, + isEmptyTBMChan, newTBMChan, + readTBMChan, writeTBMChan) +import Control.Monad (forM_, unless, void, when) +import Control.Monad.Catch (SomeException, catch) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Reader (ask, runReaderT) +import Data.ByteString (ByteString) +import Data.Conduit (ConduitM, await, + awaitForever, yield, (.|)) +import Data.IORef (IORef, newIORef, readIORef, + writeIORef) +import qualified Data.Set as S +import Data.Text (Text) +import Data.Text.Encoding (decodeUtf8, encodeUtf8) +import Data.Time.Clock (NominalDiffTime, UTCTime, + addUTCTime, diffUTCTime, + getCurrentTime) +import Data.Time.Format (formatTime) +import Data.Void (Void) +import Network.IRC.Conduit (Event(..), Message(..), + Source(..), floodProtector, + rawMessage, toByteString) #if MIN_VERSION_time(1,5,0) -import Data.Time.Format (defaultTimeLocale) +import Data.Time.Format (defaultTimeLocale) #else -import System.Locale (defaultTimeLocale) +import System.Locale (defaultTimeLocale) #endif -import Network.IRC.Client.Internal.Lens -import Network.IRC.Client.Internal.Types -import Network.IRC.Client.Lens +import Network.IRC.Client.Internal.Lens +import Network.IRC.Client.Internal.Types +import Network.IRC.Client.Lens ------------------------------------------------------------------------------- @@ -126,13 +138,13 @@ -- Fork a thread to disconnect if the timeout elapses. mainTId <- liftIO myThreadId let time = _timeout cconf - let delay = round time + let delayms = 1000000 * round time let timeoutThread = do now <- getCurrentTime prior <- readIORef lastReceived if diffUTCTime now prior >= time then throwTo mainTId Timeout - else threadDelay delay >> timeoutThread + else threadDelay delayms >> timeoutThread timeoutTId <- liftIO (forkIO timeoutThread) -- Start the client. diff --git a/Network/IRC/Client/Internal/Lens.hs b/Network/IRC/Client/Internal/Lens.hs --- a/Network/IRC/Client/Internal/Lens.hs +++ b/Network/IRC/Client/Internal/Lens.hs @@ -15,13 +15,14 @@ -- of this library. module Network.IRC.Client.Internal.Lens where -import Control.Applicative (Const(..)) -import Control.Concurrent.STM (TVar, STM, atomically, readTVar, writeTVar) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Data.Functor.Contravariant (Contravariant) -import Data.Functor.Identity (Identity(..)) -import Data.Monoid (First(..)) -import Data.Profunctor (Choice) +import Control.Applicative (Const(..)) +import Control.Concurrent.STM (STM, TVar, atomically, readTVar, + readTVarIO, writeTVar) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Functor.Contravariant (Contravariant) +import Data.Functor.Identity (Identity(..)) +import Data.Monoid (First(..)) +import Data.Profunctor (Choice) ------------------------------------------------------------------------------- @@ -75,7 +76,7 @@ -- | Atomically snapshot some shared state. snapshot :: MonadIO m => Getting (TVar a) s (TVar a) -> s -> m a -snapshot lens = liftIO . atomically . readTVar . get lens +snapshot lens = liftIO . readTVarIO . get lens -- | Atomically snapshot and modify some shared state. snapshotModify :: MonadIO m => Lens' s (TVar a) -> (a -> STM (a, b)) -> s -> m b diff --git a/Network/IRC/Client/Internal/Types.hs b/Network/IRC/Client/Internal/Types.hs --- a/Network/IRC/Client/Internal/Types.hs +++ b/Network/IRC/Client/Internal/Types.hs @@ -17,22 +17,25 @@ -- of this library. module Network.IRC.Client.Internal.Types where -import Control.Applicative (Alternative) -import Control.Concurrent (ThreadId) -import Control.Concurrent.STM (TVar, atomically, readTVar, writeTVar) -import Control.Concurrent.STM.TBMChan (TBMChan) -import Control.Monad (MonadPlus) -import Control.Monad.Catch (Exception, MonadThrow, MonadCatch, MonadMask, SomeException) -import Control.Monad.IO.Class (MonadIO, liftIO) -import Control.Monad.Reader (MonadReader, ReaderT, asks) -import Control.Monad.State (MonadState(..)) -import Data.ByteString (ByteString) -import Data.Conduit (ConduitM) -import qualified Data.Set as S -import Data.Text (Text) -import Data.Time.Clock (NominalDiffTime) -import Data.Void (Void) -import Network.IRC.Conduit (Event(..), Message, Source) +import Control.Applicative (Alternative) +import Control.Concurrent (ThreadId) +import Control.Concurrent.STM (TVar, atomically, readTVar, + readTVarIO, writeTVar) +import Control.Concurrent.STM.TBMChan (TBMChan) +import Control.Monad (MonadPlus) +import Control.Monad.Catch (Exception, MonadCatch, + MonadMask, MonadThrow, + SomeException) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Monad.Reader (MonadReader, ReaderT, asks) +import Control.Monad.State (MonadState(..)) +import Data.ByteString (ByteString) +import Data.Conduit (ConduitM) +import qualified Data.Set as S +import Data.Text (Text) +import Data.Time.Clock (NominalDiffTime) +import Data.Void (Void) +import Network.IRC.Conduit (Event(..), Message, Source) ------------------------------------------------------------------------------- @@ -51,7 +54,7 @@ pure a get = do tvar <- asks _userState - liftIO $ atomically (readTVar tvar) + liftIO $ readTVarIO tvar put s = do tvar <- asks _userState liftIO $ atomically (writeTVar tvar s) @@ -92,9 +95,9 @@ , _flood :: NominalDiffTime -- ^ The minimum time between two adjacent messages. , _timeout :: NominalDiffTime - -- ^ The maximum time between received messages from the server. If no - -- messages arrive from the server for this period, the client is sent - -- a 'Timeout' exception and disconnects. + -- ^ The maximum time (in seconds) between received messages from + -- the server. If no messages arrive from the server for this + -- period, the client is sent a 'Timeout' exception and disconnects. , _onconnect :: IRC s () -- ^ Action to run after sending the @PASS@ and @USER@ commands to the -- server. The default behaviour is to send the @NICK@ command. diff --git a/Network/IRC/Client/Lens.hs b/Network/IRC/Client/Lens.hs --- a/Network/IRC/Client/Lens.hs +++ b/Network/IRC/Client/Lens.hs @@ -12,8 +12,8 @@ import Control.Concurrent.STM (TVar) import Control.Monad.Catch (SomeException) import Data.ByteString (ByteString) -import Data.Profunctor (Choice (right'), - Profunctor (dimap)) +import Data.Profunctor (Choice(right'), + Profunctor(dimap)) import Data.Text (Text) import Data.Time (NominalDiffTime) diff --git a/Network/IRC/Client/Utils.hs b/Network/IRC/Client/Utils.hs --- a/Network/IRC/Client/Utils.hs +++ b/Network/IRC/Client/Utils.hs @@ -41,17 +41,18 @@ , modify ) where -import Control.Concurrent (ThreadId, myThreadId, forkFinally) -import Control.Concurrent.STM (TVar, STM, atomically, modifyTVar) -import Control.Monad.IO.Class (liftIO) -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T -import Network.IRC.Conduit (Event(..), Message(..), Source(..)) -import Network.IRC.CTCP (toCTCP) +import Control.Concurrent (ThreadId, forkFinally, myThreadId) +import Control.Concurrent.STM (STM, TVar, atomically, modifyTVar) +import Control.Monad.IO.Class (liftIO) +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import Network.IRC.Conduit (Event(..), Message(..), + Source(..)) +import Network.IRC.CTCP (toCTCP) -import Network.IRC.Client.Internal -import Network.IRC.Client.Lens +import Network.IRC.Client.Internal +import Network.IRC.Client.Lens ------------------------------------------------------------------------------- -- Nicks diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,2 @@ -import Distribution.Simple +import Distribution.Simple main = defaultMain diff --git a/irc-client.cabal b/irc-client.cabal --- a/irc-client.cabal +++ b/irc-client.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 1.1.1.1 +version: 1.1.2.0 -- A short (one-line) description of the package. synopsis: An IRC client library. @@ -124,4 +124,4 @@ source-repository this type: git location: https://github.com/barrucadu/irc-client.git - tag: 1.1.1.1 + tag: 1.1.2.0