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 WebSocketsT
, webSockets , webSockets
, receiveData , receiveData
, receiveDataX , receiveDataE
, sendPing , sendPing
, sendPingX , sendPingE
, sendClose , sendClose
, sendCloseX , sendCloseE
, sendTextData , sendTextData
, sendTextDataX , sendTextDataE
, sendBinaryData , sendBinaryData
, sendBinaryDataX , sendBinaryDataE
-- * Conduit API -- * Conduit API
, sourceWS , sourceWS
, sinkWSText , sinkWSText
@ -33,12 +33,14 @@ import Control.Monad.IO.Class (MonadIO (liftIO))
import Control.Monad.Trans.Control (control) import Control.Monad.Trans.Control (control)
import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith, restoreM)) import Control.Monad.Trans.Control (MonadBaseControl (liftBaseWith, restoreM))
import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT)) import Control.Monad.Trans.Reader (ReaderT (ReaderT, runReaderT))
import Data.Either
import qualified Data.Conduit as C import qualified Data.Conduit as C
import qualified Data.Conduit.List as CL 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 import Control.Exception (SomeException)
import Control.Exception.Enclosed (tryAny)
-- | A transformer for a WebSockets handler. -- | A transformer for a WebSockets handler.
-- --
@ -70,6 +72,13 @@ webSockets inner = do
src src
sink 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. -- | Receive a piece of data from the client.
-- --
-- Since 0.1.0 -- Since 0.1.0
@ -77,59 +86,60 @@ 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. -- | 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 -- Since 0.1.1.3
receiveDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m a receiveDataE :: (MonadIO m, WS.WebSocketsData a) => WebSocketsT m (Either SomeException a)
receiveDataX ex d = ReaderT $ \c -> liftIO $ (WS.receiveData c) `E.catch` (\(_ :: E.SomeException) -> ex >> return d) receiveDataE = ReaderT $ liftIO . tryAny . WS.receiveData
-- | 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 = wrapWS WS.sendTextData
-- | Send a textual message to the client. -- | 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 -- Since 0.1.1.3
sendTextDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m () sendTextDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendTextDataX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendTextData x $ c) `E.catch` (\(_ :: E.SomeException) -> ex) sendTextDataE = wrapWS WS.sendTextData
-- | 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 = wrapWS WS.sendBinaryData
-- | Send a binary message to the client. -- | 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 -- Since 0.1.1.3
sendBinaryDataX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m () sendBinaryDataE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendBinaryDataX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendBinaryData x $ c) `E.catch` (\(_ :: E.SomeException) -> ex) sendBinaryDataE = wrapWSE WS.sendBinaryData
-- | Send a ping message to the client. -- | Send a ping message to the client.
-- --
-- Since 0.1.1.3 -- Since 0.1.1.3
sendPing :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () 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. -- | 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 -- Since 0.1.1.3
sendPingX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m () sendPingE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendPingX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendPing x $ c) `E.catch` (\(_ :: E.SomeException) -> ex) sendPingE = wrapWSE WS.sendPing
-- | Send a close request to the client. -- | Send a close request to the client.
-- --
-- Since 0.1.1.3 -- Since 0.1.1.3
sendClose :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m () 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. -- | 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 -- Since 0.1.1.3
sendCloseX :: (MonadIO m, WS.WebSocketsData a) => IO () -> a -> WebSocketsT m () sendCloseE :: (MonadIO m, WS.WebSocketsData a) => a -> WebSocketsT m (Either SomeException ())
sendCloseX ex x = ReaderT $ \c -> liftIO $ (flip WS.sendClose x $ c) `E.catch` (\(_ :: E.SomeException) -> ex) sendCloseE = wrapWSE WS.sendClose
-- | A @Source@ of WebSockets data from the user. -- | A @Source@ of WebSockets data from the user.
-- --