Refactor servant-client-core Response+StreamingResponse
This commit is contained in:
Oleg Grenrus
parent
ff268941a1
commit
f4fc2b321f
9 changed files with 27 additions and 18 deletions
|
|
@ -40,7 +40,8 @@ module Servant.Client.Core
|
|||
|
||||
|
||||
-- * Response
|
||||
, Response(..)
|
||||
, Response
|
||||
, GenResponse (..)
|
||||
, RunClient(..)
|
||||
, module Servant.Client.Core.Internal.BaseUrl
|
||||
, StreamingResponse(..)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,8 +5,11 @@ module Servant.Client.Core.Reexport
|
|||
(
|
||||
-- * HasClient
|
||||
HasClient(..)
|
||||
|
||||
-- * Response (for @Raw@)
|
||||
, Response(..)
|
||||
, Response
|
||||
, StreamingResponse
|
||||
, GenResponse(..)
|
||||
|
||||
-- * Generic Client
|
||||
, ClientLike(..)
|
||||
|
|
|
|||
|
|
@ -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.*
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue