Merge pull request #1066 from phadej/separate-streaming-client

Separate streaming client

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,6 +225,8 @@ 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:
 
@@ -231,21 +234,18 @@ In any case, here's how we write a function to query our API:
 streamAPI :: Proxy StreamAPI
 streamAPI = Proxy
 
-posStream :: ClientM (Codensity IO (SourceIO Position))
+posStream :: S.ClientM (SourceIO Position)
-posStream = client streamAPI
+posStream = S.client streamAPI
 ```
 
-We'll get back a `Codensity IO (SourceIO Position)`. The wrapping in
+We'll get back a `SourceIO Position`. Instead of `runClientM`, the streaming
-`Codensity` is generally necessary, as `Codensity` lets us `bracket` things
+client provides `withClientM`: the underlying HTTP connection is open only
-properly.  This is best explained by an example. To consume `ClientM (Codentity
+until the inner functions exits.  Inside the block we can e.g just print out
-IO ...)` we can use `withClientM` helper: the underlying HTTP connection is
+all elements from a `SourceIO`, to give some idea of how to work with them.
-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 :: Show a => ClientEnv -> S.ClientM (SourceIO a) -> IO ()
-printSourceIO env c = withClientM c env $ \e -> case e of
+printSourceIO env c = S.withClientM c env $ \e -> case e of
     Left err -> putStrLn $ "Error: " ++ show err
     Right rs -> foreach fail print rs
 ```

doc/tutorial/tutorial.cabal

@@ -46,7 +46,6 @@ library
     , http-client
     , http-media
     , http-types
-    , kan-extensions
     , mtl
     , string-conversions
     , text

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 (..),
+                 EmptyAPI, FramingUnrender (..), FromSourceIO (..), Header',
-                 Header', Headers (..), HttpVersion, IsSecure,
+                 Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),
-                 MimeRender (mimeRender), MimeUnrender (mimeUnrender),
+                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,
-                 NoContent (NoContent), QueryFlag, QueryParam', QueryParams,
+                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,
-                 Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
+                 ReqBody', SBoolI, Stream, StreamBody, Summary, ToHttpApiData,
-                 StreamBody, Summary, ToHttpApiData, Vault, Verb,
+                 Vault, Verb, WithNamedContext, contentType, getHeadersHList,
-                 WithNamedContext, contentType, getHeadersHList, getResponse,
+                 getResponse, toQueryParam, toUrlPiece)
-                 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
+  clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do
-    sresp <- streamingRequest req
+      let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
-      { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
+          framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
-      , requestMethod = reflectMethod (Proxy :: Proxy method)
+      return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
-      }
+    where
-    return $ do
+      req' = req
-        let mimeUnrender'    = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk
+          { requestAccept = fromList [contentType (Proxy :: Proxy ct)]
-            framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender'
+          , requestMethod = reflectMethod (Proxy :: Proxy method)
-        gres <- sresp
+          }
-        return $ fromSourceIO $ framingUnrender' $ S.fromAction BS.null (responseBody gres)
-
 
 -- | 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-ghcjs/src/Servant/Client/Internal/XhrClient.hs

@@ -108,7 +108,6 @@ instance Exception StreamingNotSupportedException where
 
 instance RunClient ClientM where
   runRequest = performRequest
-  streamingRequest _ = liftIO $ throwIO StreamingNotSupportedException
   throwServantError = throwError
 
 instance ClientLike (ClientM a) (ClientM a) where

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,17 +140,6 @@ 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
-    -> (Either ServantError a -> IO b)  -- ^ continuation
-    -> IO b
-withClientM cm env k = do
-    e <- runExceptT (runReaderT (unClientM cm) env)
-    case e of
-        Left err  -> k (Left err)
-        Right cod -> runCodensity cod (k . Right)
-
 performRequest :: Request -> ClientM Response
 performRequest req = do
   ClientEnv m burl cookieJar' <- ask
@@ -186,21 +172,6 @@ performRequest req = do
         throwError $ FailureResponse ourResponse
       return ourResponse
 
-performStreamingRequest :: Request -> ClientM StreamingResponse
-performStreamingRequest req = do
-  m <- asks manager
-  burl <- asks baseUrl
-  let request = requestToClientRequest burl req
-  return $ Codensity $
-    \k -> Client.withResponse request m $
-    \r -> do
-      let status = Client.responseStatus r
-          status_code = statusCode status
-      unless (status_code >= 200 && status_code < 300) $ 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
   { responseStatusCode = Client.responseStatus r

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

@@ -0,0 +1,172 @@
+{-# LANGUAGE CPP                        #-}
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE FlexibleContexts           #-}
+{-# LANGUAGE FlexibleInstances          #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses      #-}
+{-# LANGUAGE RankNTypes                 #-}
+{-# LANGUAGE ScopedTypeVariables        #-}
+{-# LANGUAGE TypeFamilies               #-}
+module Servant.Client.Internal.HttpClient.Streaming (
+    module Servant.Client.Internal.HttpClient.Streaming,
+    ClientEnv (..),
+    mkClientEnv,
+    clientResponseToResponse,
+    requestToClientRequest,
+    catchConnectionError,
+    ) where
+
+import           Prelude ()
+import           Prelude.Compat
+
+import           Control.Concurrent.STM.TVar
+import           Control.Exception
+import           Control.Monad
+import           Control.Monad.Base
+                 (MonadBase (..))
+import           Control.Monad.Codensity
+                 (Codensity (..))
+import           Control.Monad.Error.Class
+                 (MonadError (..))
+import           Control.Monad.Reader
+import           Control.Monad.STM
+                 (atomically)
+import           Control.Monad.Trans.Except
+import qualified Data.ByteString.Lazy               as BSL
+import           Data.Foldable
+                 (for_)
+import           Data.Functor.Alt
+                 (Alt (..))
+import           Data.Proxy
+                 (Proxy (..))
+import           Data.Time.Clock
+                 (getCurrentTime)
+import           GHC.Generics
+import           Network.HTTP.Types
+                 (statusCode)
+
+import qualified Network.HTTP.Client                as Client
+
+import           Servant.Client.Core
+import           Servant.Client.Internal.HttpClient
+                 (ClientEnv (..), catchConnectionError,
+                 clientResponseToResponse, mkClientEnv, requestToClientRequest)
+
+
+-- | Generates a set of client functions for an API.
+--
+-- Example:
+--
+-- > type API = Capture "no" Int :> Get '[JSON] Int
+-- >        :<|> Get '[JSON] [Bool]
+-- >
+-- > api :: Proxy API
+-- > api = Proxy
+-- >
+-- > getInt :: Int -> ClientM Int
+-- > getBools :: ClientM [Bool]
+-- > getInt :<|> getBools = client api
+client :: HasClient ClientM api => Proxy api -> Client ClientM api
+client api = api `clientIn` (Proxy :: Proxy ClientM)
+
+-- | Change the monad the client functions live in, by
+--   supplying a conversion function
+--   (a natural transformation to be precise).
+--
+--   For example, assuming you have some @manager :: 'Manager'@ and
+--   @baseurl :: 'BaseUrl'@ around:
+--
+--   > type API = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
+--   > api :: Proxy API
+--   > api = Proxy
+--   > getInt :: IO Int
+--   > postInt :: Int -> IO Int
+--   > getInt :<|> postInt = hoistClient api (flip runClientM cenv) (client api)
+--   >   where cenv = mkClientEnv manager baseurl
+hoistClient
+  :: HasClient ClientM api
+  => Proxy api
+  -> (forall a. m a -> n a)
+  -> Client m api
+  -> Client n api
+hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
+
+-- | @ClientM@ is the monad in which client functions run. Contains the
+-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
+newtype ClientM a = ClientM
+  { unClientM :: ReaderT ClientEnv (ExceptT ServantError (Codensity IO)) a }
+  deriving ( Functor, Applicative, Monad, MonadIO, Generic
+           , MonadReader ClientEnv, MonadError ServantError)
+
+instance MonadBase IO ClientM where
+  liftBase = ClientM . liftIO
+
+-- | Try clients in order, last error is preserved.
+instance Alt ClientM where
+  a <!> b = a `catchError` \_ -> b
+
+instance RunClient ClientM where
+  runRequest = performRequest
+  throwServantError = throwError
+
+instance RunStreamingClient ClientM where
+  withStreamingRequest = performWithStreamingRequest
+
+instance ClientLike (ClientM a) (ClientM a) where
+  mkClient = id
+
+withClientM :: ClientM a -> ClientEnv -> (Either ServantError a -> IO b) -> IO b
+withClientM cm env k =
+    let Codensity f = runExceptT $ flip runReaderT env $ unClientM cm
+    in f k
+
+performRequest :: Request -> ClientM Response
+performRequest req = do
+    -- TODO: should use Client.withResponse here too
+  ClientEnv m burl cookieJar' <- ask
+  let clientRequest = requestToClientRequest burl req
+  request <- case cookieJar' of
+    Nothing -> pure clientRequest
+    Just cj -> liftIO $ do
+      now <- getCurrentTime
+      atomically $ do
+        oldCookieJar <- readTVar cj
+        let (newRequest, newCookieJar) =
+              Client.insertCookiesIntoRequest
+                (requestToClientRequest burl req)
+                oldCookieJar
+                now
+        writeTVar cj newCookieJar
+        pure newRequest
+
+  eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m
+  case eResponse of
+    Left err -> throwError err
+    Right response -> do
+      for_ cookieJar' $ \cj -> liftIO $ do
+        now' <- getCurrentTime
+        atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now')
+      let status = Client.responseStatus response
+          status_code = statusCode status
+          ourResponse = clientResponseToResponse response
+      unless (status_code >= 200 && status_code < 300) $
+        throwError $ FailureResponse ourResponse
+      return ourResponse
+
+performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
+performWithStreamingRequest req k = do
+  m <- asks manager
+  burl <- asks baseUrl
+  let request = requestToClientRequest burl req
+  ClientM $ lift $ lift $ Codensity $ \k1 ->
+      Client.withResponse request m $ \res -> do
+          let status = Client.responseStatus res
+              status_code = statusCode status
+
+          -- we throw FailureResponse in IO :(
+          unless (status_code >= 200 && status_code < 300) $ do
+              b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res)
+              throwIO $ FailureResponse $ clientResponseToResponse res { Client.responseBody = b }
+
+          x <- k (clientResponseToResponse res)
+          k1 x

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

@@ -0,0 +1,17 @@
+-- | This module provides 'client' which can automatically generate
+-- querying functions for each endpoint just from the type representing your
+-- API.
+--
+-- This client supports streaming operations.
+module Servant.Client.Streaming
+    ( client
+    , ClientM
+    , withClientM
+    , ClientEnv(..)
+    , mkClientEnv
+    , hoistClient
+    , module Servant.Client.Core.Reexport
+    ) where
+
+import           Servant.Client.Core.Reexport
+import           Servant.Client.Internal.HttpClient.Streaming

servant-client/test/Servant/ClientSpec.hs

@@ -72,7 +72,7 @@ import           Servant.Server
 import           Servant.Server.Experimental.Auth
 
 -- This declaration simply checks that all instances are in place.
-_ = client comprehensiveAPI
+_ = client comprehensiveAPIWithoutStreaming
 
 spec :: Spec
 spec = describe "Servant.Client" $ do

servant-client/test/Servant/StreamSpec.hs

@@ -28,20 +28,21 @@ import           Control.Monad.Codensity
 import           Control.Monad.IO.Class
                  (MonadIO (..))
 import           Control.Monad.Trans.Except
-import qualified Data.ByteString            as BS
+import qualified Data.ByteString               as BS
 import           Data.Proxy
-import qualified Data.TDigest               as TD
+import qualified Data.TDigest                  as TD
-import qualified Network.HTTP.Client        as C
+import qualified Network.HTTP.Client           as C
 import           Prelude ()
 import           Prelude.Compat
 import           Servant.API
                  ((:<|>) ((:<|>)), (:>), JSON, NetstringFraming,
                  NewlineFraming, NoFraming, OctetStream, SourceIO, StreamGet)
-import           Servant.Client
+import           Servant.Client.Streaming
 import           Servant.ClientSpec
                  (Person (..))
-import qualified Servant.ClientSpec         as CS
+import qualified Servant.ClientSpec            as CS
 import           Servant.Server
+import           Servant.Test.ComprehensiveAPI
 import           Servant.Types.SourceT
 import           System.Entropy
                  (getEntropy, getHardwareEntropy)
@@ -59,8 +60,12 @@ import           GHC.Stats
                  (currentBytesUsed, getGCStats)
 #endif
 
+-- This declaration simply checks that all instances are in place.
+-- Note: this is streaming client
+_ = client comprehensiveAPI
+
 spec :: Spec
-spec = describe "Servant.Stream" $ do
+spec = describe "Servant.Client.Streaming" $ do
     streamSpec
 
 type StreamApi =
@@ -71,8 +76,8 @@ type StreamApi =
 api :: Proxy StreamApi
 api = Proxy
 
-getGetNL, getGetNS :: ClientM (Codensity IO (SourceIO Person))
+getGetNL, getGetNS :: ClientM (SourceIO Person)
-getGetALot :: ClientM (Codensity IO (SourceIO BS.ByteString))
+getGetALot :: ClientM (SourceIO BS.ByteString)
 getGetNL :<|> getGetNS :<|> getGetALot = client api
 
 alice :: Person
@@ -104,28 +109,22 @@ powerOfTwo = (2 ^)
 manager' :: C.Manager
 manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
 
-runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)
+withClient :: ClientM a -> BaseUrl -> (Either ServantError a -> IO r) -> IO r
-runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')
+withClient x baseUrl' = withClientM x (mkClientEnv manager' baseUrl')
 
-testRunSourceIO :: Codensity IO (SourceIO a)
+testRunSourceIO :: SourceIO a
     -> IO (Either String [a])
-testRunSourceIO = runExceptT . runSourceT . joinCodensitySourceT
+testRunSourceIO = runExceptT . runSourceT
-
-joinCodensitySourceT :: Codensity m (SourceT m a) -> SourceT m a
-joinCodensitySourceT cod =
-    SourceT $ \r ->
-    runCodensity cod $ \src ->
-    unSourceT src r
 
 streamSpec :: Spec
 streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do
     it "works with Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do
-        Right res <- runClient getGetNL baseUrl
+        withClient getGetNL baseUrl $ \(Right res) ->
-        testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
+            testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
 
     it "works with Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do
-        Right res <- runClient getGetNS baseUrl
+        withClient getGetNS baseUrl $ \(Right res) ->
-        testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
+            testRunSourceIO res `shouldReturn` Right [alice, bob, alice]
 
 {-
     it "streams in constant memory" $ \(_, baseUrl) -> do

servant-conduit/example/Main.hs

@@ -27,7 +27,7 @@ import           Text.Read
 import           Data.Conduit
 import qualified Data.Conduit.Combinators     as C
 import           Servant
-import           Servant.Client
+import           Servant.Client.Streaming
 import           Servant.Conduit ()
 
 import qualified Network.Wai.Handler.Warp     as Warp

servant-docs/golden/comprehensive.md

@@ -16,6 +16,42 @@
 
 ```
 
+## GET /alternative/left
+
+### Response:
+
+- Status code 200
+- Headers: []
+
+- Supported content types are:
+
+    - `application/json;charset=utf-8`
+    - `application/json`
+
+- Example (`application/json;charset=utf-8`, `application/json`):
+
+```javascript
+
+```
+
+## GET /alternative/right
+
+### Response:
+
+- Status code 200
+- Headers: []
+
+- Supported content types are:
+
+    - `application/json;charset=utf-8`
+    - `application/json`
+
+- Example (`application/json;charset=utf-8`, `application/json`):
+
+```javascript
+
+```
+
 ## GET /capture/:foo
 
 ### Captures:

servant-machines/example/Main.hs

@@ -26,7 +26,7 @@ import           Text.Read
 
 import           Data.Machine
 import           Servant
-import           Servant.Client
+import           Servant.Client.Streaming
 import           Servant.Machines ()
 
 import qualified Network.Wai.Handler.Warp as Warp

servant-pipes/example/Main.hs

@@ -19,18 +19,19 @@ import           Network.Wai
                  (Application)
 import           System.Environment
                  (getArgs, lookupEnv)
-import System.IO (IOMode (..))
+import           System.IO
+                 (IOMode (..))
 import           Text.Read
                  (readMaybe)
 
 import qualified Pipes                    as P
+import           Pipes.ByteString         as PBS
 import qualified Pipes.Prelude            as P
 import           Pipes.Safe
                  (SafeT)
 import qualified Pipes.Safe.Prelude       as P
 import           Servant
-import Pipes.ByteString as PBS
+import           Servant.Client.Streaming
-import           Servant.Client
 import           Servant.Pipes ()
 
 import qualified Network.Wai.Handler.Warp as Warp

servant/src/Servant/Test/ComprehensiveAPI.hs

@@ -15,38 +15,64 @@ import           Servant.Types.SourceT
 type GET = Get '[JSON] NoContent
 
 type ComprehensiveAPI =
-  ComprehensiveAPIWithoutRaw :<|>
+    ComprehensiveAPIWithoutStreamingOrRaw'
-  "raw" :> Raw
+    (EmptyEndpoint :<|> StreamingEndpoint :<|> RawEndpoint)
+
+type RawEndpoint =
+    "raw" :> Raw
+
+type StreamingEndpoint =
+    "streaming" :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int)
+
+type EmptyEndpoint =
+    "empty-api" :> EmptyAPI
 
 comprehensiveAPI :: Proxy ComprehensiveAPI
 comprehensiveAPI = Proxy
 
 type ComprehensiveAPIWithoutRaw =
-  GET :<|>
+    ComprehensiveAPIWithoutStreamingOrRaw'
-  "get-int"          :> Get '[JSON] Int :<|>
+    (EmptyEndpoint :<|> StreamingEndpoint)
-  "capture"          :> Capture' '[Description "example description"] "foo" Int :> GET :<|>
-  "header"           :> Header "foo" Int :> GET :<|>
-  "header-lenient"   :> Header' '[Required, Lenient] "bar" Int :> GET :<|>
-  "http-version"     :> HttpVersion :> GET :<|>
-  "is-secure"        :> IsSecure :> GET :<|>
-  "param"            :> QueryParam "foo" Int :> GET :<|>
-  "param-lenient"    :>  QueryParam' '[Required, Lenient] "bar" Int :> GET :<|>
-  "params"           :> QueryParams "foo" Int :> GET :<|>
-  "flag"             :> QueryFlag "foo" :> GET :<|>
-  "remote-host"      :> RemoteHost :> GET :<|>
-  "req-body"         :> ReqBody '[JSON] Int :> GET :<|>
-  "req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET :<|>
-  "res-headers"      :> Get '[JSON] (Headers '[Header "foo" Int] NoContent) :<|>
-  "foo"              :> GET :<|>
-  "vault"            :> Vault :> GET :<|>
-  "post-no-content"  :> Verb 'POST 204 '[JSON] NoContent :<|>
-  "post-int"         :> Verb 'POST 204 '[JSON] Int :<|>
-  "streaming"        :> StreamBody NetstringFraming JSON (SourceT IO Int) :> Stream 'GET 200 NetstringFraming JSON (SourceT IO Int) :<|>
-  "named-context"    :> WithNamedContext "foo" '[] GET :<|>
-  "capture-all"      :>  CaptureAll "foo" Int :> GET :<|>
-  "summary"          :> Summary "foo" :> GET :<|>
-  "description"      :> Description "foo" :> GET :<|>
-  "empty-api"        :> EmptyAPI
 
 comprehensiveAPIWithoutRaw :: Proxy ComprehensiveAPIWithoutRaw
 comprehensiveAPIWithoutRaw = Proxy
+
+type ComprehensiveAPIWithoutStreaming =
+    ComprehensiveAPIWithoutStreamingOrRaw'
+    (EmptyEndpoint :<|> RawEndpoint)
+
+comprehensiveAPIWithoutStreaming :: Proxy ComprehensiveAPIWithoutStreaming
+comprehensiveAPIWithoutStreaming = Proxy
+
+-- | @:: API -> API@, so we have linear structure of the API.
+type ComprehensiveAPIWithoutStreamingOrRaw' endpoint =
+    GET
+    :<|> "get-int"          :> Get '[JSON] Int
+    :<|> "capture"          :> Capture' '[Description "example description"] "foo" Int :> GET
+    :<|> "header"           :> Header "foo" Int :> GET
+    :<|> "header-lenient"   :> Header' '[Required, Lenient] "bar" Int :> GET
+    :<|> "http-version"     :> HttpVersion :> GET
+    :<|> "is-secure"        :> IsSecure :> GET
+    :<|> "param"            :> QueryParam "foo" Int :> GET
+    :<|> "param-lenient"    :> QueryParam' '[Required, Lenient] "bar" Int :> GET
+    :<|> "params"           :> QueryParams "foo" Int :> GET
+    :<|> "flag"             :> QueryFlag "foo" :> GET
+    :<|> "remote-host"      :> RemoteHost :> GET
+    :<|> "req-body"         :> ReqBody '[JSON] Int :> GET
+    :<|> "req-body-lenient" :> ReqBody' '[Lenient] '[JSON] Int :> GET
+    :<|> "res-headers"      :> Get '[JSON] (Headers '[Header "foo" Int] NoContent)
+    :<|> "foo"              :> GET
+    :<|> "vault"            :> Vault :> GET
+    :<|> "post-no-content"  :> Verb 'POST 204 '[JSON] NoContent
+    :<|> "post-int"         :> Verb 'POST 204 '[JSON] Int
+    :<|> "named-context"    :> WithNamedContext "foo" '[] GET
+    :<|> "capture-all"      :> CaptureAll "foo" Int :> GET
+    :<|> "summary"          :> Summary "foo" :> GET
+    :<|> "description"      :> Description "foo" :> GET
+    :<|> "alternative"      :> ("left" :> GET :<|> "right" :> GET)
+    :<|> endpoint
+
+type ComprehensiveAPIWithoutStreamingOrRaw = ComprehensiveAPIWithoutStreamingOrRaw' EmptyEndpoint
+
+comprehensiveAPIWithoutStreamingOrRaw :: Proxy ComprehensiveAPIWithoutStreamingOrRaw
+comprehensiveAPIWithoutStreamingOrRaw = Proxy

servant/test/Servant/LinksSpec.hs

@@ -89,7 +89,7 @@ spec = describe "Servant.Links" $ do
         allNames ["Seneca", "Aurelius"] `shouldBeLink` "all/Seneca/Aurelius"
 
     it "can generate all links for ComprehensiveAPIWithoutRaw" $ do
-        let (firstLink :<|> _) = allLinks comprehensiveAPIWithoutRaw
+        let firstLink :<|> _ = allLinks comprehensiveAPIWithoutRaw
         firstLink `shouldBeLink` ""
 
 -- |