{-# OPTIONS_HADDOCK hide #-}
module Network.Xmpp.Concurrent.Presence where
import Control.Applicative ((<$>))
import Control.Concurrent.STM
import Control.Lens.Prism (_Just)
import Lens.Family2 hiding (to)
import Lens.Family2.Stock hiding (_Just)
import Network.Xmpp.Concurrent.Basic
import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Lens
import Network.Xmpp.Types
pullPresenceA :: Session -> IO (Either (Annotated PresenceError)
(Annotated Presence))
pullPresenceA :: Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
session = do
(Stanza
stanza, [Annotation]
as) <- forall a. STM a -> IO a
atomically forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TChan a -> STM a
readTChan forall a b. (a -> b) -> a -> b
$ Session -> TChan (Stanza, [Annotation])
stanzaCh Session
session
case Stanza
stanza of
PresenceS Presence
p -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Presence
p, [Annotation]
as)
PresenceErrorS PresenceError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (PresenceError
e, [Annotation]
as)
Stanza
_ -> Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
session
pullPresence :: Session -> IO (Either PresenceError Presence)
pullPresence :: Session -> IO (Either PresenceError Presence)
pullPresence Session
s = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
s
waitForPresenceA :: (Annotated Presence -> Bool)
-> Session
-> IO (Annotated Presence)
waitForPresenceA :: (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
session = do
Either (Annotated PresenceError) (Annotated Presence)
s <- Session
-> IO (Either (Annotated PresenceError) (Annotated Presence))
pullPresenceA Session
session
case Either (Annotated PresenceError) (Annotated Presence)
s of
Left Annotated PresenceError
_ -> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
session
Right Annotated Presence
m | Annotated Presence -> Bool
f Annotated Presence
m -> forall (m :: * -> *) a. Monad m => a -> m a
return Annotated Presence
m
| Bool
otherwise -> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA Annotated Presence -> Bool
f Session
session
waitForPresence :: (Presence -> Bool) -> Session -> IO Presence
waitForPresence :: (Presence -> Bool) -> Session -> IO Presence
waitForPresence Presence -> Bool
f Session
s = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Annotated Presence -> Bool) -> Session -> IO (Annotated Presence)
waitForPresenceA (Presence -> Bool
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Session
s
sendPresence :: Presence -> Session -> IO (Either XmppFailure ())
sendPresence :: Presence -> Session -> IO (Either XmppFailure ())
sendPresence Presence
p Session
session = Stanza -> Session -> IO (Either XmppFailure ())
sendStanza (Presence -> Stanza
PresenceS Presence
checkedP) Session
session
where
checkedP :: Presence
checkedP = case Presence -> PresenceType
presenceType Presence
p of
PresenceType
Subscribe -> Presence
p forall s t. s -> (s -> t) -> t
& forall s. IsStanza s => Lens s (Maybe Jid)
to forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Prism (Maybe a) (Maybe b) a b
_Just forall s t a b. Setter s t a b -> (a -> b) -> s -> t
%~ Jid -> Jid
toBare
PresenceType
_ -> Presence
p