Browse Source

minor formatting and documentation additions; changed Session field

order
master
Jon Kristensen 14 years ago
parent
commit
abb264a311
  1. 2
      src/Network/XMPP/Concurrent/Monad.hs
  2. 9
      src/Network/XMPP/Concurrent/Threads.hs
  3. 70
      src/Network/XMPP/Concurrent/Types.hs

2
src/Network/XMPP/Concurrent/Monad.hs

@ -170,7 +170,7 @@ withConnection a = do
write <- asks writeRef write <- asks writeRef
wait <- liftIO $ newEmptyTMVarIO wait <- liftIO $ newEmptyTMVarIO
liftIO . Ex.mask_ $ do liftIO . Ex.mask_ $ do
-- Kills the reader until the lock (wait) is released (set to `()'). -- Suspends the reader until the lock (wait) is released (set to `()').
throwTo readerId $ Interrupt wait throwTo readerId $ Interrupt wait
-- We acquire the write and stateRef locks, to make sure that this is -- We acquire the write and stateRef locks, to make sure that this is
-- the only thread that can write to the stream and to perform a -- the only thread that can write to the stream and to perform a

9
src/Network/XMPP/Concurrent/Threads.hs

@ -181,6 +181,11 @@ startThreads = do
_ <- atomically $ takeTMVar writeLock -- Should we put it back? _ <- atomically $ takeTMVar writeLock -- Should we put it back?
_ <- forM threads killThread _ <- forM threads killThread
return () return ()
zeroEventHandlers :: EventHandlers
zeroEventHandlers = EventHandlers
{ sessionEndHandler = return ()
, connectionClosedHandler = \_ -> return ()
}
-- | Creates and initializes a new XMPP session. -- | Creates and initializes a new XMPP session.
newSession :: IO Session newSession :: IO Session
@ -194,10 +199,10 @@ newSession = do
writeTVar idRef (curId + 1 :: Integer) writeTVar idRef (curId + 1 :: Integer)
return . read. show $ curId return . read. show $ curId
return $ Session return $ Session
workermCh
workerpCh
mC mC
pC pC
workermCh
workerpCh
outC outC
hand hand
writeR writeR

70
src/Network/XMPP/Concurrent/Types.hs

@ -14,49 +14,51 @@ import qualified Data.Map as Map
import Data.Text(Text) import Data.Text(Text)
import Data.Typeable import Data.Typeable
import Network.XMPP.Types import Network.XMPP.Types
-- Map between the IQ request type and the "query" namespace pair, and the TChan
type IQHandlers = (Map.Map (IQRequestType, Text) (TChan (IQRequest, TVar Bool)) -- for the IQ request and "sent" boolean pair.
type IQHandlers = ( Map.Map (IQRequestType, Text) (TChan (IQRequest, TVar Bool))
, Map.Map StanzaId (TMVar IQResponse) , Map.Map StanzaId (TMVar IQResponse)
) )
-- Handlers to be run when the XMPP session ends and when the XMPP connection is
-- closed.
data EventHandlers = EventHandlers data EventHandlers = EventHandlers
{ sessionEndHandler :: IO () { sessionEndHandler :: IO ()
, connectionClosedHandler :: StreamError -> IO () , connectionClosedHandler :: StreamError -> IO ()
} }
zeroEventHandlers :: EventHandlers -- The Session object is the XMPP (ReaderT) state.
zeroEventHandlers = EventHandlers data Session = Session
{ sessionEndHandler = return () { -- The original master channels that the reader puts stanzas into. These
, connectionClosedHandler = \_ -> return () -- are cloned by @get{Message,Presence}Chan on demand when first used by
} -- the thread and are stored in the {message,presence}Ref fields below.
mShadow :: TChan (Either MessageError Message)
data Session = Session { messagesRef :: IORef (Maybe ( TChan (Either , pShadow :: TChan (Either PresenceError Presence)
MessageError -- The cloned copies of the original/shadow channels. They are
Message -- thread-local (as opposed to the shadow channels) and contains all
))) -- stanzas received after the cloning of the shadow channels.
, presenceRef :: IORef (Maybe (TChan (Either , messagesRef :: IORef (Maybe (TChan (Either MessageError Message)))
PresenceError Presence ))) , presenceRef :: IORef (Maybe (TChan (Either PresenceError Presence)))
, mShadow :: TChan (Either MessageError , outCh :: TChan Stanza
Message) , iqHandlers :: TVar IQHandlers
-- the original chan -- Writing lock, so that only one thread could write to the stream at any
, pShadow :: TChan (Either PresenceError -- given time.
Presence) , writeRef :: TMVar (BS.ByteString -> IO Bool)
-- the original chan , readerThread :: ThreadId
, outCh :: TChan Stanza , idGenerator :: IO StanzaId
, iqHandlers :: TVar IQHandlers -- Lock (used by withConnection) to make sure that a maximum of one
, writeRef :: TMVar (BS.ByteString -> IO Bool ) -- XMPPConMonad calculation is executed at any given time.
, readerThread :: ThreadId , conStateRef :: TMVar XmppConnection
, idGenerator :: IO StanzaId , eventHandlers :: TVar EventHandlers
, conStateRef :: TMVar XmppConnection , stopThreads :: IO ()
, eventHandlers :: TVar EventHandlers }
, stopThreads :: IO ()
}
-- XMPP is a monad for concurrent XMPP usage.
type XMPP a = ReaderT Session IO a type XMPP a = ReaderT Session IO a
-- Interrupt is used to signal to the reader thread that it should stop.
data Interrupt = Interrupt (TMVar ()) deriving Typeable data Interrupt = Interrupt (TMVar ()) deriving Typeable
instance Show Interrupt where show _ = "<Interrupt>" instance Show Interrupt where show _ = "<Interrupt>"
instance Ex.Exception Interrupt instance Ex.Exception Interrupt
Loading…
Cancel
Save