diff --git a/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs b/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs index bd407ed6..42d61d58 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs @@ -17,7 +17,6 @@ module Servant.Client.Core.Internal.HasClient where import Prelude () import Prelude.Compat -import Control.Monad.Error.Class (throwError) import Data.Foldable (toList) import Data.List (foldl') import Data.Proxy (Proxy (Proxy)) @@ -225,7 +224,7 @@ instance OVERLAPPING_ , requestAccept = fromList $ toList accept } case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of - Left err -> throwError $ DecodeFailure (pack err) response + Left err -> throwServantError $ DecodeFailure (pack err) response Right val -> return $ Headers { getResponse = val , getHeadersHList = buildHeadersTo . toList $ responseHeaders response diff --git a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs index af204f01..458219b9 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs @@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} @@ -13,6 +13,7 @@ module Servant.Client.Core.Internal.Request where import Prelude () import Prelude.Compat +import Control.Monad.Catch (Exception) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LBS import Data.Semigroup ((<>)) @@ -44,6 +45,8 @@ data ServantError = | ConnectionError Text deriving (Eq, Show, Generic, Typeable) +instance Exception ServantError + data RequestF a = Request { requestPath :: a , requestQueryString :: Seq.Seq QueryItem diff --git a/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs b/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs index a441a8b8..564cbb39 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs @@ -6,11 +6,10 @@ -- | Types for possible backends to run client-side `Request` queries module Servant.Client.Core.Internal.RunClient where -import Prelude.Compat import Prelude () +import Prelude.Compat import Control.Monad (unless) -import Control.Monad.Error.Class (MonadError, throwError) import Data.Foldable (toList) import Data.Proxy (Proxy) import qualified Data.Text as T @@ -22,16 +21,18 @@ import Servant.API (MimeUnrender, import Servant.Client.Core.Internal.Request (Request, Response (..), ServantError (..)) -class (MonadError ServantError m) => RunClient m where +class (Monad m) => RunClient m where -- | How to make a request. runRequest :: Request -> m Response + throwServantError :: ServantError -> m a + catchServantError :: m a -> (ServantError -> m a) -> m a checkContentTypeHeader :: RunClient m => Response -> m MediaType checkContentTypeHeader response = case lookup "Content-Type" $ toList $ responseHeaders response of Nothing -> return $ "application"//"octet-stream" Just t -> case parseAccept t of - Nothing -> throwError $ InvalidContentTypeHeader response + Nothing -> throwServantError $ InvalidContentTypeHeader response Just t' -> return t' decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m) @@ -39,9 +40,9 @@ decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m) decodedAs response contentType = do responseContentType <- checkContentTypeHeader response unless (any (matches responseContentType) accept) $ - throwError $ UnsupportedContentType responseContentType response + throwServantError $ UnsupportedContentType responseContentType response case mimeUnrender contentType $ responseBody response of - Left err -> throwError $ DecodeFailure (T.pack err) response + Left err -> throwServantError $ DecodeFailure (T.pack err) response Right val -> return val where accept = toList $ contentTypes contentType diff --git a/servant-client/src/Servant/Client/Internal/HttpClient.hs b/servant-client/src/Servant/Client/Internal/HttpClient.hs index 5595c039..e61b29e3 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient.hs @@ -88,6 +88,8 @@ instance Alt ClientM where instance RunClient ClientM where runRequest = performRequest + throwServantError = throwError + catchServantError = catchError instance ClientLike (ClientM a) (ClientM a) where mkClient = id