{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE StrictData         #-}
module Network.MessagePack.Types.Error
  ( RpcError (..)
  , ServerError (..)
  ) where

import           Control.Exception (Exception)
import           Data.MessagePack  (Object)
import           Data.Text         (Text)
import           Data.Typeable     (Typeable)


-- | RPC error type
data RpcError
  = RemoteError Object          -- ^ Server error
  | ResultTypeError Text Object -- ^ Result type mismatch
  | ProtocolError Text          -- ^ Protocol error
  deriving (Int -> RpcError -> ShowS
[RpcError] -> ShowS
RpcError -> String
(Int -> RpcError -> ShowS)
-> (RpcError -> String) -> ([RpcError] -> ShowS) -> Show RpcError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RpcError] -> ShowS
$cshowList :: [RpcError] -> ShowS
show :: RpcError -> String
$cshow :: RpcError -> String
showsPrec :: Int -> RpcError -> ShowS
$cshowsPrec :: Int -> RpcError -> ShowS
Show, RpcError -> RpcError -> Bool
(RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> Bool) -> Eq RpcError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RpcError -> RpcError -> Bool
$c/= :: RpcError -> RpcError -> Bool
== :: RpcError -> RpcError -> Bool
$c== :: RpcError -> RpcError -> Bool
Eq, Eq RpcError
Eq RpcError
-> (RpcError -> RpcError -> Ordering)
-> (RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> Bool)
-> (RpcError -> RpcError -> RpcError)
-> (RpcError -> RpcError -> RpcError)
-> Ord RpcError
RpcError -> RpcError -> Bool
RpcError -> RpcError -> Ordering
RpcError -> RpcError -> RpcError
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: RpcError -> RpcError -> RpcError
$cmin :: RpcError -> RpcError -> RpcError
max :: RpcError -> RpcError -> RpcError
$cmax :: RpcError -> RpcError -> RpcError
>= :: RpcError -> RpcError -> Bool
$c>= :: RpcError -> RpcError -> Bool
> :: RpcError -> RpcError -> Bool
$c> :: RpcError -> RpcError -> Bool
<= :: RpcError -> RpcError -> Bool
$c<= :: RpcError -> RpcError -> Bool
< :: RpcError -> RpcError -> Bool
$c< :: RpcError -> RpcError -> Bool
compare :: RpcError -> RpcError -> Ordering
$ccompare :: RpcError -> RpcError -> Ordering
$cp1Ord :: Eq RpcError
Ord, Typeable)

instance Exception RpcError


newtype ServerError = ServerError Text
  deriving (Int -> ServerError -> ShowS
[ServerError] -> ShowS
ServerError -> String
(Int -> ServerError -> ShowS)
-> (ServerError -> String)
-> ([ServerError] -> ShowS)
-> Show ServerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerError] -> ShowS
$cshowList :: [ServerError] -> ShowS
show :: ServerError -> String
$cshow :: ServerError -> String
showsPrec :: Int -> ServerError -> ShowS
$cshowsPrec :: Int -> ServerError -> ShowS
Show, Typeable)

instance Exception ServerError