Use own throw/catch

This commit is contained in:
Julian K. Arni 2017-09-15 14:57:03 -04:00
parent 49d5067e22
commit 1a67d93c60
4 changed files with 14 additions and 9 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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