diff --git a/yesod-websockets/Yesod/WebSockets.hs b/yesod-websockets/Yesod/WebSockets.hs index 38f3215b..2ee44809 100644 --- a/yesod-websockets/Yesod/WebSockets.hs +++ b/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. -- diff --git a/yesod-websockets/yesod-websockets.cabal b/yesod-websockets/yesod-websockets.cabal index e4884bd9..6747a04e 100644 --- a/yesod-websockets/yesod-websockets.cabal +++ b/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