{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Servant.Exception
( Throws,
ToServantErr (..),
ServantException,
toServantException,
fromServantException,
Exception (..),
mapException
)
where
import Control.Monad.Catch (Exception (..), MonadCatch, SomeException, catch, throwM)
import Data.Aeson (ToJSON (..), encode, object, (.=))
import Data.Kind (Type)
import Data.String (fromString)
import Data.Text (Text)
import Data.Typeable (Typeable, cast, typeOf)
import Network.HTTP.Types (Header, Status (..))
import Servant.API.ContentTypes (JSON, MimeRender (..), PlainText)
data Throws (e :: Type)
class (Typeable e, Show e) => ToServantErr e where
status :: e -> Status
message :: e -> Text
message = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (e -> String) -> e -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> String
forall a. Show a => a -> String
show
:: e -> [Header]
headers e
_ = []
data ServantException = forall e. (Exception e, ToJSON e, ToServantErr e) => ServantException e
deriving (Typeable)
instance Show ServantException where
show :: ServantException -> String
show (ServantException e
e) = e -> String
forall a. Show a => a -> String
show e
e
instance Exception ServantException
instance MimeRender JSON ServantException where
mimeRender :: Proxy JSON -> ServantException -> ByteString
mimeRender Proxy JSON
_ (ServantException e
e) =
Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode (Value -> ByteString) -> Value -> ByteString
forall a b. (a -> b) -> a -> b
$
[Pair] -> Value
object
[ Text
"type" Text -> String -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= String
errorType,
Text
"message" Text -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= e -> Text
forall e. ToServantErr e => e -> Text
message e
e,
Text
"error" Text -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= e -> Value
forall a. ToJSON a => a -> Value
toJSON e
e
]
where
errorType :: String
errorType = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ e -> TypeRep
forall a. Typeable a => a -> TypeRep
typeOf e
e
instance MimeRender PlainText ServantException where
mimeRender :: Proxy PlainText -> ServantException -> ByteString
mimeRender Proxy PlainText
ct = Proxy PlainText -> String -> ByteString
forall k (ctype :: k) a.
MimeRender ctype a =>
Proxy ctype -> a -> ByteString
mimeRender Proxy PlainText
ct (String -> ByteString)
-> (ServantException -> String) -> ServantException -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServantException -> String
forall e. Exception e => e -> String
displayException
instance ToServantErr ServantException where
status :: ServantException -> Status
status (ServantException e
e) = e -> Status
forall e. ToServantErr e => e -> Status
status e
e
message :: ServantException -> Text
message (ServantException e
e) = e -> Text
forall e. ToServantErr e => e -> Text
message e
e
toServantException :: (Exception e, ToJSON e, ToServantErr e) => e -> SomeException
toServantException :: e -> SomeException
toServantException = ServantException -> SomeException
forall e. Exception e => e -> SomeException
toException (ServantException -> SomeException)
-> (e -> ServantException) -> e -> SomeException
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> ServantException
forall e.
(Exception e, ToJSON e, ToServantErr e) =>
e -> ServantException
ServantException
fromServantException :: Exception e => SomeException -> Maybe e
fromServantException :: SomeException -> Maybe e
fromServantException SomeException
x = SomeException -> Maybe ServantException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
x Maybe ServantException -> (ServantException -> Maybe e) -> Maybe e
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(ServantException e
e) -> e -> Maybe e
forall a b. (Typeable a, Typeable b) => a -> Maybe b
cast e
e
mapException :: (Exception e1, Exception e2, MonadCatch m) => (e1 -> e2) -> m a -> m a
mapException :: (e1 -> e2) -> m a -> m a
mapException e1 -> e2
f m a
a = m a
a m a -> (e1 -> m a) -> m a
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` (e2 -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (e2 -> m a) -> (e1 -> e2) -> e1 -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f)