eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

3
servant-client-core/src/Servant/Client/Core.hs
View file

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

3
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs
View file

@ -269,7 +269,8 @@ instance OVERLAPPABLE_
, requestMethod = reflectMethod (Proxy :: Proxy method)
}
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)
loop bs = do
res <- BL.fromStrict <$> reader

12
servant-client-core/src/Servant/Client/Core/Internal/Request.hs
View file

@ -1,8 +1,9 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE OverloadedStrings #-}
@ -65,14 +66,15 @@ type Request = RequestF Builder.Builder
newtype RequestBody = RequestBodyLBS LBS.ByteString
deriving (Eq, Ord, Read, Show, Typeable)
data Response = Response
data GenResponse a = Response
{ responseStatusCode :: Status
, responseBody :: LBS.ByteString
, responseHeaders :: Seq.Seq Header
, 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
defaultRequest :: Request

2
servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs
View file

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

5
servant-client-core/src/Servant/Client/Core/Reexport.hs
View file

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

3
servant-client/servant-client.cabal
View file

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

4
servant-client/src/Servant/Client.hs
View file

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

11
servant-client/src/Servant/Client/Internal/HttpClient.hs
View file

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

2
servant/servant.cabal
View file

@ -71,7 +71,7 @@ library
build-depends:
base >= 4.7 && < 4.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
if !impl(ghc >= 8.0)