git.iko.soy/typeable/servant
on master help sign in
Add runClientM for streaming-client
commit0dd8ee75855310a6948c394402a4b86cd26a493a authorOleg Grenrus <oleg.grenrus@iki.fi> dateFri 9 Nov 2018, 19:43 (8 years ago) parent5f947d1
5 files changed+49−4
compare with master
unifiedsplit
servant-client-core/servant-client-core.cabal+1 servant-client-core/src/Servant/Client/Core/Internal/Request.hs+29−3 servant-client/servant-client.cabal+1 servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+17−1 servant-client/src/Servant/Client/Streaming.hs+1
servant-client-core/servant-client-core.cabal+1
@@ -50,6 +50,7 @@ library
5050 base >= 4.9 && < 4.13
5151 , bytestring >= 0.10.8.1 && < 0.11
5252 , containers >= 0.5.7.1 && < 0.7
53+ , deepseq >= 1.4.2.0 && < 1.5
5354 , text >= 1.2.3.0 && < 1.3
5455 , transformers >= 0.5.2.0 && < 0.6
5556 , template-haskell >= 2.11.1.0 && < 2.15
servant-client-core/src/Servant/Client/Core/Internal/Request.hs+29−3
@@ -15,6 +15,8 @@ module Servant.Client.Core.Internal.Request where
1515import Prelude ()
1616import Prelude.Compat
1717
18+import Control.DeepSeq
19+ (NFData (..))
1820import Control.Monad.Catch
1921 (Exception)
2022import qualified Data.ByteString as BS
@@ -34,10 +36,10 @@ import Data.Typeable
3436import GHC.Generics
3537 (Generic)
3638import Network.HTTP.Media
37− (MediaType)
39+ (MediaType, mainType, parameters, subType)
3840import Network.HTTP.Types
39− (Header, HeaderName, HttpVersion, Method, QueryItem, Status,
40− http11, methodGet)
41+ (Header, HeaderName, HttpVersion (..), Method, QueryItem,
42+ Status (..), http11, methodGet)
4143import Web.HttpApiData
4244 (ToHttpApiData, toEncodedUrlPiece, toHeader)
4345
@@ -59,6 +61,20 @@ data ServantError =
5961
6062instance Exception ServantError
6163
64+instance NFData ServantError where
65+ rnf (FailureResponse res) = rnf res
66+ rnf (DecodeFailure err res) = rnf err `seq` rnf res
67+ rnf (UnsupportedContentType mt' res) =
68+ mediaTypeRnf mt' `seq`
69+ rnf res
70+ where
71+ mediaTypeRnf mt =
72+ rnf (mainType mt) `seq`
73+ rnf (subType mt) `seq`
74+ rnf (parameters mt)
75+ rnf (InvalidContentTypeHeader res) = rnf res
76+ rnf (ConnectionError err) = rnf err
77+
6278data RequestF a = Request
6379 { requestPath :: a
6480 , requestQueryString :: Seq.Seq QueryItem
@@ -88,6 +104,16 @@ data GenResponse a = Response
88104 , responseBody :: a
89105 } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
90106
107+instance NFData a => NFData (GenResponse a) where
108+ rnf (Response sc hs hv body) =
109+ rnfStatus sc `seq`
110+ rnf hs `seq`
111+ rnfHttpVersion hv `seq`
112+ rnf body
113+ where
114+ rnfStatus (Status code msg) = rnf code `seq` rnf msg
115+ rnfHttpVersion (HttpVersion _ _) = () -- HttpVersion fields are strict
116+
91117type Response = GenResponse LBS.ByteString
92118type StreamingResponse = GenResponse (IO BS.ByteString)
93119
servant-client/servant-client.cabal+1
@@ -43,6 +43,7 @@ library
4343 base >= 4.9 && < 4.13
4444 , bytestring >= 0.10.8.1 && < 0.11
4545 , containers >= 0.5.7.1 && < 0.7
46+ , deepseq >= 1.4.2.0 && < 1.5
4647 , mtl >= 2.2.2 && < 2.3
4748 , stm >= 2.4.5.1 && < 2.6
4849 , text >= 1.2.3.0 && < 1.3
servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+17−1
@@ -20,8 +20,11 @@ import Prelude ()
2020import Prelude.Compat
2121
2222import Control.Concurrent.STM.TVar
23+import Control.DeepSeq
24+ (NFData, force)
2325import Control.Exception
24−import Control.Monad
26+ (evaluate, throwIO)
27+import Control.Monad ()
2528import Control.Monad.Base
2629 (MonadBase (..))
2730import Control.Monad.Codensity
@@ -120,6 +123,19 @@ withClientM cm env k =
120123 let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
121124 in f k
122125
126+-- | A 'runClientM' variant for streaming client.
127+--
128+-- It allows using this module's 'ClientM' in a direct style.
129+-- The 'NFData' constraint however prevents using this function with genuine
130+-- streaming response types ('SourceT', 'Conduit', pipes 'Proxy' or 'Machine').
131+-- For those you have to use 'withClientM'.
132+--
133+-- /Note:/ we 'force' the result, so the likehood of accidentally leaking a
134+-- connection is smaller. Use with care.
135+--
136+runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)
137+runClientM cm env = withClientM cm env (evaluate . force)
138+
123139performRequest :: Request -> ClientM Response
124140performRequest req = do
125141 -- TODO: should use Client.withResponse here too
servant-client/src/Servant/Client/Streaming.hs+1
@@ -7,6 +7,7 @@ module Servant.Client.Streaming
77 ( client
88 , ClientM
99 , withClientM
10+ , runClientM
1011 , ClientEnv(..)
1112 , mkClientEnv
1213 , hoistClient