Add runClientM for streaming-client

servant-client-core/servant-client-core.cabal

@@ -50,6 +50,7 @@ library
       base                  >= 4.9      && < 4.13
     , bytestring            >= 0.10.8.1 && < 0.11
     , containers            >= 0.5.7.1  && < 0.7
+    , deepseq               >= 1.4.2.0  && < 1.5
     , text                  >= 1.2.3.0  && < 1.3
     , transformers          >= 0.5.2.0  && < 0.6
     , template-haskell      >= 2.11.1.0 && < 2.15

servant-client-core/src/Servant/Client/Core/Internal/Request.hs

@@ -15,6 +15,8 @@ module Servant.Client.Core.Internal.Request where
 import           Prelude ()
 import           Prelude.Compat
 
+import           Control.DeepSeq
+                 (NFData (..))
 import           Control.Monad.Catch
                  (Exception)
 import qualified Data.ByteString         as BS
@@ -34,10 +36,10 @@ import           Data.Typeable
 import           GHC.Generics
                  (Generic)
 import           Network.HTTP.Media
-                 (MediaType)
+                 (MediaType, mainType, parameters, subType)
 import           Network.HTTP.Types
-                 (Header, HeaderName, HttpVersion, Method, QueryItem, Status,
+                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,
-                 http11, methodGet)
+                 Status (..), http11, methodGet)
 import           Web.HttpApiData
                  (ToHttpApiData, toEncodedUrlPiece, toHeader)
 
@@ -59,6 +61,20 @@ data ServantError =
 
 instance Exception ServantError
 
+instance NFData ServantError where
+    rnf (FailureResponse res)            = rnf res
+    rnf (DecodeFailure err res)          = rnf err `seq` rnf res
+    rnf (UnsupportedContentType mt' res) =
+        mediaTypeRnf mt' `seq`
+        rnf res
+      where
+        mediaTypeRnf mt =
+            rnf (mainType mt) `seq`
+            rnf (subType mt) `seq`
+            rnf (parameters mt)
+    rnf (InvalidContentTypeHeader res)   = rnf res
+    rnf (ConnectionError err)            = rnf err
+
 data RequestF a = Request
   { requestPath        :: a
   , requestQueryString :: Seq.Seq QueryItem
@@ -88,6 +104,16 @@ data GenResponse a = Response
   , responseBody        :: a
   } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
 
+instance NFData a => NFData (GenResponse a) where
+    rnf (Response sc hs hv body) =
+        rnfStatus sc `seq`
+        rnf hs `seq`
+        rnfHttpVersion hv `seq`
+        rnf body
+      where
+        rnfStatus (Status code msg) = rnf code `seq` rnf msg
+        rnfHttpVersion (HttpVersion _ _) = () -- HttpVersion fields are strict
+
 type Response = GenResponse LBS.ByteString
 type StreamingResponse = GenResponse (IO BS.ByteString)
 

servant-client/servant-client.cabal

@@ -43,6 +43,7 @@ library
       base                  >= 4.9      && < 4.13
     , bytestring            >= 0.10.8.1 && < 0.11
     , containers            >= 0.5.7.1  && < 0.7
+    , deepseq               >= 1.4.2.0  && < 1.5
     , mtl                   >= 2.2.2    && < 2.3
     , stm                   >= 2.4.5.1  && < 2.6
     , text                  >= 1.2.3.0  && < 1.3

servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs

@@ -20,8 +20,11 @@ import           Prelude ()
 import           Prelude.Compat
 
 import           Control.Concurrent.STM.TVar
+import           Control.DeepSeq
+                 (NFData, force)
 import           Control.Exception
-import           Control.Monad
+                 (evaluate, throwIO)
+import           Control.Monad ()
 import           Control.Monad.Base
                  (MonadBase (..))
 import           Control.Monad.Codensity
@@ -120,6 +123,19 @@ withClientM cm env k =
     let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
     in f k
 
+-- | A 'runClientM' variant for streaming client.
+--
+-- It allows using this module's 'ClientM' in a direct style.
+-- The 'NFData' constraint however prevents using this function with genuine
+-- streaming response types ('SourceT', 'Conduit', pipes 'Proxy' or 'Machine').
+-- For those you have to use 'withClientM'.
+--
+-- /Note:/ we 'force' the result, so the likehood of accidentally leaking a
+-- connection is smaller. Use with care.
+--
+runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)
+runClientM cm env = withClientM cm env (evaluate . force)
+
 performRequest :: Request -> ClientM Response
 performRequest req = do
     -- TODO: should use Client.withResponse here too

servant-client/src/Servant/Client/Streaming.hs

@@ -7,6 +7,7 @@ module Servant.Client.Streaming
     ( client
     , ClientM
     , withClientM
+    , runClientM
     , ClientEnv(..)
     , mkClientEnv
     , hoistClient