From f4fc2b321f39c17ae0d7889d8ffd84b7eea5a3bd Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Tue, 30 Jan 2018 18:40:02 +0200 Subject: [PATCH] Refactor servant-client-core Response+StreamingResponse --- servant-client-core/src/Servant/Client/Core.hs | 3 ++- .../src/Servant/Client/Core/Internal/HasClient.hs | 3 ++- .../src/Servant/Client/Core/Internal/Request.hs | 12 +++++++----- .../src/Servant/Client/Core/Internal/RunClient.hs | 2 +- .../src/Servant/Client/Core/Reexport.hs | 5 ++++- servant-client/servant-client.cabal | 3 +++ servant-client/src/Servant/Client.hs | 4 +++- .../src/Servant/Client/Internal/HttpClient.hs | 11 ++++------- servant/servant.cabal | 2 +- 9 files changed, 27 insertions(+), 18 deletions(-) diff --git a/servant-client-core/src/Servant/Client/Core.hs b/servant-client-core/src/Servant/Client/Core.hs index 73160abf..f974b23a 100644 --- a/servant-client-core/src/Servant/Client/Core.hs +++ b/servant-client-core/src/Servant/Client/Core.hs @@ -40,7 +40,8 @@ module Servant.Client.Core -- * Response - , Response(..) + , Response + , GenResponse (..) , RunClient(..) , module Servant.Client.Core.Internal.BaseUrl , StreamingResponse(..) diff --git a/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs b/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs index cf2ec85d..20a65db7 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs @@ -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 diff --git a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs index b120c7f7..50aadda3 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/Request.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/Request.hs @@ -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 diff --git a/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs b/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs index 88b39a04..1c959998 100644 --- a/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs +++ b/servant-client-core/src/Servant/Client/Core/Internal/RunClient.hs @@ -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 (..)) diff --git a/servant-client-core/src/Servant/Client/Core/Reexport.hs b/servant-client-core/src/Servant/Client/Core/Reexport.hs index 4c90a6f2..3d8dd53b 100644 --- a/servant-client-core/src/Servant/Client/Core/Reexport.hs +++ b/servant-client-core/src/Servant/Client/Core/Reexport.hs @@ -5,8 +5,11 @@ module Servant.Client.Core.Reexport ( -- * HasClient HasClient(..) + -- * Response (for @Raw@) - , Response(..) + , Response + , StreamingResponse + , GenResponse(..) -- * Generic Client , ClientLike(..) diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 10f13b90..d4dc6ae0 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -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.* diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index 3de40365..d3243198 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -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 diff --git a/servant-client/src/Servant/Client/Internal/HttpClient.hs b/servant-client/src/Servant/Client/Internal/HttpClient.hs index e0085070..d3613650 100644 --- a/servant-client/src/Servant/Client/Internal/HttpClient.hs +++ b/servant-client/src/Servant/Client/Internal/HttpClient.hs @@ -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 diff --git a/servant/servant.cabal b/servant/servant.cabal index 8684ce7f..e9eb9b8f 100644 --- a/servant/servant.cabal +++ b/servant/servant.cabal @@ -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)