3a9a1ca · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Parametrise over body contents only

3a9a1caOleg Grenrus8 years ago

servant-client-core/servant-client-core.cabal+5−1

compare with master

unifiedsplit

@@ -58,9 +58,13 @@ library

58 , transformers >= 0.5.2.0 && < 0.6

59 , template-haskell >= 2.11.1.0 && < 2.15

61+ if !impl(ghc >= 8.2)

62+ build-depends:

63+ bifunctors >= 5.5.3 && < 5.6

64+

61 -- Servant dependencies

65 -- Servant dependencies

62 build-depends:

66 build-depends:

63− servant >= 0.15 && <0.16

67+ servant >= 0.15 && <0.16

65 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

69 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

66 -- Here can be exceptions if we really need features from the newer versions.

70 -- Here can be exceptions if we really need features from the newer versions.

servant-client-core/src/Servant/Client/Core/Internal/Request.hs+36−18

@@ -19,14 +19,20 @@ import Control.DeepSeq

19 (NFData (..))

20import Control.Monad.Catch

21 (Exception)

22+import Data.Bifoldable

23+ (Bifoldable (..))

24+import Data.Bifunctor

25+ (Bifunctor (..))

26+import Data.Bitraversable

27+ (Bitraversable (..), bifoldMapDefault, bimapDefault)

22−import qualified Data.ByteString as BS

28+import qualified Data.ByteString as BS

23−import qualified Data.ByteString.Builder as Builder

29+import qualified Data.ByteString.Builder as Builder

24−import qualified Data.ByteString.Lazy as LBS

30+import qualified Data.ByteString.Lazy as LBS

25import Data.Int

31import Data.Int

26 (Int64)

32 (Int64)

27import Data.Semigroup

33import Data.Semigroup

28 ((<>))

34 ((<>))

29−import qualified Data.Sequence as Seq

35+import qualified Data.Sequence as Seq

30import Data.Text

36import Data.Text

31 (Text)

37 (Text)

32import Data.Text.Encoding

38import Data.Text.Encoding

@@ -40,10 +46,10 @@ import Network.HTTP.Media

40import Network.HTTP.Types

46import Network.HTTP.Types

41 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

47 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

42 Status (..), http11, methodGet)

48 Status (..), http11, methodGet)

43−import Servant.Client.Core.Internal.BaseUrl

44− (BaseUrl)

45import Servant.API

49import Servant.API

46 (ToHttpApiData, toEncodedUrlPiece, toHeader)

50 (ToHttpApiData, toEncodedUrlPiece, toHeader)

51+import Servant.Client.Core.Internal.BaseUrl

52+ (BaseUrl)

48-- | A type representing possible errors in a request

54-- | A type representing possible errors in a request

49--

55--

@@ -83,24 +89,36 @@ mediaTypeRnf mt =

83data RequestF body path = Request

89data RequestF body path = Request

84 { requestPath :: path

90 { requestPath :: path

85 , requestQueryString :: Seq.Seq QueryItem

91 , requestQueryString :: Seq.Seq QueryItem

86− , requestBody :: body

92+ , requestBody :: Maybe (body, MediaType)

87 , requestAccept :: Seq.Seq MediaType

93 , requestAccept :: Seq.Seq MediaType

88 , requestHeaders :: Seq.Seq Header

94 , requestHeaders :: Seq.Seq Header

89 , requestHttpVersion :: HttpVersion

95 , requestHttpVersion :: HttpVersion

90 , requestMethod :: Method

96 , requestMethod :: Method

91− } deriving (Generic, Typeable, Eq, Show)

97+ } deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable)

98+

99+instance Bifunctor RequestF where bimap = bimapDefault

100+instance Bifoldable RequestF where bifoldMap = bifoldMapDefault

101+instance Bitraversable RequestF where

102+ bitraverse f g r = mk

103+ <$> traverse (bitraverse f pure) (requestBody r)

104+ <*> g (requestPath r)

105+ where

106+ mk b p = r { requestBody = b, requestPath = p }

107

93instance (NFData path, NFData body) => NFData (RequestF body path) where

108instance (NFData path, NFData body) => NFData (RequestF body path) where

94− rnf r =

109+ rnf r =

95− rnf (requestPath r)

110+ rnf (requestPath r)

96− `seq` rnf (requestQueryString r)

111+ `seq` rnf (requestQueryString r)

97− `seq` rnf (requestBody r)

112+ `seq` rnfB (requestBody r)

98− `seq` rnf (fmap mediaTypeRnf (requestAccept r))

113+ `seq` rnf (fmap mediaTypeRnf (requestAccept r))

99− `seq` rnf (requestHeaders r)

114+ `seq` rnf (requestHeaders r)

100− `seq` requestHttpVersion r

115+ `seq` requestHttpVersion r

101− `seq` rnf (requestMethod r)

116+ `seq` rnf (requestMethod r)

102−

117+ where

118+ rnfB Nothing = ()

119+ rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

120+

103−type Request = RequestF (Maybe (RequestBody, MediaType)) Builder.Builder

121+type Request = RequestF RequestBody Builder.Builder

104

122

105-- | The request body. A replica of the @http-client@ @RequestBody@.

123-- | The request body. A replica of the @http-client@ @RequestBody@.

106data RequestBody

124data RequestBody

servant-client/servant-client.cabal+4

@@ -55,6 +55,10 @@ library

55 , time >= 1.6.0.1 && < 1.9

56 , transformers >= 0.5.2.0 && < 0.6

58+ if !impl(ghc >= 8.2)

59+ build-depends:

60+ bifunctors >= 5.5.3 && < 5.6

61+

58 -- Servant dependencies.

62 -- Servant dependencies.

59 -- Strict dependency on `servant-client-core` as we re-export things.

63 -- Strict dependency on `servant-client-core` as we re-export things.

60 build-depends:

64 build-depends:

servant-client/src/Servant/Client/Internal/HttpClient.hs+6−3

@@ -31,6 +31,8 @@ import Control.Monad.STM

31import Control.Monad.Trans.Control

32 (MonadBaseControl (..))

33import Control.Monad.Trans.Except

34+import Data.Bifunctor

35+ (bimap)

34import Data.ByteString.Builder

36import Data.ByteString.Builder

35 (toLazyByteString)

37 (toLazyByteString)

36import qualified Data.ByteString.Lazy as BSL

38import qualified Data.ByteString.Lazy as BSL

@@ -196,9 +198,10 @@ performRequest req = do

196 fRes = Client.hrFinalResponse responses

198 fRes = Client.hrFinalResponse responses

197

199

198mkFailureResponse :: BaseUrl -> Request -> GenResponse BSL.ByteString -> ServantError

200mkFailureResponse :: BaseUrl -> Request -> GenResponse BSL.ByteString -> ServantError

199−mkFailureResponse burl request ourResponse =

201+mkFailureResponse burl request =

200− FailureResponse (request {requestPath = (burl, path), requestBody = ()}) ourResponse

202+ FailureResponse (bimap (const ()) f request)

203+ where

201− where path = BSL.toStrict $ toLazyByteString $ requestPath request

204+ f b = (burl, BSL.toStrict $ toLazyByteString b)

202

205

203clientResponseToResponse :: Client.Response a -> GenResponse a

206clientResponseToResponse :: Client.Response a -> GenResponse a

204clientResponseToResponse r = Response

207clientResponseToResponse r = Response