make client endpoint give polymorphic result
This commit is contained in:
parent
e75a3cc37b
commit
0c77a2b4b0
3 changed files with 13 additions and 10 deletions
|
@ -4,7 +4,6 @@
|
||||||
{-# LANGUAGE FlexibleInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
{-# LANGUAGE InstanceSigs #-}
|
{-# LANGUAGE InstanceSigs #-}
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
@ -48,6 +47,7 @@ import Servant.API ((:<|>) ((:<|>)), (:>),
|
||||||
QueryParams, Raw,
|
QueryParams, Raw,
|
||||||
ReflectMethod (..),
|
ReflectMethod (..),
|
||||||
RemoteHost, ReqBody,
|
RemoteHost, ReqBody,
|
||||||
|
ResultStream(..),
|
||||||
Stream,
|
Stream,
|
||||||
Summary, ToHttpApiData,
|
Summary, ToHttpApiData,
|
||||||
Vault, Verb,
|
Vault, Verb,
|
||||||
|
@ -253,21 +253,19 @@ instance OVERLAPPING_
|
||||||
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
, getHeadersHList = buildHeadersTo . toList $ responseHeaders response
|
||||||
}
|
}
|
||||||
|
|
||||||
data ResultStream a = ResultStream ((forall b. (IO (Maybe (Either String a)) -> IO b) -> IO b))
|
|
||||||
|
|
||||||
instance OVERLAPPABLE_
|
instance OVERLAPPABLE_
|
||||||
( RunClient m, MimeUnrender ct a, ReflectMethod method,
|
( RunClient m, MimeUnrender ct a, ReflectMethod method,
|
||||||
FramingUnrender framing a, BuildFromStream a (f a)
|
FramingUnrender framing a, BuildFromStream a (f a)
|
||||||
) => HasClient m (Stream method framing ct (f a)) where
|
) => HasClient m (Stream method framing ct (f a)) where
|
||||||
|
|
||||||
type Client m (Stream method framing ct (f a)) = m (ResultStream a)
|
type Client m (Stream method framing ct (f a)) = m (f a)
|
||||||
|
|
||||||
clientWithRoute _pm Proxy req = do
|
clientWithRoute _pm Proxy req = do
|
||||||
sresp <- streamingRequest req
|
sresp <- streamingRequest req
|
||||||
{ requestAccept = fromList [contentType (Proxy :: Proxy ct)]
|
{ requestAccept = fromList [contentType (Proxy :: Proxy ct)]
|
||||||
, requestMethod = reflectMethod (Proxy :: Proxy method)
|
, requestMethod = reflectMethod (Proxy :: Proxy method)
|
||||||
}
|
}
|
||||||
return $ ResultStream $ \k ->
|
return . buildFromStream $ ResultStream $ \k ->
|
||||||
runStreamingResponse sresp $ \(status,_headers,_httpversion,reader) -> do
|
runStreamingResponse sresp $ \(status,_headers,_httpversion,reader) -> do
|
||||||
when (H.statusCode status /= 200) $ error "bad status" --fixme
|
when (H.statusCode status /= 200) $ error "bad status" --fixme
|
||||||
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
|
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
|
||||||
|
|
|
@ -84,7 +84,8 @@ import Servant.API.QueryParam (QueryFlag, QueryParam,
|
||||||
QueryParams)
|
QueryParams)
|
||||||
import Servant.API.Raw (Raw)
|
import Servant.API.Raw (Raw)
|
||||||
import Servant.API.Stream (Stream, StreamGenerator (..),
|
import Servant.API.Stream (Stream, StreamGenerator (..),
|
||||||
ToStreamGenerator (..), BuildFromStream (..),
|
ToStreamGenerator (..),
|
||||||
|
ResultStream(..), BuildFromStream (..),
|
||||||
ByteStringParser (..),
|
ByteStringParser (..),
|
||||||
FramingRender (..), BoundaryStrategy (..),
|
FramingRender (..), BoundaryStrategy (..),
|
||||||
FramingUnrender (..),
|
FramingUnrender (..),
|
||||||
|
|
|
@ -6,6 +6,7 @@
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE PolyKinds #-}
|
{-# LANGUAGE PolyKinds #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
{-# OPTIONS_HADDOCK not-home #-}
|
{-# OPTIONS_HADDOCK not-home #-}
|
||||||
|
|
||||||
|
@ -35,11 +36,14 @@ class ToStreamGenerator f a where
|
||||||
instance ToStreamGenerator StreamGenerator a
|
instance ToStreamGenerator StreamGenerator a
|
||||||
where toStreamGenerator x = x
|
where toStreamGenerator x = x
|
||||||
|
|
||||||
-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints. The streams we build from are represented as lazy lists of elements interspersed with possible errors.
|
-- | Clients reading from streaming endpoints can be implemented as producing a @ResultStream@ that captures the setup, takedown, and incremental logic for a read, being an IO continuation that takes a producer of Just either values or errors that terminates with a Nothing.
|
||||||
class BuildFromStream a b where
|
data ResultStream a = ResultStream ((forall b. (IO (Maybe (Either String a)) -> IO b) -> IO b))
|
||||||
buildFromStream :: [Either String a] -> b
|
|
||||||
|
|
||||||
instance BuildFromStream a [Either String a]
|
-- | BuildFromStream is intended to be implemented for types such as Conduit, Pipe, etc. By implementing this class, all such streaming abstractions can be used directly on the client side for talking to streaming endpoints.
|
||||||
|
class BuildFromStream a b where
|
||||||
|
buildFromStream :: ResultStream a -> b
|
||||||
|
|
||||||
|
instance BuildFromStream a (ResultStream a)
|
||||||
where buildFromStream x = x
|
where buildFromStream x = x
|
||||||
|
|
||||||
-- | The FramingRender class provides the logic for emitting a framing strategy. The strategy emits a header, followed by boundary-delimited data, and finally a termination character. For many strategies, some of these will just be empty bytestrings.
|
-- | The FramingRender class provides the logic for emitting a framing strategy. The strategy emits a header, followed by boundary-delimited data, and finally a termination character. For many strategies, some of these will just be empty bytestrings.
|
||||||
|
|
Loading…
Reference in a new issue