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

Rewrite to Either SomeException a

Browse Source 
Rewrite to use suggested `enclosed-exceptions` package and `Either` pattern for capturing exceptions
This commit is contained in:
tolysz 2014-07-14 15:02:32 +01:00
parent 038c94d1cf
commit 89cd52ad10
1 changed files with 36 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -7,15 +7,15 @@ module Yesod.WebSockets
WebSocketsT
, webSockets
, receiveData
, receiveDataX
, receiveDataE
, sendPing
, sendPingX
, sendPingE
, sendClose
, sendCloseX
, sendCloseE
, sendTextData
, sendTextDataX
, sendTextDataE
, sendBinaryData
, sendBinaryDataX
, sendBinaryDataE
-- * Conduit API
, sourceWS
, sinkWSText
@ -33,12 +33,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 qualified Control.Exception as E
import Control.Exception (SomeException)
import Control.Exception.Enclosed (tryAny)
-- | A transformer for a WebSockets handler.
--
@ -70,6 +72,13 @@ webSockets inner = do
src
sink
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
@ -77,59 +86,60 @@ receiveData :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m a
receiveData = ReaderT $ liftIO . WS.receiveData
-- | Receive a piece of data from the client.
-- Execute IO () action on WebSocket Exception
-- Capture SomeException as the result or operation
-- 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)
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.
-- Execute IO () action on WebSocket Exception
-- Capture SomeException as the result or operation
-- and can be used like
-- `either handle_exception return =<< sendTextDataE ("Welcome" :: Text)`
-- 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)
sendTextDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendTextDataE = wrapWS 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.
-- Execute IO () action on WebSocket Exception
-- Capture SomeException as the result or operation
-- Since 0.1.1.3
sendBinaryDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m ()
sendBinaryDataX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendBinaryData x $ c) `E.catch` (\(_ :: E.SomeException) -> ex)
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 x = ReaderT $ liftIO . flip WS.sendPing x
sendPing = wrapWS WS.sendPing
-- | Send a ping message to the client.
-- Execute IO () action on WebSocket Exception
-- Capture SomeException as the result of operation
-- 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)
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 x = ReaderT $ liftIO . flip WS.sendClose x
sendClose = wrapWS WS.sendClose
-- | Send a close request to the client.
-- Execute IO () action on WebSocket Exception
-- Capture SomeException as the result of operation
-- 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)
sendCloseE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendCloseE = wrapWSE WS.sendClose
-- | A @Source@ of WebSockets data from the user.
--