Merge branch 'master' of https://github.com/tolysz/yesod

Conflicts:
	yesod-websockets/yesod-websockets.cabal

yesod-websockets/Yesod/WebSockets.hs

@@ -6,8 +6,15 @@ module Yesod.WebSockets
       WebSocketsT
     , webSockets
     , receiveData
+    , receiveDataE
+    , sendPing
+    , sendPingE
+    , sendClose
+    , sendCloseE
     , sendTextData
+    , sendTextDataE
     , sendBinaryData
+    , sendBinaryDataE
       -- * Conduit API
     , sourceWS
     , sinkWSText
@@ -25,11 +32,14 @@ import           Control.Monad.IO.Class         (MonadIO (liftIO))
 import           Control.Monad.Trans.Control    (control)
 import           Control.Monad.Trans.Control    (MonadBaseControl (liftBaseWith, restoreM))
 import           Control.Monad.Trans.Reader     (ReaderT (ReaderT, runReaderT))
+import           Data.Either
 import qualified Data.Conduit                   as C
 import qualified Data.Conduit.List              as CL
 import qualified Network.Wai.Handler.WebSockets as WaiWS
 import qualified Network.WebSockets             as WS
 import qualified Yesod.Core                     as Y
+import           Control.Exception (SomeException)
+import           Control.Exception.Enclosed (tryAny)
 
 -- | A transformer for a WebSockets handler.
 --
@@ -58,23 +68,74 @@ webSockets inner = do
             src
             sink
 
+-- | Wrapper for capturing exceptions
+wrapWSE :: (MonadIO m, WS.WebSocketsData a) => (WS.Connection -> a -> IO ())-> a -> WebSocketsT m (Either SomeException ())
+wrapWSE ws x = ReaderT $ liftIO . tryAny . flip ws x
+
+wrapWS :: (MonadIO m, WS.WebSocketsData a) => (WS.Connection -> a -> IO ()) -> a -> WebSocketsT m ()
+wrapWS ws x = ReaderT $ liftIO . flip ws x
+
 -- | Receive a piece of data from the client.
 --
 -- Since 0.1.0
 receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a
 receiveData = ReaderT $ liftIO . WS.receiveData
 
+-- | Receive a piece of data from the client.
+-- Capture SomeException as the result or operation
+-- Since 0.1.1.3
+receiveDataE :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m (Either SomeException a)
+receiveDataE = ReaderT $ liftIO . tryAny . WS.receiveData
+
 -- | Send a textual message to the client.
 --
 -- Since 0.1.0
 sendTextData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
-sendTextData x = ReaderT $ liftIO . flip WS.sendTextData x
+sendTextData = wrapWS WS.sendTextData
+
+-- | Send a textual message to the client.
+-- Capture SomeException as the result or operation
+-- and can be used like 
+-- `either handle_exception return =<< sendTextDataE ("Welcome" :: Text)`
+-- Since 0.1.1.3
+sendTextDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendTextDataE = wrapWSE WS.sendTextData
 
 -- | Send a binary message to the client.
 --
 -- Since 0.1.0
 sendBinaryData :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
-sendBinaryData x = ReaderT $ liftIO . flip WS.sendBinaryData x
+sendBinaryData = wrapWS WS.sendBinaryData
+
+-- | Send a binary message to the client.
+-- Capture SomeException as the result of operation
+-- Since 0.1.1.3
+sendBinaryDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendBinaryDataE = wrapWSE WS.sendBinaryData
+
+-- | Send a ping message to the client.
+--
+-- Since 0.1.1.3
+sendPing :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendPing = wrapWS WS.sendPing
+
+-- | Send a ping message to the client. 
+-- Capture SomeException as the result of operation
+-- Since 0.1.1.3
+sendPingE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendPingE = wrapWSE WS.sendPing
+
+-- | Send a close request to the client. 
+-- 
+-- Since 0.1.1.3
+sendClose :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m ()
+sendClose = wrapWS WS.sendClose
+
+-- | Send a close request to the client. 
+-- Capture SomeException as the result of operation
+-- Since 0.1.1.3
+sendCloseE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
+sendCloseE = wrapWSE WS.sendClose
 
 -- | A @Source@ of WebSockets data from the user.
 --

yesod-websockets/yesod-websockets.cabal

@@ -1,5 +1,5 @@
 name:                yesod-websockets
-version:             0.2.1.1
+version:             0.2.2
 synopsis:            WebSockets support for Yesod
 description:         WebSockets support for Yesod
 homepage:            https://github.com/yesodweb/yesod
@@ -27,6 +27,7 @@ library
                      , monad-control     >= 0.3
                      , conduit           >= 1.0.15.1
                      , async             >= 2.0.1.5
+                     , enclosed-exceptions >= 1.0
 
 source-repository head
   type:     git