Separate Servant.Client.Streaming

- as a bonus only `servant-client` depends on `kan-extensions`

doc/cookbook/basic-streaming/Streaming.lhs

@@ -38,7 +38,7 @@ import           Text.Read
                  (readMaybe)
 
 import           Servant
-import           Servant.Client
+import           Servant.Client.Streaming
 import qualified Servant.Types.SourceT as S
 
 import qualified Network.Wai.Handler.Warp     as Warp

doc/tutorial/Client.lhs

@@ -21,7 +21,8 @@ import Network.HTTP.Client (newManager, defaultManagerSettings)
 import Servant.API
 import Servant.Client
 import Servant.Types.SourceT (foreach)
-import Control.Monad.Codensity (Codensity)
+
+import qualified Servant.Client.Streaming as S
 ```
 
 Also, we need examples for some domain specific data types:
@@ -224,28 +225,27 @@ type StreamAPI = "positionStream" :> StreamGet NewlineFraming JSON (SourceIO Pos
 
 Note that we use the same `SourceIO` type as on the server-side 
 (this is different from `servant-0.14`).
+However, we have to use different client, `Servant.Client.Streaming`,
+which can stream (but has different API).
 
 In any case, here's how we write a function to query our API:
 
 ```haskell
 streamAPI :: Proxy StreamAPI
 streamAPI = Proxy
 
-posStream :: ClientM (Codensity IO (SourceIO Position))
-posStream = client streamAPI
+posStream :: S.ClientM (SourceIO Position)
+posStream = S.client streamAPI
 ```
 
-We'll get back a `Codensity IO (SourceIO Position)`. The wrapping in
-`Codensity` is generally necessary, as `Codensity` lets us `bracket` things
-properly.  This is best explained by an example. To consume `ClientM (Codentity
-IO ...)` we can use `withClientM` helper: the underlying HTTP connection is
-open only until the inner functions exits.  Inside the block we can e.g just
-print out all elements from a `SourceIO`, to give some idea of how to work with
-them.
+We'll get back a `SourceIO Position`. Instead of `runClientM`, the streaming
+client provides `withClientM`: the underlying HTTP connection is open only
+until the inner functions exits.  Inside the block we can e.g just print out
+all elements from a `SourceIO`, to give some idea of how to work with them.
 
 ``` haskell
-printSourceIO :: Show a => ClientEnv -> ClientM (Codensity IO (SourceIO a)) -> IO ()
-printSourceIO env c = withClientM c env $ \e -> case e of
+printSourceIO :: Show a => ClientEnv -> S.ClientM (SourceIO a) -> IO ()
+printSourceIO env c = S.withClientM c env $ \e -> case e of
     Left err -> putStrLn $ "Error: " ++ show err
     Right rs -> foreach fail print rs
 ```

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

@@ -70,7 +70,6 @@ library
     , http-api-data         >= 0.3.8.1  && < 0.4
     , http-media            >= 0.7.1.2  && < 0.8
     , http-types            >= 0.12.1   && < 0.13
-    , kan-extensions        >= 5.2      && < 5.3
     , network-uri           >= 2.6.1.0  && < 2.7
     , safe                  >= 0.3.17   && < 0.4
 

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

@@ -44,6 +44,8 @@ module Servant.Client.Core
   , GenResponse (..)
   , RunClient(..)
   , module Servant.Client.Core.Internal.BaseUrl
+  -- ** Streaming
+  , RunStreamingClient(..)
   , StreamingResponse
 
   -- * Writing HasClient instances

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

@@ -36,20 +36,17 @@ import qualified Network.HTTP.Types                     as H
 import           Servant.API
                  ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,
                  BuildHeadersTo (..), Capture', CaptureAll, Description,
-                 EmptyAPI, FramingUnrender (..), FromSourceIO (..),
-                 Header', Headers (..), HttpVersion, IsSecure,
-                 MimeRender (mimeRender), MimeUnrender (mimeUnrender),
-                 NoContent (NoContent), QueryFlag, QueryParam', QueryParams,
-                 Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
-                 StreamBody, Summary, ToHttpApiData, Vault, Verb,
-                 WithNamedContext, contentType, getHeadersHList, getResponse,
-                 toQueryParam, toUrlPiece)
+                 EmptyAPI, FramingUnrender (..), FromSourceIO (..), Header',
+                 Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
+                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
+                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
+                 ReqBody', SBoolI, Stream, StreamBody, Summary, ToHttpApiData,
+                 Vault, Verb, WithNamedContext, contentType, getHeadersHList,
+                 getResponse, toQueryParam, toUrlPiece)
 import           Servant.API.ContentTypes
                  (contentTypes)
 import           Servant.API.Modifiers
                  (FoldRequired, RequiredArgument, foldRequiredArgument)
-import           Control.Monad.Codensity
-                 (Codensity (..))
 import qualified Servant.Types.SourceT                  as S
 
 import           Servant.Client.Core.Internal.Auth
@@ -272,25 +269,23 @@ instance {-# OVERLAPPING #-}
   hoistClientMonad _ _ f ma = f ma
 
 instance {-# OVERLAPPABLE #-}
-  ( RunClient m, MimeUnrender ct chunk, ReflectMethod method,
+  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,
     FramingUnrender framing, FromSourceIO chunk a
   ) => HasClient m (Stream method status framing ct a) where
 
-  type Client m (Stream method status framing ct a) = m (Codensity IO a)
+  type Client m (Stream method status framing ct a) = m a
 
   hoistClientMonad _ _ f ma = f ma
 
-  clientWithRoute _pm Proxy req = do
-    sresp <- streamingRequest req
-      { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
-      , requestMethod = reflectMethod (Proxy :: Proxy method)
-      }
-    return $ do
-        let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
-            framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
-        gres <- sresp
-        return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
-
+  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
+      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
+          framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
+      return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
+    where
+      req' = req
+          { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
+          , requestMethod = reflectMethod (Proxy :: Proxy method)
+          }
 
 -- | If you use a 'Header' in one of your endpoints in your API,
 -- the corresponding querying function will automatically take

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

@@ -38,8 +38,6 @@ import           Network.HTTP.Media
 import           Network.HTTP.Types
                  (Header, HeaderName, HttpVersion, Method, QueryItem, Status,
                  http11, methodGet)
-import           Control.Monad.Codensity
-                 (Codensity (..))
 import           Web.HttpApiData
                  (ToHttpApiData, toEncodedUrlPiece, toHeader)
 
@@ -91,7 +89,7 @@ data GenResponse a = Response
   } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
 
 type Response = GenResponse LBS.ByteString
-type StreamingResponse = Codensity IO (GenResponse (IO BS.ByteString))
+type StreamingResponse = GenResponse (IO BS.ByteString)
 
 -- A GET request to the top-level path
 defaultRequest :: Request

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

@@ -31,9 +31,11 @@ import           Servant.Client.Core.Internal.Request
 class Monad m => RunClient m where
   -- | How to make a request.
   runRequest :: Request -> m Response
-  streamingRequest :: Request -> m StreamingResponse
   throwServantError :: ServantError -> m a
 
+class RunClient m =>  RunStreamingClient m where
+    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a
+
 checkContentTypeHeader :: RunClient m => Response -> m MediaType
 checkContentTypeHeader response =
   case lookup "Content-Type" $ toList $ responseHeaders response of
@@ -56,5 +58,10 @@ decodedAs response contentType = do
 
 instance ClientF ~ f => RunClient (Free f) where
     runRequest req  = liftF (RunRequest req id)
-    streamingRequest req = liftF (StreamingRequest req id)
     throwServantError = liftF . Throw
+
+{-
+Free and streaming?
+instance ClientF ~ f => RunStreamingClient (Free f) where
+    streamingRequest req = liftF (StreamingRequest req id)
+-}

servant-client/servant-client.cabal

@@ -33,7 +33,9 @@ source-repository head
 library
   exposed-modules:
     Servant.Client
+    Servant.Client.Streaming
     Servant.Client.Internal.HttpClient
+    Servant.Client.Internal.HttpClient.Streaming
 
   -- Bundled with GHC: Lower bound to not force re-installs
   -- text and mtl are bundled starting with GHC-8.4

servant-client/src/Servant/Client.hs

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

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

@@ -21,8 +21,6 @@ import           Control.Monad.Base
                  (MonadBase (..))
 import           Control.Monad.Catch
                  (MonadCatch, MonadThrow)
-import           Control.Monad.Codensity
-                 (Codensity (..))
 import           Control.Monad.Error.Class
                  (MonadError (..))
 import           Control.Monad.Reader
@@ -134,7 +132,6 @@ instance Alt ClientM where
 
 instance RunClient ClientM where
   runRequest = performRequest
-  streamingRequest = performStreamingRequest
   throwServantError = throwError
 
 instance ClientLike (ClientM a) (ClientM a) where
@@ -143,6 +140,7 @@ instance ClientLike (ClientM a) (ClientM a) where
 runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
 runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
 
+{-
 withClientM
     :: ClientM (Codensity IO a)         -- ^ client with codensity result
     -> ClientEnv                        -- ^ environment
@@ -153,6 +151,7 @@ withClientM cm env k = do
     case e of
         Left err  -> k (Left err)
         Right cod -> runCodensity cod (k . Right)
+-}
 
 performRequest :: Request -> ClientM Response
 performRequest req = do
@@ -186,6 +185,7 @@ performRequest req = do
         throwError $ FailureResponse ourResponse
       return ourResponse
 
+{-
 performStreamingRequest :: Request -> ClientM StreamingResponse
 performStreamingRequest req = do
   m <- asks manager
@@ -200,6 +200,7 @@ performStreamingRequest req = do
         b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
         throw $ FailureResponse $ clientResponseToResponse r { Client.responseBody = b }
       k (clientResponseToResponse r)
+-}
 
 clientResponseToResponse :: Client.Response a -> GenResponse a
 clientResponseToResponse r = Response