From 3ff3c71a98c0a2e2914d46a264fda24805581970 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Mon, 26 Nov 2012 15:48:33 +0100 Subject: [PATCH] rename CSession to Context rename forkSessionChan to forkContext --- source/Network/Xmpp.hs | 6 ++-- source/Network/Xmpp/Concurrent/Channels.hs | 10 +++--- .../Network/Xmpp/Concurrent/Channels/Basic.hs | 8 ++--- source/Network/Xmpp/Concurrent/Channels/IQ.hs | 34 +++++++++---------- .../Xmpp/Concurrent/Channels/Message.hs | 14 ++++---- .../Xmpp/Concurrent/Channels/Presence.hs | 10 +++--- .../Network/Xmpp/Concurrent/Channels/Types.hs | 2 +- source/Network/Xmpp/Xep/ServiceDiscovery.hs | 4 +-- 8 files changed, 44 insertions(+), 44 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index 3a06f37..0c87fc8 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -29,8 +29,8 @@ module Network.Xmpp ( -- * Session management - Session - , newSessionChans + Context + , newContext , withConnection , connect , simpleConnect @@ -141,7 +141,7 @@ module Network.Xmpp , iqRequestPayload , iqResultPayload -- * Threads - , forkCSession + , forkContext -- * Miscellaneous , LangTag(..) , exampleParams diff --git a/source/Network/Xmpp/Concurrent/Channels.hs b/source/Network/Xmpp/Concurrent/Channels.hs index 3f23e06..45afd4c 100644 --- a/source/Network/Xmpp/Concurrent/Channels.hs +++ b/source/Network/Xmpp/Concurrent/Channels.hs @@ -6,7 +6,7 @@ module Network.Xmpp.Concurrent.Channels , module Network.Xmpp.Concurrent.Channels.Presence , module Network.Xmpp.Concurrent.Channels.IQ , toChans - , newSessionChans + , newContext , writeWorker ) @@ -90,9 +90,9 @@ toChans messageC presenceC stanzaC iqHands sta = atomically $ do iqID (Right iq') = iqResultID iq' --- | Creates and initializes a new concurrent session. -newSessionChans :: IO CSession -newSessionChans = do +-- | Creates and initializes a new concurrent context. +newContext :: IO Context +newContext = do messageC <- newTChanIO presenceC <- newTChanIO outC <- newTChanIO @@ -116,7 +116,7 @@ newSessionChans = do , eventHandlers = eh , stopThreads = kill >> killThread writer } - return $ CSession { session = sess + return $ Context { session = sess , mShadow = messageC , pShadow = presenceC , sShadow = stanzaC diff --git a/source/Network/Xmpp/Concurrent/Channels/Basic.hs b/source/Network/Xmpp/Concurrent/Channels/Basic.hs index 51f7914..4e1395d 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Basic.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Basic.hs @@ -6,16 +6,16 @@ import Network.Xmpp.Concurrent.Channels.Types import Network.Xmpp.Types -- | Get a duplicate of the stanza channel -getStanzaChan :: CSession -> IO (TChan Stanza) +getStanzaChan :: Context -> IO (TChan Stanza) getStanzaChan session = atomically $ dupTChan (sShadow session) -- | Send a stanza to the server. -sendStanza :: Stanza -> CSession -> IO () +sendStanza :: Stanza -> Context -> IO () sendStanza a session = atomically $ writeTChan (outCh session) a -- | Create a forked session object -forkCSession :: CSession -> IO CSession -forkCSession session = do +forkContext :: Context -> IO Context +forkContext session = do mCH' <- newIORef Nothing pCH' <- newIORef Nothing return $ session {messagesRef = mCH' , presenceRef = pCH'} diff --git a/source/Network/Xmpp/Concurrent/Channels/IQ.hs b/source/Network/Xmpp/Concurrent/Channels/IQ.hs index 4923756..087b91e 100644 --- a/source/Network/Xmpp/Concurrent/Channels/IQ.hs +++ b/source/Network/Xmpp/Concurrent/Channels/IQ.hs @@ -23,28 +23,28 @@ sendIQ :: Maybe Int -- ^ Timeout -> Maybe LangTag -- ^ Language tag of the payload (@Nothing@ for -- default) -> Element -- ^ The IQ body (there has to be exactly one) - -> CSession + -> Context -> IO (TMVar IQResponse) -sendIQ timeOut to tp lang body csession = do -- TODO: Add timeout - newId <- idGenerator (session csession) +sendIQ timeOut to tp lang body context = do -- TODO: Add timeout + newId <- idGenerator (session context) ref <- atomically $ do resRef <- newEmptyTMVar - (byNS, byId) <- readTVar (iqHandlers csession) - writeTVar (iqHandlers csession) (byNS, Map.insert newId resRef byId) + (byNS, byId) <- readTVar (iqHandlers context) + writeTVar (iqHandlers context) (byNS, Map.insert newId resRef byId) -- TODO: Check for id collisions (shouldn't happen?) return resRef - sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) csession + sendStanza (IQRequestS $ IQRequest newId Nothing to lang tp body) context case timeOut of Nothing -> return () Just t -> void . forkIO $ do threadDelay t - doTimeOut (iqHandlers csession) newId ref + doTimeOut (iqHandlers context) newId ref return ref where doTimeOut handlers iqid var = atomically $ do p <- tryPutTMVar var IQResponseTimeout when p $ do - (byNS, byId) <- readTVar (iqHandlers csession) + (byNS, byId) <- readTVar (iqHandlers context) writeTVar handlers (byNS, Map.delete iqid byId) return () @@ -54,10 +54,10 @@ sendIQ' :: Maybe Jid -> IQRequestType -> Maybe LangTag -> Element - -> CSession + -> Context -> IO IQResponse -sendIQ' to tp lang body csession = do - ref <- sendIQ (Just 3000000) to tp lang body csession +sendIQ' to tp lang body context = do + ref <- sendIQ (Just 3000000) to tp lang body context atomically $ takeTMVar ref @@ -68,10 +68,10 @@ sendIQ' to tp lang body csession = do -- to interfere with existing consumers. listenIQChan :: IQRequestType -- ^ Type of IQs to receive (@Get@ or @Set@) -> Text -- ^ Namespace of the child element - -> CSession + -> Context -> IO (Either (TChan IQRequestTicket) (TChan IQRequestTicket)) -listenIQChan tp ns csession = do - let handlers = (iqHandlers csession) +listenIQChan tp ns context = do + let handlers = (iqHandlers context) atomically $ do (byNS, byID) <- readTVar handlers iqCh <- newTChan @@ -87,12 +87,12 @@ listenIQChan tp ns csession = do answerIQ :: IQRequestTicket -> Either StanzaError (Maybe Element) - -> CSession + -> Context -> IO Bool answerIQ (IQRequestTicket sentRef (IQRequest iqid from _to lang _tp bd)) - answer csession = do + answer context = do let response = case answer of Left err -> IQErrorS $ IQError iqid Nothing from lang err (Just bd) Right res -> IQResultS $ IQResult iqid Nothing from lang res @@ -102,6 +102,6 @@ answerIQ (IQRequestTicket False -> do writeTVar sentRef True - writeTChan (outCh csession) response + writeTChan (outCh context) response return True True -> return False diff --git a/source/Network/Xmpp/Concurrent/Channels/Message.hs b/source/Network/Xmpp/Concurrent/Channels/Message.hs index 6f55962..58dbc6d 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Message.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Message.hs @@ -10,7 +10,7 @@ import Network.Xmpp.Concurrent.Channels.Basic -- | Get the inbound stanza channel, duplicates from master if necessary. Please -- note that once duplicated it will keep filling up, call 'dropMessageChan' to -- allow it to be garbage collected. -getMessageChan :: CSession -> IO (TChan (Either MessageError Message)) +getMessageChan :: Context -> IO (TChan (Either MessageError Message)) getMessageChan session = do mCh <- readIORef . messagesRef $ session case mCh of @@ -22,19 +22,19 @@ getMessageChan session = do -- | Drop the local end of the inbound stanza channel from our context so it can -- be GC-ed. -dropMessageChan :: CSession -> IO () +dropMessageChan :: Context -> IO () dropMessageChan session = writeIORef (messagesRef session) Nothing -- | Read an element from the inbound stanza channel, acquiring a copy of the -- channel as necessary. -pullMessage :: CSession -> IO (Either MessageError Message) +pullMessage :: Context -> IO (Either MessageError Message) pullMessage session = do c <- getMessageChan session atomically $ readTChan c -- | Pulls a (non-error) message and returns it if the given predicate returns -- @True@. -waitForMessage :: (Message -> Bool) -> CSession -> IO Message +waitForMessage :: (Message -> Bool) -> Context -> IO Message waitForMessage f session = do s <- pullMessage session case s of @@ -43,7 +43,7 @@ waitForMessage f session = do | otherwise -> waitForMessage f session -- | Pulls an error message and returns it if the given predicate returns @True@. -waitForMessageError :: (MessageError -> Bool) -> CSession -> IO MessageError +waitForMessageError :: (MessageError -> Bool) -> Context -> IO MessageError waitForMessageError f session = do s <- pullMessage session case s of @@ -55,7 +55,7 @@ waitForMessageError f session = do -- | Pulls a message and returns it if the given predicate returns @True@. filterMessages :: (MessageError -> Bool) -> (Message -> Bool) - -> CSession -> IO (Either MessageError Message) + -> Context -> IO (Either MessageError Message) filterMessages f g session = do s <- pullMessage session case s of @@ -65,5 +65,5 @@ filterMessages f g session = do | otherwise -> filterMessages f g session -- | Send a message stanza. -sendMessage :: Message -> CSession -> IO () +sendMessage :: Message -> Context -> IO () sendMessage m session = sendStanza (MessageS m) session diff --git a/source/Network/Xmpp/Concurrent/Channels/Presence.hs b/source/Network/Xmpp/Concurrent/Channels/Presence.hs index e264a14..9c3d878 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Presence.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Presence.hs @@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types import Network.Xmpp.Concurrent.Channels.Basic -- | Analogous to 'getMessageChan'. -getPresenceChan :: CSession -> IO (TChan (Either PresenceError Presence)) +getPresenceChan :: Context -> IO (TChan (Either PresenceError Presence)) getPresenceChan session = do pCh <- readIORef $ (presenceRef session) case pCh of @@ -20,20 +20,20 @@ getPresenceChan session = do -- | Analogous to 'dropMessageChan'. -dropPresenceChan :: CSession -> IO () +dropPresenceChan :: Context -> IO () dropPresenceChan session = writeIORef (presenceRef session) Nothing -- | Read an element from the inbound stanza channel, acquiring a copy of the -- channel as necessary. -pullPresence :: CSession -> IO (Either PresenceError Presence) +pullPresence :: Context -> IO (Either PresenceError Presence) pullPresence session = do c <- getPresenceChan session atomically $ readTChan c -- | Pulls a (non-error) presence and returns it if the given predicate returns -- @True@. -waitForPresence :: (Presence -> Bool) -> CSession -> IO Presence +waitForPresence :: (Presence -> Bool) -> Context -> IO Presence waitForPresence f session = do s <- pullPresence session case s of @@ -42,5 +42,5 @@ waitForPresence f session = do | otherwise -> waitForPresence f session -- | Send a presence stanza. -sendPresence :: Presence -> CSession -> IO () +sendPresence :: Presence -> Context -> IO () sendPresence p session = sendStanza (PresenceS p) session diff --git a/source/Network/Xmpp/Concurrent/Channels/Types.hs b/source/Network/Xmpp/Concurrent/Channels/Types.hs index 0832154..fcf4ee7 100644 --- a/source/Network/Xmpp/Concurrent/Channels/Types.hs +++ b/source/Network/Xmpp/Concurrent/Channels/Types.hs @@ -8,7 +8,7 @@ import Network.Xmpp.Concurrent.Types import Network.Xmpp.Types -- | Session with Channels -data CSession = CSession +data Context = Context { session :: Session -- The original master channels that the reader puts stanzas -- into. These are cloned by @get{STanza,Message,Presence}Chan diff --git a/source/Network/Xmpp/Xep/ServiceDiscovery.hs b/source/Network/Xmpp/Xep/ServiceDiscovery.hs index 233f981..1a6882d 100644 --- a/source/Network/Xmpp/Xep/ServiceDiscovery.hs +++ b/source/Network/Xmpp/Xep/ServiceDiscovery.hs @@ -86,7 +86,7 @@ xpQueryInfo = xpWrap (\(nd, (feats, ids)) -> QIR nd ids feats) -- | Query an entity for it's identity and features queryInfo :: Jid -- ^ Entity to query -> Maybe Text.Text -- ^ Node - -> CSession + -> Context -> IO (Either DiscoError QueryInfoResult) queryInfo to node session = do res <- sendIQ' (Just to) Get Nothing queryBody session @@ -149,7 +149,7 @@ xpQueryItems = xpElem (itemsN "query") -- | Query an entity for Items of a node queryItems :: Jid -- ^ Entity to query -> Maybe Text.Text -- ^ Node - -> CSession + -> Context -> IO (Either DiscoError (Maybe Text.Text, [Item])) queryItems to node session = do res <- sendIQ' (Just to) Get Nothing queryBody session