diff --git a/src/Haboli/Euphoria/Client.hs b/src/Haboli/Euphoria/Client.hs index a442170..0cade01 100644 --- a/src/Haboli/Euphoria/Client.hs +++ b/src/Haboli/Euphoria/Client.hs @@ -21,6 +21,7 @@ module Haboli.Euphoria.Client -- ** Exception handling , ClientException(..) , Haboli.Euphoria.Client.throw + , Haboli.Euphoria.Client.catch -- ** Euphoria commands -- *** Session commands , pingReply @@ -111,8 +112,8 @@ data ClientInfo e = ClientInfo } -- This type declaration feels lispy in its parenthesisness -newtype Client e a = Client (ReaderT (ClientInfo e) - (ExceptT (ClientException e) +newtype Client e a = Client (ExceptT (ClientException e) + (ReaderT (ClientInfo e) IO) a) deriving (Functor, Applicative, Monad, MonadIO) @@ -208,7 +209,7 @@ runClient details (Client stack) wsThreadFinished <- newEmptyMVar void $ forkFinally (runWebsocketThread info) (\_ -> putMVar wsThreadFinished ()) -- Run the actual 'Client' in this thread - result <- runExceptT $ runReaderT stack info + result <- runReaderT (runExceptT stack) info -- Close the connection if it is not already closed, and wait until the -- websocket thread stops handle ignoreAllExceptions $ WS.sendClose connection $ T.pack "Goodbye :D" @@ -221,10 +222,10 @@ runClient details (Client stack) {- Private operations -} throwRaw :: ClientException e -> Client e a -throwRaw e = Client $ lift $ throwE e +throwRaw = Client . throwE getClientInfo :: Client e (ClientInfo e) -getClientInfo = Client ask +getClientInfo = Client $ lift ask newPacketId :: Client e T.Text newPacketId = do @@ -328,6 +329,11 @@ respondingToPing holdingEvent = do throw :: e -> Client e a throw = throwRaw . CustomException +catch :: Client e a -> (ClientException e -> Client e a) -> Client e a +catch c f = Client $ catchE (unclient c) (unclient . f) + where + unclient (Client m) = m + {- Euphoria commands -} {- Session commands -}