-- |Exceptions for RPC calls

{-# LANGUAGE ExistentialQuantification #-}
module Network.ONCRPC.Exception
  ( RPCException(..)
  , rpcExceptionToException
  , rpcExceptionFromException
  ) where

import           Control.Exception (Exception(..), SomeException)
import           Data.Typeable (Typeable, cast)

data RPCException = forall e . Exception e => RPCException e
  deriving (Typeable)

instance Show RPCException where
  showsPrec :: Int -> RPCException -> ShowS
showsPrec Int
p (RPCException e
e) = forall a. Show a => Int -> a -> ShowS
showsPrec Int
p e
e

instance Exception RPCException

rpcExceptionToException :: Exception e => e -> SomeException
rpcExceptionToException :: forall e. Exception e => e -> SomeException
rpcExceptionToException = forall e. Exception e => e -> SomeException
toException forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. Exception e => e -> RPCException
RPCException

rpcExceptionFromException :: Exception e => SomeException -> Maybe e
rpcExceptionFromException :: forall e. Exception e => SomeException -> Maybe e
rpcExceptionFromException SomeException
x = do
  RPCException e
a <- forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x
  forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
a