git.iko.soy/typeable/servant
on master help sign in
Use own throw/catch
commit1a67d93c609555e97299d947b18b7b8f25a9259e authorJulian K. Arni <jkarni@gmail.com> dateFri 15 Sep 2017, 14:57 (9 years ago) parent49d5067
4 files changed+14−9
compare with master
unifiedsplit
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+1−2 servant-client-core/src/Servant/Client/Core/Internal/Request.hs+4−1 servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs+7−6 servant-client/src/Servant/Client/Internal/HttpClient.hs+2
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+1−2
@@ -17,7 +17,6 @@ module Servant.Client.Core.Internal.HasClient where
1717import Prelude ()
1818import Prelude.Compat
1919
20−import Control.Monad.Error.Class (throwError)
2120import Data.Foldable (toList)
2221import Data.List (foldl')
2322import Data.Proxy (Proxy (Proxy))
@@ -225,7 +224,7 @@ instance OVERLAPPING_
225224 , requestAccept = fromList $ toList accept
226225 }
227226 case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of
228− Left err -> throwError $ DecodeFailure (pack err) response
227+ Left err -> throwServantError $ DecodeFailure (pack err) response
229228 Right val -> return $ Headers
230229 { getResponse = val
231230 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
servant-client-core/src/Servant/Client/Core/Internal/Request.hs+4−1
@@ -1,7 +1,7 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveGeneric #-}
43{-# LANGUAGE DeriveFunctor #-}
4+{-# LANGUAGE DeriveGeneric #-}
55{-# LANGUAGE GeneralizedNewtypeDeriving #-}
66{-# LANGUAGE MultiParamTypeClasses #-}
77{-# LANGUAGE OverloadedStrings #-}
@@ -13,6 +13,7 @@ module Servant.Client.Core.Internal.Request where
1313import Prelude ()
1414import Prelude.Compat
1515
16+import Control.Monad.Catch (Exception)
1617import qualified Data.ByteString.Builder as Builder
1718import qualified Data.ByteString.Lazy as LBS
1819import Data.Semigroup ((<>))
@@ -44,6 +45,8 @@ data ServantError =
4445 | ConnectionError Text
4546 deriving (Eq, Show, Generic, Typeable)
4647
48+instance Exception ServantError
49+
4750data RequestF a = Request
4851 { requestPath :: a
4952 , requestQueryString :: Seq.Seq QueryItem
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs+7−6
@@ -6,11 +6,10 @@
66-- | Types for possible backends to run client-side `Request` queries
77module Servant.Client.Core.Internal.RunClient where
88
9−import Prelude.Compat
109import Prelude ()
10+import Prelude.Compat
1111
1212import Control.Monad (unless)
13−import Control.Monad.Error.Class (MonadError, throwError)
1413import Data.Foldable (toList)
1514import Data.Proxy (Proxy)
1615import qualified Data.Text as T
@@ -22,16 +21,18 @@ import Servant.API (MimeUnrender,
2221import Servant.Client.Core.Internal.Request (Request, Response (..),
2322 ServantError (..))
2423
25−class (MonadError ServantError m) => RunClient m where
24+class (Monad m) => RunClient m where
2625 -- | How to make a request.
2726 runRequest :: Request -> m Response
27+ throwServantError :: ServantError -> m a
28+ catchServantError :: m a -> (ServantError -> m a) -> m a
2829
2930checkContentTypeHeader :: RunClient m => Response -> m MediaType
3031checkContentTypeHeader response =
3132 case lookup "Content-Type" $ toList $ responseHeaders response of
3233 Nothing -> return $ "application"//"octet-stream"
3334 Just t -> case parseAccept t of
34− Nothing -> throwError $ InvalidContentTypeHeader response
35+ Nothing -> throwServantError $ InvalidContentTypeHeader response
3536 Just t' -> return t'
3637
3738decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
@@ -39,9 +40,9 @@ decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
3940decodedAs response contentType = do
4041 responseContentType <- checkContentTypeHeader response
4142 unless (any (matches responseContentType) accept) $
42− throwError $ UnsupportedContentType responseContentType response
43+ throwServantError $ UnsupportedContentType responseContentType response
4344 case mimeUnrender contentType $ responseBody response of
44− Left err -> throwError $ DecodeFailure (T.pack err) response
45+ Left err -> throwServantError $ DecodeFailure (T.pack err) response
4546 Right val -> return val
4647 where
4748 accept = toList $ contentTypes contentType
servant-client/src/Servant/Client/Internal/HttpClient.hs+2
@@ -88,6 +88,8 @@ instance Alt ClientM where
8888
8989instance RunClient ClientM where
9090 runRequest = performRequest
91+ throwServantError = throwError
92+ catchServantError = catchError
9193
9294instance ClientLike (ClientM a) (ClientM a) where
9395 mkClient = id