Merge pull request #899 from phadej/response-body-refactor

Refactor servant-client-core Response+StreamingResponse
This commit is contained in:
Oleg Grenrus 2018-02-06 11:33:36 +02:00 committed by GitHub
commit f5ffdc7fbd
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
9 changed files with 27 additions and 18 deletions

View file

@ -40,7 +40,8 @@ module Servant.Client.Core
-- * Response -- * Response
, Response(..) , Response
, GenResponse (..)
, RunClient(..) , RunClient(..)
, module Servant.Client.Core.Internal.BaseUrl , module Servant.Client.Core.Internal.BaseUrl
, StreamingResponse(..) , StreamingResponse(..)

View file

@ -269,7 +269,8 @@ instance OVERLAPPABLE_
, requestMethod = reflectMethod (Proxy :: Proxy method) , requestMethod = reflectMethod (Proxy :: Proxy method)
} }
return . buildFromStream $ ResultStream $ \k -> return . buildFromStream $ ResultStream $ \k ->
runStreamingResponse sresp $ \(_status,_headers,_httpversion,reader) -> do runStreamingResponse sresp $ \gres -> do
let reader = responseBody gres
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a) let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
loop bs = do loop bs = do
res <- BL.fromStrict <$> reader res <- BL.fromStrict <$> reader

View file

@ -1,8 +1,9 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
@ -65,14 +66,15 @@ type Request = RequestF Builder.Builder
newtype RequestBody = RequestBodyLBS LBS.ByteString newtype RequestBody = RequestBodyLBS LBS.ByteString
deriving (Eq, Ord, Read, Show, Typeable) deriving (Eq, Ord, Read, Show, Typeable)
data Response = Response data GenResponse a = Response
{ responseStatusCode :: Status { responseStatusCode :: Status
, responseBody :: LBS.ByteString
, responseHeaders :: Seq.Seq Header , responseHeaders :: Seq.Seq Header
, responseHttpVersion :: HttpVersion , responseHttpVersion :: HttpVersion
} deriving (Eq, Show, Generic, Typeable) , responseBody :: a
} deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
data StreamingResponse = StreamingResponse { runStreamingResponse :: forall a. ((Status, Seq.Seq Header, HttpVersion, IO BS.ByteString) -> IO a) -> IO a } type Response = GenResponse LBS.ByteString
newtype StreamingResponse = StreamingResponse { runStreamingResponse :: forall a. (GenResponse (IO BS.ByteString) -> IO a) -> IO a }
-- A GET request to the top-level path -- A GET request to the top-level path
defaultRequest :: Request defaultRequest :: Request

View file

@ -18,7 +18,7 @@ import Network.HTTP.Media (MediaType, matches,
import Servant.API (MimeUnrender, import Servant.API (MimeUnrender,
contentTypes, contentTypes,
mimeUnrender) mimeUnrender)
import Servant.Client.Core.Internal.Request (Request, Response (..), import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..),
StreamingResponse (..), StreamingResponse (..),
ServantError (..)) ServantError (..))

View file

@ -5,8 +5,11 @@ module Servant.Client.Core.Reexport
( (
-- * HasClient -- * HasClient
HasClient(..) HasClient(..)
-- * Response (for @Raw@) -- * Response (for @Raw@)
, Response(..) , Response
, StreamingResponse
, GenResponse(..)
-- * Generic Client -- * Generic Client
, ClientLike(..) , ClientLike(..)

View file

@ -49,6 +49,9 @@ library
, time >= 1.4.2 && < 1.9 , time >= 1.4.2 && < 1.9
, transformers >= 0.3.0.0 && < 0.6 , transformers >= 0.3.0.0 && < 0.6
if !impl(ghc >= 8.0)
build-depends: semigroups >=0.18.3 && <0.19
-- Servant dependencies -- Servant dependencies
build-depends: build-depends:
servant-client-core == 0.12.* servant-client-core == 0.12.*

View file

@ -1,3 +1,5 @@
-- | This module provides 'client' which can automatically generate -- | This module provides 'client' which can automatically generate
-- querying functions for each endpoint just from the type representing your -- querying functions for each endpoint just from the type representing your
-- API. -- API.
@ -10,5 +12,5 @@ module Servant.Client
, module Servant.Client.Core.Reexport , module Servant.Client.Core.Reexport
) where ) where
import Servant.Client.Internal.HttpClient
import Servant.Client.Core.Reexport import Servant.Client.Core.Reexport
import Servant.Client.Internal.HttpClient

View file

@ -8,11 +8,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
-- | @http-client@-based client requests executor
module Servant.Client.Internal.HttpClient where module Servant.Client.Internal.HttpClient where
import Prelude () import Prelude ()
import Prelude.Compat import Prelude.Compat
@ -31,7 +28,7 @@ import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList, for_) import Data.Foldable (toList, for_)
import Data.Functor.Alt (Alt (..)) import Data.Functor.Alt (Alt (..))
import Data.Maybe (maybeToList) import Data.Maybe (maybeToList)
import Data.Monoid ((<>)) import Data.Semigroup ((<>))
import Data.Proxy (Proxy (..)) import Data.Proxy (Proxy (..))
import Data.Sequence (fromList) import Data.Sequence (fromList)
import Data.String (fromString) import Data.String (fromString)
@ -151,10 +148,10 @@ performStreamingRequest req = do
status_code = statusCode status status_code = statusCode status
unless (status_code >= 200 && status_code < 300) $ do unless (status_code >= 200 && status_code < 300) $ do
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r) b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
throw $ FailureResponse $ Response status b (fromList $ Client.responseHeaders r) (Client.responseVersion r) throw $ FailureResponse $ clientResponseToResponse r { Client.responseBody = b }
k (status, fromList $ Client.responseHeaders r, Client.responseVersion r, Client.responseBody r) k (clientResponseToResponse r)
clientResponseToResponse :: Client.Response BSL.ByteString -> Response clientResponseToResponse :: Client.Response a -> GenResponse a
clientResponseToResponse r = Response clientResponseToResponse r = Response
{ responseStatusCode = Client.responseStatus r { responseStatusCode = Client.responseStatus r
, responseBody = Client.responseBody r , responseBody = Client.responseBody r

View file

@ -71,7 +71,7 @@ library
build-depends: build-depends:
base >= 4.7 && < 4.11 base >= 4.7 && < 4.11
, bytestring >= 0.10.4.0 && < 0.11 , bytestring >= 0.10.4.0 && < 0.11
, mtl >= 2.0.1 && < 2.3 , mtl >= 2.1 && < 2.3
, text >= 1.2.3.0 && < 1.3 , text >= 1.2.3.0 && < 1.3
if !impl(ghc >= 8.0) if !impl(ghc >= 8.0)