haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add versions with exceptions

Browse Source 
Add versions of commands which execute IO () actions on exceptions.
This commit is contained in:
tolysz 2014-07-14 12:08:46 +01:00
parent 9d006b0ea2
commit 772e9ec7f8
1 changed files with 37 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
yesod-websockets/Yesod/WebSockets.hs
View File

@ -30,6 +30,7 @@ import qualified Data.Conduit.List as CL
import qualified Network.Wai.Handler.WebSockets as WaiWS import qualified Network.Wai.Handler.WebSockets as WaiWS
import qualified Network.WebSockets as WS import qualified Network.WebSockets as WS
import qualified Yesod.Core as Y import qualified Yesod.Core as Y
import qualified Control.Exception as E
-- | A transformer for a WebSockets handler. -- | A transformer for a WebSockets handler.
-- --
@ -67,18 +68,54 @@ webSockets inner = do
receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a
receiveData = ReaderT $ liftIO . WS.receiveData receiveData = ReaderT $ liftIO . WS.receiveData
-- | Receive a piece of data from the client.
-- Execute IO () action on WebSocket Exception
-- Since 0.1.1.3
receiveDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m a
receiveDataX ex d = ReaderT $ \c -> liftIO $ (WS.receiveData c) `E.catch` (\(_ :: E.SomeException) -> ex >> return d)
-- | Send a textual message to the client. -- | Send a textual message to the client.
-- --
-- Since 0.1.0 -- Since 0.1.0
sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x
-- | Send a textual message to the client.
-- Execute IO () action on WebSocket Exception
-- Since 0.1.1.3
sendTextDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m ()
sendTextDataX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendTextData x $ c) `E.catch` (\(_ :: E.SomeException) -> ex)
-- | Send a binary message to the client. -- | Send a binary message to the client.
-- --
-- Since 0.1.0 -- Since 0.1.0
sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x
-- | Send a ping message to the client.
--
-- Since 0.1.1.3
sendPing :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
sendPing x = ReaderT $ liftIO $ flip WS.sendPing x
-- | Send a ping message to the client.
-- Execute IO () action on WebSocket Exception
-- Since 0.1.1.3
sendPingX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m ()
sendPingX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendPing x $ c) `E.catch` (\(_ :: E.SomeException) -> ex)
-- | Send a close request to the client.
--
-- Since 0.1.1.3
sendClose :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
sendClose x = ReaderT $ liftIO . flip WS.sendClose x
-- | Send a close request to the client.
-- Execute IO () action on WebSocket Exception
-- Since 0.1.1.3
sendCloseX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m ()
sendCloseX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendClose x $ c) `E.catch` (\(_ :: E.SomeException) -> ex)
-- | A @Source@ of WebSockets data from the user. -- | A @Source@ of WebSockets data from the user.
-- --
-- Since 0.1.0 -- Since 0.1.0