{-# LANGUAGE DeriveDataTypeable #-}
-------------------------------------------------------------------------------
-- |
-- Module     : Network/Mom/Stompl/Client/Exception.hs
-- Copyright  : (c) Tobias Schoofs
-- License    : LGPL 
-- Stability  : experimental
-- Portability: portable
--
-- Exceptions for the Stompl Client.
-- Note that exceptions thrown in internal worker threads
-- (sender and listener) will be forwarded to the connection owner,
-- that is the thread that actually initialised the connection.
-- Since, in some circumstances, several exceptions may be thrown
-- in response to one error event (/e.g./ the broker sends an error frame
-- and, immediately afterwards, closes the connection),
-- the connection owner should implement a robust exception handling mechanism.
-------------------------------------------------------------------------------
module Network.Mom.Stompl.Client.Exception (
                          StomplException(..), try, convertError)
where

  import Control.Exception hiding (try)
  import Control.Applicative ((<$>))
  import Data.Typeable (Typeable)

  ------------------------------------------------------------------------
  -- The Stompl Exception
  ------------------------------------------------------------------------
  data StomplException =
                       -- | Currently not used
                       SocketException   String
                       -- | Thrown
                       --   when a worker thread terminates
                       --   unexpectedly;
                       --   usually, this is a consequence 
                       --   of another error (/e.g./ the broker
                       --   closed the socket) and you will
                       --   probably receive another exception
                       --   (/e.g./ a BrokerException)
                       | WorkerException String
                       -- | Thrown when something 
                       --   against the protocol happens, /e.g./
                       --   an unexpected frame is received
                       --   or a message from a queue
                       --   that was not subscribed
                       | ProtocolException String
                       -- | Thrown on wrong uses of queues, /e.g./
                       --   use of a queue outside its scope
                       | QueueException    String
                       -- | Thrown on transaction errors, /e.g./
                       --   pending acks
                       | TxException       String
                       -- | Thrown on connection errors, /e.g./
                       --   connection was closed
                       | ConnectException  String
                       -- | Should be thrown 
                       --   by user-defined converters
                       | ConvertException  String
                       -- | Thrown when an error frame is received
                       | BrokerException   String
                       -- | Thrown by /abort/
                       | AppException      String
                       -- | You hit a bug!
                       --   This exception is only thrown
                       --   when something really strange happened
                       | OuchException     String
    deriving (Int -> StomplException -> ShowS
[StomplException] -> ShowS
StomplException -> String
(Int -> StomplException -> ShowS)
-> (StomplException -> String)
-> ([StomplException] -> ShowS)
-> Show StomplException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StomplException] -> ShowS
$cshowList :: [StomplException] -> ShowS
show :: StomplException -> String
$cshow :: StomplException -> String
showsPrec :: Int -> StomplException -> ShowS
$cshowsPrec :: Int -> StomplException -> ShowS
Show, ReadPrec [StomplException]
ReadPrec StomplException
Int -> ReadS StomplException
ReadS [StomplException]
(Int -> ReadS StomplException)
-> ReadS [StomplException]
-> ReadPrec StomplException
-> ReadPrec [StomplException]
-> Read StomplException
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StomplException]
$creadListPrec :: ReadPrec [StomplException]
readPrec :: ReadPrec StomplException
$creadPrec :: ReadPrec StomplException
readList :: ReadS [StomplException]
$creadList :: ReadS [StomplException]
readsPrec :: Int -> ReadS StomplException
$creadsPrec :: Int -> ReadS StomplException
Read, Typeable, StomplException -> StomplException -> Bool
(StomplException -> StomplException -> Bool)
-> (StomplException -> StomplException -> Bool)
-> Eq StomplException
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StomplException -> StomplException -> Bool
$c/= :: StomplException -> StomplException -> Bool
== :: StomplException -> StomplException -> Bool
$c== :: StomplException -> StomplException -> Bool
Eq)

  instance Exception StomplException

  ------------------------------------------------------------------------
  -- | Catches any 'StomplException',
  --   including asynchronous exceptions coming from internal threads
  ------------------------------------------------------------------------
  try :: IO a -> IO (Either StomplException a)
  try :: IO a -> IO (Either StomplException a)
try IO a
act = (a -> Either StomplException a
forall a b. b -> Either a b
Right (a -> Either StomplException a)
-> IO a -> IO (Either StomplException a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
act) IO (Either StomplException a)
-> (StomplException -> IO (Either StomplException a))
-> IO (Either StomplException a)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Either StomplException a -> IO (Either StomplException a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StomplException a -> IO (Either StomplException a))
-> (StomplException -> Either StomplException a)
-> StomplException
-> IO (Either StomplException a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StomplException -> Either StomplException a
forall a b. a -> Either a b
Left)

  ------------------------------------------------------------------------
  -- | Throws 'ConvertException'
  --   to signal a conversion error.
  ------------------------------------------------------------------------
  convertError :: String -> IO a
  convertError :: String -> IO a
convertError String
e = StomplException -> IO a
forall e a. Exception e => e -> IO a
throwIO (StomplException -> IO a) -> StomplException -> IO a
forall a b. (a -> b) -> a -> b
$ String -> StomplException
ConvertException String
e