Garmelon/haboli
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Clear up confusion around 'handle'

Browse source
This commit is contained in:
Joscha 2020-01-07 16:15:43 +00:00
parent 604cb4b09b
commit e30a08e967
1 changed files with 11 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

22
src/Haboli/Euphoria/Client.hs
View file

@ -18,9 +18,9 @@ module Haboli.Euphoria.Client
, respondingToPing , respondingToPing
-- ** Exception handling -- ** Exception handling
, ClientException(..) , ClientException(..)
, Haboli.Euphoria.Client.throw , throw
, Haboli.Euphoria.Client.catch , catch
, Haboli.Euphoria.Client.handle , handle
-- ** Threading -- ** Threading
, Thread , Thread
, fork , fork
@ -38,7 +38,7 @@ module Haboli.Euphoria.Client
import Control.Applicative import Control.Applicative
import Control.Concurrent import Control.Concurrent
import Control.Concurrent.STM import Control.Concurrent.STM
import Control.Exception import qualified Control.Exception as E
import Control.Monad import Control.Monad
import Control.Monad.IO.Class import Control.Monad.IO.Class
import Control.Monad.Trans.Class import Control.Monad.Trans.Class
@ -98,7 +98,7 @@ newtype Client e a = Client (ExceptT (ClientException e)
-- 'WS.ConnectionException's in the process. -- 'WS.ConnectionException's in the process.
safelyCloseConnection :: WS.Connection -> IO () safelyCloseConnection :: WS.Connection -> IO ()
safelyCloseConnection connection = safelyCloseConnection connection =
Control.Exception.handle ignoreAllExceptions $ E.handle ignoreAllExceptions $
WS.sendClose connection $ T.pack "Goodbye :D" WS.sendClose connection $ T.pack "Goodbye :D"
where where
ignoreAllExceptions :: WS.ConnectionException -> IO () ignoreAllExceptions :: WS.ConnectionException -> IO ()
@ -111,7 +111,7 @@ closeConnectionOnInvalidMessage connection (WS.ParseException _) =
safelyCloseConnection connection safelyCloseConnection connection
closeConnectionOnInvalidMessage connection (WS.UnicodeException _) = closeConnectionOnInvalidMessage connection (WS.UnicodeException _) =
safelyCloseConnection connection safelyCloseConnection connection
closeConnectionOnInvalidMessage _ e = throwIO e closeConnectionOnInvalidMessage _ e = E.throwIO e
-- | An exception handler that stops the client if any sort of -- | An exception handler that stops the client if any sort of
-- 'WS.ConnectionException' occurs. It does this by setting 'ciStopped' to True -- 'WS.ConnectionException' occurs. It does this by setting 'ciStopped' to True
@ -150,11 +150,11 @@ runWebsocketThread :: ClientInfo e -> IO ()
runWebsocketThread info = runWebsocketThread info =
WS.withPingThread connection pingInterval (pure ()) $ WS.withPingThread connection pingInterval (pure ()) $
-- Stop the client and cancel all replies before this thread finishes -- Stop the client and cancel all replies before this thread finishes
Control.Exception.handle (cancelAllReplies info) $ E.handle (cancelAllReplies info) $
forever $ forever $
-- If the client receives an invalidly formatted message, be careful and just -- If the client receives an invalidly formatted message, be careful and just
-- disconnect because something went really wrong -- disconnect because something went really wrong
Control.Exception.handle (closeConnectionOnInvalidMessage connection) $ do E.handle (closeConnectionOnInvalidMessage connection) $ do
msg <- WS.receiveData connection msg <- WS.receiveData connection
case decode msg of case decode msg of
-- If the client receives invalid JSON, also disconnect for the same reason -- If the client receives invalid JSON, also disconnect for the same reason
@ -312,7 +312,7 @@ data ClientException e
-- ^ The websocket connection underlying the 'Client' was closed. -- ^ The websocket connection underlying the 'Client' was closed.
| DecodeException T.Text | DecodeException T.Text
-- ^ At some point during decoding a websocket packet, something went wrong. -- ^ At some point during decoding a websocket packet, something went wrong.
| UnexpectedException SomeException | UnexpectedException E.SomeException
-- ^ While a forked thread was executed, an unexpected exception was thrown in -- ^ While a forked thread was executed, an unexpected exception was thrown in
-- the IO monad. -- the IO monad.
| CustomException e | CustomException e
@ -335,7 +335,7 @@ catch c f = Client $ catchE (unclient c) (unclient . f)
unclient (Client m) = m unclient (Client m) = m
-- | A version of 'catch' with its arguments flipped. It is named after -- | A version of 'catch' with its arguments flipped. It is named after
-- 'Control.Exception.handle'. -- 'E.handle'.
handle :: (ClientException e -> Client e a) -> Client e a -> Client e a handle :: (ClientException e -> Client e a) -> Client e a -> Client e a
handle = flip Haboli.Euphoria.Client.catch handle = flip Haboli.Euphoria.Client.catch
@ -408,7 +408,7 @@ newPacketId = do
safeSend :: ToJSON a => WS.Connection -> a -> Client e () safeSend :: ToJSON a => WS.Connection -> a -> Client e ()
safeSend connection packet = do safeSend connection packet = do
result <- liftIO result <- liftIO
$ Control.Exception.handle convertToException $ E.handle convertToException
$ Nothing <$ WS.sendTextData connection (encode packet) $ Nothing <$ WS.sendTextData connection (encode packet)
case result of case result of
Nothing -> pure () Nothing -> pure ()