You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
33 lines
1.1 KiB
33 lines
1.1 KiB
|
13 years ago
|
{-# OPTIONS_HADDOCK hide #-}
|
||
|
13 years ago
|
module Network.Xmpp.Concurrent.Presence where
|
||
|
13 years ago
|
|
||
|
|
import Control.Concurrent.STM
|
||
|
|
import Data.IORef
|
||
|
|
import Network.Xmpp.Types
|
||
|
|
import Network.Xmpp.Concurrent.Types
|
||
|
13 years ago
|
import Network.Xmpp.Concurrent.Basic
|
||
|
13 years ago
|
|
||
|
|
-- | Read an element from the inbound stanza channel, acquiring a copy of the
|
||
|
|
-- channel as necessary.
|
||
|
13 years ago
|
pullPresence :: Session -> IO (Either PresenceError Presence)
|
||
|
13 years ago
|
pullPresence session = do
|
||
|
13 years ago
|
stanza <- atomically . readTChan $ stanzaCh session
|
||
|
|
case stanza of
|
||
|
|
PresenceS p -> return $ Right p
|
||
|
|
PresenceErrorS e -> return $ Left e
|
||
|
|
_ -> pullPresence session
|
||
|
13 years ago
|
|
||
|
|
-- | Pulls a (non-error) presence and returns it if the given predicate returns
|
||
|
|
-- @True@.
|
||
|
13 years ago
|
waitForPresence :: (Presence -> Bool) -> Session -> IO Presence
|
||
|
13 years ago
|
waitForPresence f session = do
|
||
|
|
s <- pullPresence session
|
||
|
|
case s of
|
||
|
|
Left _ -> waitForPresence f session
|
||
|
|
Right m | f m -> return m
|
||
|
|
| otherwise -> waitForPresence f session
|
||
|
|
|
||
|
|
-- | Send a presence stanza.
|
||
|
13 years ago
|
sendPresence :: Presence -> Session -> IO ()
|
||
|
13 years ago
|
sendPresence p session = sendStanza (PresenceS p) session
|