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

Refactor servant-client-core Response+StreamingResponse

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(..)

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

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

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 (..))
 

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(..)

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.*

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

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)
+        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
   { responseStatusCode = Client.responseStatus r
   , responseBody = Client.responseBody r

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)