{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Xmpp.Concurrent.Monad where
import Control.Applicative ((<$>))
import Control.Concurrent
import Control.Concurrent.STM
import qualified Control.Exception.Lifted as Ex
import Control.Monad.State
import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Stream
import Network.Xmpp.Types
withConnection :: (Stream -> IO (b, Stream))
-> Session
-> IO (Either XmppFailure b)
withConnection :: forall b.
(Stream -> IO (b, Stream)) -> Session -> IO (Either XmppFailure b)
withConnection Stream -> IO (b, Stream)
a Session
session = do
TMVar ()
wait <- forall a. IO (TMVar a)
newEmptyTMVarIO
forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
Ex.mask_ forall a b. (a -> b) -> a -> b
$ do
forall e. Exception e => ThreadId -> e -> IO ()
throwTo (Session -> ThreadId
readerThread Session
session) forall a b. (a -> b) -> a -> b
$ TMVar () -> Interrupt
Interrupt TMVar ()
wait
Stream
s <- forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
Ex.catch
(forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
ByteString -> IO (Either XmppFailure ())
_ <- forall a. TMVar a -> STM a
takeTMVar (Session -> WriteSemaphore
writeSemaphore Session
session)
Stream
s <- forall a. TMVar a -> STM a
takeTMVar (Session -> TMVar Stream
streamRef Session
session)
forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
wait ()
forall (m :: * -> *) a. Monad m => a -> m a
return Stream
s
)
(\SomeException
e -> forall a. STM a -> IO a
atomically (forall a. TMVar a -> a -> STM ()
putTMVar TMVar ()
wait ()) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
Ex.throwIO (SomeException
e :: Ex.SomeException)
)
forall (m :: * -> *) a.
MonadBaseControl IO m =>
m a -> [Handler m a] -> m a
Ex.catches
(do
(b
res, Stream
s') <- Stream -> IO (b, Stream)
a Stream
s
ByteString -> IO (Either XmppFailure ())
wl <- forall a. StateT StreamState IO a -> Stream -> IO a
withStream' (forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets forall a b. (a -> b) -> a -> b
$ StreamHandle -> ByteString -> IO (Either XmppFailure ())
streamSend forall b c a. (b -> c) -> (a -> b) -> a -> c
. StreamState -> StreamHandle
streamHandle) Stream
s'
forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ do
forall a. TMVar a -> a -> STM ()
putTMVar (Session -> WriteSemaphore
writeSemaphore Session
session) ByteString -> IO (Either XmppFailure ())
wl
forall a. TMVar a -> a -> STM ()
putTMVar (Session -> TMVar Stream
streamRef Session
session) Stream
s'
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right b
res
)
[ forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Ex.Handler forall a b. (a -> b) -> a -> b
$ \XmppFailure
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 (XmppFailure
e :: XmppFailure)
, forall (m :: * -> *) a e. Exception e => (e -> m a) -> Handler m a
Ex.Handler forall a b. (a -> b) -> a -> b
$ \SomeException
e -> Stream -> IO (Either XmppFailure ())
killStream Stream
s
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) e a. (MonadBase IO m, Exception e) => e -> m a
Ex.throwIO (SomeException
e :: Ex.SomeException)
]
modifyHandlers :: (EventHandlers -> EventHandlers) -> Session -> IO ()
modifyHandlers :: (EventHandlers -> EventHandlers) -> Session -> IO ()
modifyHandlers EventHandlers -> EventHandlers
f Session
session = forall a. STM a -> IO a
atomically forall a b. (a -> b) -> a -> b
$ forall a. TMVar a -> (a -> a) -> STM ()
modifyTMVar_ (Session -> TMVar EventHandlers
eventHandlers Session
session) EventHandlers -> EventHandlers
f
where
modifyTMVar_ :: TMVar a -> (a -> a) -> STM ()
modifyTMVar_ :: forall a. TMVar a -> (a -> a) -> STM ()
modifyTMVar_ TMVar a
var a -> a
g = do
a
x <- forall a. TMVar a -> STM a
takeTMVar TMVar a
var
forall a. TMVar a -> a -> STM ()
putTMVar TMVar a
var (a -> a
g a
x)
setConnectionClosedHandler :: (XmppFailure -> Session -> IO ()) -> Session -> IO ()
setConnectionClosedHandler :: (XmppFailure -> Session -> IO ()) -> Session -> IO ()
setConnectionClosedHandler XmppFailure -> Session -> IO ()
eh Session
session = do
(EventHandlers -> EventHandlers) -> Session -> IO ()
modifyHandlers (\EventHandlers
s -> EventHandlers
s{connectionClosedHandler :: XmppFailure -> IO ()
connectionClosedHandler =
\XmppFailure
e -> XmppFailure -> Session -> IO ()
eh XmppFailure
e Session
session}) Session
session
runConnectionClosedHandler :: Session -> XmppFailure -> IO ()
runConnectionClosedHandler :: Session -> XmppFailure -> IO ()
runConnectionClosedHandler Session
session XmppFailure
e = do
XmppFailure -> IO ()
h <- EventHandlers -> XmppFailure -> IO ()
connectionClosedHandler forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. STM a -> IO a
atomically (forall a. TMVar a -> STM a
readTMVar
forall a b. (a -> b) -> a -> b
$ Session -> TMVar EventHandlers
eventHandlers Session
session)
XmppFailure -> IO ()
h XmppFailure
e
runHandler :: (EventHandlers -> IO a) -> Session -> IO a
runHandler :: forall a. (EventHandlers -> IO a) -> Session -> IO a
runHandler EventHandlers -> IO a
h Session
session = EventHandlers -> IO a
h forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. STM a -> IO a
atomically (forall a. TMVar a -> STM a
readTMVar forall a b. (a -> b) -> a -> b
$ Session -> TMVar EventHandlers
eventHandlers Session
session)
endSession :: Session -> IO ()
endSession :: Session -> IO ()
endSession Session
session = do
Session -> IO ()
stopThreads Session
session
Either XmppFailure ()
_ <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b.
(Stream -> IO (b, Stream)) -> Session -> IO (Either XmppFailure b)
withConnection Session
session forall a b. (a -> b) -> a -> b
$ \Stream
stream -> do
()
_ <- Stream -> IO ()
closeStreams Stream
stream
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Stream
stream)
forall (m :: * -> *) a. Monad m => a -> m a
return ()
closeConnection :: Session -> IO ()
closeConnection :: Session -> IO ()
closeConnection Session
session = do
Either XmppFailure ()
_ <-forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b.
(Stream -> IO (b, Stream)) -> Session -> IO (Either XmppFailure b)
withConnection Session
session forall a b. (a -> b) -> a -> b
$ \Stream
stream -> do
()
_ <- Stream -> IO ()
closeStreams Stream
stream
forall (m :: * -> *) a. Monad m => a -> m a
return ((), Stream
stream)
Session -> XmppFailure -> IO ()
runConnectionClosedHandler Session
session XmppFailure
StreamEndFailure