1a67d93 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Use own throw/catch

1a67d93Julian K. Arni9 years ago

servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+1−2

compare with master

unifiedsplit

@@ -17,7 +17,6 @@ module Servant.Client.Core.Internal.HasClient where

17import Prelude ()

18import Prelude.Compat

20−import Control.Monad.Error.Class (throwError)

21import Data.Foldable (toList)

20import Data.Foldable (toList)

22import Data.List (foldl')

21import Data.List (foldl')

23import Data.Proxy (Proxy (Proxy))

22import Data.Proxy (Proxy (Proxy))

@@ -225,7 +224,7 @@ instance OVERLAPPING_

225 , requestAccept = fromList $ toList accept

224 , requestAccept = fromList $ toList accept

226 }

225 }

227 case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of

226 case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of

228− Left err -> throwError $ DecodeFailure (pack err) response

227+ Left err -> throwServantError $ DecodeFailure (pack err) response

229 Right val -> return $ Headers

228 Right val -> return $ Headers

230 { getResponse = val

229 { getResponse = val

231 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

230 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response

servant-client-core/src/Servant/Client/Core/Internal/Request.hs+4−1

@@ -1,7 +1,7 @@

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3−{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE DeriveFunctor #-}

3{-# LANGUAGE DeriveFunctor #-}

4+{-# LANGUAGE DeriveGeneric #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE OverloadedStrings #-}

@@ -13,6 +13,7 @@ module Servant.Client.Core.Internal.Request where

13import Prelude ()

14import Prelude.Compat

16+import Control.Monad.Catch (Exception)

16import qualified Data.ByteString.Builder as Builder

17import qualified Data.ByteString.Builder as Builder

17import qualified Data.ByteString.Lazy as LBS

18import qualified Data.ByteString.Lazy as LBS

18import Data.Semigroup ((<>))

19import Data.Semigroup ((<>))

@@ -44,6 +45,8 @@ data ServantError =

44 | ConnectionError Text

45 | ConnectionError Text

45 deriving (Eq, Show, Generic, Typeable)

46 deriving (Eq, Show, Generic, Typeable)

48+instance Exception ServantError

49+

47data RequestF a = Request

50data RequestF a = Request

48 { requestPath :: a

51 { requestPath :: a

49 , requestQueryString :: Seq.Seq QueryItem

52 , requestQueryString :: Seq.Seq QueryItem

servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs+7−6

@@ -6,11 +6,10 @@

6-- | Types for possible backends to run client-side `Request` queries

7module Servant.Client.Core.Internal.RunClient where

9−import Prelude.Compat

10import Prelude ()

9import Prelude ()

10+import Prelude.Compat

12import Control.Monad (unless)

13−import Control.Monad.Error.Class (MonadError, throwError)

14import Data.Foldable (toList)

13import Data.Foldable (toList)

15import Data.Proxy (Proxy)

14import Data.Proxy (Proxy)

16import qualified Data.Text as T

15import qualified Data.Text as T

@@ -22,16 +21,18 @@ import Servant.API (MimeUnrender,

22import Servant.Client.Core.Internal.Request (Request, Response (..),

21import Servant.Client.Core.Internal.Request (Request, Response (..),

23 ServantError (..))

22 ServantError (..))

25−class (MonadError ServantError m) => RunClient m where

24+class (Monad m) => RunClient m where

26 -- | How to make a request.

25 -- | How to make a request.

27 runRequest :: Request -> m Response

26 runRequest :: Request -> m Response

27+ throwServantError :: ServantError -> m a

28+ catchServantError :: m a -> (ServantError -> m a) -> m a

29checkContentTypeHeader :: RunClient m => Response -> m MediaType

30checkContentTypeHeader :: RunClient m => Response -> m MediaType

30checkContentTypeHeader response =

31checkContentTypeHeader response =

31 case lookup "Content-Type" $ toList $ responseHeaders response of

32 case lookup "Content-Type" $ toList $ responseHeaders response of

32 Nothing -> return $ "application"//"octet-stream"

33 Nothing -> return $ "application"//"octet-stream"

33 Just t -> case parseAccept t of

34 Just t -> case parseAccept t of

34− Nothing -> throwError $ InvalidContentTypeHeader response

35+ Nothing -> throwServantError $ InvalidContentTypeHeader response

35 Just t' -> return t'

36 Just t' -> return t'

37decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)

38decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)

@@ -39,9 +40,9 @@ decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)

39decodedAs response contentType = do

40decodedAs response contentType = do

40 responseContentType <- checkContentTypeHeader response

41 responseContentType <- checkContentTypeHeader response

41 unless (any (matches responseContentType) accept) $

42 unless (any (matches responseContentType) accept) $

42− throwError $ UnsupportedContentType responseContentType response

43+ throwServantError $ UnsupportedContentType responseContentType response

43 case mimeUnrender contentType $ responseBody response of

44 case mimeUnrender contentType $ responseBody response of

44− Left err -> throwError $ DecodeFailure (T.pack err) response

45+ Left err -> throwServantError $ DecodeFailure (T.pack err) response

45 Right val -> return val

46 Right val -> return val

46 where

47 where

47 accept = toList $ contentTypes contentType

48 accept = toList $ contentTypes contentType

servant-client/src/Servant/Client/Internal/HttpClient.hs+2

@@ -88,6 +88,8 @@ instance Alt ClientM where

89instance RunClient ClientM where

90 runRequest = performRequest

91+ throwServantError = throwError

92+ catchServantError = catchError

92instance ClientLike (ClientM a) (ClientM a) where

94instance ClientLike (ClientM a) (ClientM a) where

93 mkClient = id

95 mkClient = id