Refactor servant-client-core

- No more Internal modules
- Remove ClientLike-generic. Let's use Routes-generics
    - Let's see if anyone notices, otherwise we can add it back
- Add Makefile for common tasks
    - Fix servant-client-ghcjs

.gitignore

@@ -1,5 +1,5 @@
 **/*/dist
-dist-newstyle
+dist-*
 .ghc.environment.*
 /bin
 /lib

Makefile

@@ -0,0 +1,13 @@
+# With common maintenance tasks
+
+all :
+	@echo "Don't try to make all at once!"
+
+build-ghc :
+	cabal v2-build all
+
+build-ghcjs :
+	cabal v2-build --builddir=dist-newstyle-ghcjs --project-file=cabal.ghcjs.project all
+
+packdeps :
+	packdeps */*.cabal

cabal.ghcjs.project

@@ -1,6 +1,4 @@
 -- Using https://launchpad.net/~hvr/+archive/ubuntu/ghcjs
---
--- $ cabal new-build --project-file cabal.ghcjs.project all -w /opt/ghcjs/8.4/bin/ghcjs
 
 packages:
   servant/
@@ -9,16 +7,3 @@ packages:
 
 -- we need to tell cabal we are using GHCJS
 compiler: ghcjs
-
--- https://github.com/ghcjs/ghcjs/issues/665
-constraints: primitive <0.6.4
-
--- ghcjs-base wants old aeson
-allow-newer: ghcjs-base:aeson
-
--- https://github.com/nomeata/hackage-ghcjs-overlay
-repository ghcjs-overlay
-  url: http://hackage-ghcjs-overlay.nomeata.de/
-  secure: True
-  root-keys:
-  key-threshold: 0

doc/cookbook/using-free-client/UsingFreeClient.lhs

@@ -99,8 +99,6 @@ test = case getSquare 42 of
         putStrLn $ "ERROR: got pure result: " ++ show n
     Free (Throw err) ->
         putStrLn $ "ERROR: got error right away: " ++ show err
-    Free (StreamingRequest _req _k) ->
-        putStrLn $ "ERROR: need to do streaming request" -- TODO: no Show Req :(
 ```
 
 We are interested in `RunRequest`, that's what client should block on:

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

@@ -36,16 +36,17 @@ library
       Servant.Client.Free
       Servant.Client.Generic
       Servant.Client.Core.Reexport
-      Servant.Client.Core.Internal.Auth
+      Servant.Client.Core.Auth
-      Servant.Client.Core.Internal.BaseUrl
+      Servant.Client.Core.BaseUrl
-      Servant.Client.Core.Internal.BasicAuth
+      Servant.Client.Core.BasicAuth
-      Servant.Client.Core.Internal.ClientError
+      Servant.Client.Core.ClientError
-      Servant.Client.Core.Internal.ClientF
+      Servant.Client.Core.HasClient
-      Servant.Client.Core.Internal.Generic
+      Servant.Client.Core.Request
-      Servant.Client.Core.Internal.HasClient
+      Servant.Client.Core.Response
-      Servant.Client.Core.Internal.Request
+      Servant.Client.Core.RunClient
-      Servant.Client.Core.Internal.Response
+
-      Servant.Client.Core.Internal.RunClient
+  other-modules:
+      Servant.Client.Core.Internal
 
   -- Bundled with GHC: Lower bound to not force re-installs
   -- text and mtl are bundled starting with GHC-8.4
@@ -76,7 +77,6 @@ library
     , base64-bytestring     >= 1.0.0.1  && < 1.1
     , exceptions            >= 0.10.0   && < 0.11
     , free                  >= 5.1      && < 5.2
-    , generics-sop          >= 0.4.0.1  && < 0.5
     , http-media            >= 0.7.1.3  && < 0.8
     , http-types            >= 0.12.2   && < 0.13
     , network-uri           >= 2.6.1.0  && < 2.7

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

@@ -32,18 +32,20 @@ module Servant.Client.Core
   , AuthClientData
 
   -- * Generic Client
-  , ClientLike(..)
-  , genericMkClientL
-  , genericMkClientP
   , ServantError(..)
   , EmptyClient(..)
 
-
   -- * Response
   , Response
   , ResponseF (..)
   , RunClient(..)
-  , module Servant.Client.Core.Internal.BaseUrl
+  -- * BaseUrl
+  , BaseUrl (..)
+  , Scheme (..)
+  , showBaseUrl
+  , parseBaseUrl
+  , InvalidBaseUrlException (..)
+
   -- ** Streaming
   , RunStreamingClient(..)
   , StreamingResponse
@@ -56,14 +58,13 @@ module Servant.Client.Core
   , setRequestBodyLBS
   , setRequestBody
   ) where
-import           Servant.Client.Core.Internal.Auth
+import           Servant.Client.Core.Auth
-import           Servant.Client.Core.Internal.BaseUrl
+import           Servant.Client.Core.BaseUrl
-                 (BaseUrl (..), InvalidBaseUrlException, Scheme (..),
+                 (BaseUrl (..), InvalidBaseUrlException (..), Scheme (..),
                  parseBaseUrl, showBaseUrl)
-import           Servant.Client.Core.Internal.BasicAuth
+import           Servant.Client.Core.BasicAuth
-import           Servant.Client.Core.Internal.Generic
+import           Servant.Client.Core.ClientError
-import           Servant.Client.Core.Internal.HasClient
+import           Servant.Client.Core.HasClient
-import           Servant.Client.Core.Internal.Request
+import           Servant.Client.Core.Request
-import           Servant.Client.Core.Internal.Response
+import           Servant.Client.Core.Response
-import           Servant.Client.Core.Internal.ClientError
+import           Servant.Client.Core.RunClient
-import           Servant.Client.Core.Internal.RunClient

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

@@ -4,9 +4,13 @@
 
 -- | Authentication for clients
 
-module Servant.Client.Core.Internal.Auth where
+module Servant.Client.Core.Auth (
+    AuthClientData,
+    AuthenticatedRequest (..),
+    mkAuthenticatedRequest,
+    ) where
 
-import           Servant.Client.Core.Internal.Request
+import           Servant.Client.Core.Request
                  (Request)
 
 -- | For a resource protected by authentication (e.g. AuthProtect), we need

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

@@ -2,7 +2,13 @@
 {-# LANGUAGE DeriveGeneric      #-}
 {-# LANGUAGE DeriveLift         #-}
 {-# LANGUAGE ViewPatterns       #-}
-module Servant.Client.Core.Internal.BaseUrl where
+module Servant.Client.Core.BaseUrl (
+    BaseUrl (..),
+    Scheme (..),
+    showBaseUrl,
+    parseBaseUrl,
+    InvalidBaseUrlException (..),
+    ) where
 
 import           Control.DeepSeq
                  (NFData (..))

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

@@ -3,8 +3,9 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 
 -- | Basic Authentication for clients
-
+module Servant.Client.Core.BasicAuth (
-module Servant.Client.Core.Internal.BasicAuth where
+    basicAuthReq,
+    ) where
 
 import           Data.ByteString.Base64
                  (encode)
@@ -14,7 +15,7 @@ import           Data.Text.Encoding
                  (decodeUtf8)
 import           Servant.API.BasicAuth
                  (BasicAuthData (BasicAuthData))
-import           Servant.Client.Core.Internal.Request
+import           Servant.Client.Core.Request
                  (Request, addHeader)
 
 -- | Authenticate a request using Basic Authentication

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

@@ -8,7 +8,9 @@
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
-module Servant.Client.Core.Internal.ClientError where
+module Servant.Client.Core.ClientError (
+    ServantError (..),
+    ) where
 
 import           Prelude ()
 import           Prelude.Compat
@@ -19,20 +21,22 @@ import           Control.Exception
                  (SomeException (..))
 import           Control.Monad.Catch
                  (Exception)
-import qualified Data.ByteString                       as BS
+import qualified Data.ByteString              as BS
 import           Data.Text
                  (Text)
 import           Data.Typeable
                  (Typeable, typeOf)
 import           GHC.Generics
                  (Generic)
-import           Network.HTTP.Media (MediaType)
+import           Network.HTTP.Media
+                 (MediaType)
 import           Network.HTTP.Types ()
 
-import           Servant.Client.Core.Internal.BaseUrl
+import           Servant.Client.Core.BaseUrl
-import           Servant.Client.Core.Internal.Request
+import           Servant.Client.Core.Internal
-import           Servant.Client.Core.Internal.Response
+                 (mediaTypeRnf)
-
+import           Servant.Client.Core.Request
+import           Servant.Client.Core.Response
 
 
 -- | A type representing possible errors in a request

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

@@ -11,11 +11,17 @@
 {-# LANGUAGE TypeOperators         #-}
 {-# LANGUAGE UndecidableInstances  #-}
 
-module Servant.Client.Core.Internal.HasClient where
+module Servant.Client.Core.HasClient (
+    clientIn,
+    HasClient (..),
+    EmptyClient (..),
+    ) where
 
 import           Prelude ()
 import           Prelude.Compat
 
+import           Control.Monad
+                 (unless)
 import qualified Data.ByteString.Lazy                     as BL
 import           Data.Foldable
                  (toList)
@@ -25,6 +31,9 @@ import           Data.Proxy
                  (Proxy (Proxy))
 import           Data.Sequence
                  (fromList)
+import qualified Data.Text                       as T
+import           Network.HTTP.Media
+                 (MediaType, matches, parseAccept, (//))
 import           Data.String
                  (fromString)
 import           Data.Text
@@ -48,12 +57,12 @@ import           Servant.API.ContentTypes
 import           Servant.API.Modifiers
                  (FoldRequired, RequiredArgument, foldRequiredArgument)
 
-import           Servant.Client.Core.Internal.Auth
+import           Servant.Client.Core.Auth
-import           Servant.Client.Core.Internal.BasicAuth
+import           Servant.Client.Core.BasicAuth
-import           Servant.Client.Core.Internal.ClientError
+import           Servant.Client.Core.ClientError
-import           Servant.Client.Core.Internal.Request
+import           Servant.Client.Core.Request
-import           Servant.Client.Core.Internal.Response
+import           Servant.Client.Core.Response
-import           Servant.Client.Core.Internal.RunClient
+import           Servant.Client.Core.RunClient
 
 -- * Accessing APIs as a Client
 
@@ -627,6 +636,7 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
     hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
 
 
+
 {- Note [Non-Empty Content Types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Rather than have
@@ -642,3 +652,27 @@ non-empty lists, but is otherwise more specific, no instance will be overall
 more specific. This in turn generally means adding yet another instance (one
 for empty and one for non-empty lists).
 -}
+
+-------------------------------------------------------------------------------
+-- helpers
+-------------------------------------------------------------------------------
+
+checkContentTypeHeader :: RunClient m => Response -> m MediaType
+checkContentTypeHeader response =
+  case lookup "Content-Type" $ toList $ responseHeaders response of
+    Nothing -> return $ "application"//"octet-stream"
+    Just t -> case parseAccept t of
+      Nothing -> throwServantError $ InvalidContentTypeHeader response
+      Just t' -> return t'
+
+decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
+  => Response -> Proxy ct -> m a
+decodedAs response ct = do
+  responseContentType <- checkContentTypeHeader response
+  unless (any (matches responseContentType) accept) $
+    throwServantError $ UnsupportedContentType responseContentType response
+  case mimeUnrender ct $ responseBody response of
+    Left err -> throwServantError $ DecodeFailure (T.pack err) response
+    Right val -> return val
+  where
+    accept = toList $ contentTypes ct 

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

@@ -0,0 +1,12 @@
+module Servant.Client.Core.Internal where
+
+import           Control.DeepSeq
+                 (rnf)
+import           Network.HTTP.Media
+                 (MediaType, mainType, parameters, subType)
+
+mediaTypeRnf :: MediaType -> ()
+mediaTypeRnf mt =
+    rnf (mainType mt) `seq`
+    rnf (subType mt) `seq`
+    rnf (parameters mt)

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

@@ -1,12 +0,0 @@
-{-# LANGUAGE DeriveFunctor #-}
-module Servant.Client.Core.Internal.ClientF where
-
-import           Servant.Client.Core.Internal.Request
-import           Servant.Client.Core.Internal.Response
-import           Servant.Client.Core.Internal.ClientError
-
-data ClientF a
-    = RunRequest Request (Response -> a)
-    | StreamingRequest Request (StreamingResponse -> a)
-    | Throw ServantError
-  deriving (Functor)

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

@@ -1,155 +0,0 @@
-{-# LANGUAGE DataKinds             #-}
-{-# LANGUAGE DefaultSignatures     #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE FlexibleInstances     #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE TypeOperators         #-}
-{-# LANGUAGE UndecidableInstances  #-}
-
-module Servant.Client.Core.Internal.Generic where
-
-import           Generics.SOP
-                 (Code, Generic, I (..), NP (..), NS (Z), SOP (..), to)
-import           Servant.API
-                 ((:<|>) (..))
-
--- | This class allows us to match client structure with client functions
--- produced with 'client' without explicit pattern-matching.
---
--- The client structure needs a 'Generics.SOP.Generic' instance.
---
--- Example:
---
--- > type API
--- >     = "foo" :> Capture "x" Int :> Get '[JSON] Int
--- >  :<|> "bar" :> QueryParam "a" Char :> QueryParam "b" String :> Post '[JSON] [Int]
--- >  :<|> Capture "nested" Int :> NestedAPI
--- >
--- > type NestedAPI
--- >     = Get '[JSON] String
--- >  :<|> "baz" :> QueryParam "c" Char :> Post '[JSON] ()
--- >
--- > data APIClient = APIClient
--- >   { getFoo         :: Int -> ClientM Int
--- >   , postBar        :: Maybe Char -> Maybe String -> ClientM [Int]
--- >   , mkNestedClient :: Int -> NestedClient
--- >   } deriving GHC.Generic
--- >
--- > instance Generics.SOP.Generic APIClient
--- > instance (Client API ~ client) => ClientLike client APIClient
--- >
--- > data NestedClient = NestedClient
--- >  { getString :: ClientM String
--- >  , postBaz   :: Maybe Char -> ClientM ()
--- >  } deriving GHC.Generic
--- >
--- > instance Generics.SOP.Generic NestedClient
--- > instance (Client NestedAPI ~ client) => ClientLike client NestedClient
--- >
--- > mkAPIClient :: APIClient
--- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
---
--- By default, left-nested alternatives are expanded:
---
--- > type API1
--- >     = "foo" :> Capture "x" Int :> Get '[JSON] Int
--- >  :<|> "bar" :> QueryParam "a" Char :> Post '[JSON] String
--- >
--- > type API2
--- >     = "baz" :> QueryParam "c" Char :> Post '[JSON] ()
--- >
--- > type API = API1 :<|> API2
--- >
--- > data APIClient = APIClient
--- >   { getFoo  :: Int -> ClientM Int
--- >   , postBar :: Maybe Char -> ClientM String
--- >   , postBaz :: Maybe Char -> ClientM ()
--- >   } deriving GHC.Generic
--- >
--- > instance Generics.SOP.Generic APIClient
--- > instance (Client API ~ client) => ClientLike client APIClient
--- >
--- > mkAPIClient :: APIClient
--- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
---
--- If you want to define client for @API1@ as a separate data structure,
--- you can use 'genericMkClientP':
---
--- > data APIClient1 = APIClient1
--- >   { getFoo  :: Int -> ClientM Int
--- >   , postBar :: Maybe Char -> ClientM String
--- >   } deriving GHC.Generic
--- >
--- > instance Generics.SOP.Generic APIClient1
--- > instance (Client API1 ~ client) => ClientLike client APIClient1
--- >
--- > data APIClient = APIClient
--- >   { mkAPIClient1 :: APIClient1
--- >   , postBaz      :: Maybe Char -> ClientM ()
--- >   } deriving GHC.Generic
--- >
--- > instance Generics.SOP.Generic APIClient
--- > instance (Client API ~ client) => ClientLike client APIClient where
--- >   mkClient = genericMkClientP
--- >
--- > mkAPIClient :: APIClient
--- > mkAPIClient = mkClient (client (Proxy :: Proxy API))
-class ClientLike client custom where
-  mkClient :: client -> custom
-  default mkClient :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
-    => client -> custom
-  mkClient = genericMkClientL
-
-instance ClientLike client custom
-      => ClientLike (a -> client) (a -> custom) where
-  mkClient c = mkClient . c
-
--- | Match client structure with client functions, regarding left-nested API clients
--- as separate data structures.
-class GClientLikeP client xs where
-  gMkClientP :: client -> NP I xs
-
-instance (GClientLikeP b (y ': xs), ClientLike a x)
-      => GClientLikeP (a :<|> b) (x ': y ': xs) where
-  gMkClientP (a :<|> b) = I (mkClient a) :* gMkClientP b
-
-instance ClientLike a x => GClientLikeP a '[x] where
-  gMkClientP a = I (mkClient a) :* Nil
-
--- | Match client structure with client functions, expanding left-nested API clients
--- in the same structure.
-class GClientLikeL (xs :: [*]) (ys :: [*]) where
-  gMkClientL :: NP I xs -> NP I ys
-
-instance GClientLikeL '[] '[] where
-  gMkClientL Nil = Nil
-
-instance (ClientLike x y, GClientLikeL xs ys) => GClientLikeL (x ': xs) (y ': ys) where
-  gMkClientL (I x :* xs) = I (mkClient x) :* gMkClientL xs
-
-type family ClientList (client :: *) (acc :: [*]) :: [*] where
-  ClientList (a :<|> b) acc = ClientList a (ClientList b acc)
-  ClientList a acc = a ': acc
-
-class GClientList client (acc :: [*]) where
-  gClientList :: client -> NP I acc -> NP I (ClientList client acc)
-
-instance (GClientList b acc, GClientList a (ClientList b acc))
-  => GClientList (a :<|> b) acc where
-  gClientList (a :<|> b) acc = gClientList a (gClientList b acc)
-
-instance {-# OVERLAPPABLE #-} (ClientList client acc ~ (client ': acc))
-  => GClientList client acc where
-  gClientList c acc = I c :* acc
-
--- | Generate client structure from client type, expanding left-nested API (done by default).
-genericMkClientL :: (Generic custom, Code custom ~ '[xs], GClientList client '[], GClientLikeL (ClientList client '[]) xs)
-  => client -> custom
-genericMkClientL = to . SOP . Z . gMkClientL . flip gClientList Nil
-
--- | Generate client structure from client type, regarding left-nested API clients as separate data structures.
-genericMkClientP :: (Generic custom, Code custom ~ '[xs], GClientLikeP client xs)
-  => client -> custom
-genericMkClientP = to . SOP . Z . gMkClientP
-

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

@@ -1,67 +0,0 @@
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE OverloadedStrings     #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TypeFamilies          #-}
--- | Types for possible backends to run client-side `Request` queries
-module Servant.Client.Core.Internal.RunClient where
-
-import           Prelude ()
-import           Prelude.Compat
-
-import           Control.Monad
-                 (unless)
-import           Control.Monad.Free
-                 (Free (..), liftF)
-import           Data.Foldable
-                 (toList)
-import           Data.Proxy
-                 (Proxy)
-import qualified Data.Text                            as T
-import           Network.HTTP.Media
-                 (MediaType, matches, parseAccept, (//))
-import           Servant.API
-                 (MimeUnrender, contentTypes, mimeUnrender)
-
-import           Servant.Client.Core.Internal.ClientF
-import           Servant.Client.Core.Internal.Request
-import           Servant.Client.Core.Internal.Response
-import           Servant.Client.Core.Internal.ClientError
-
-class Monad m => RunClient m where
-  -- | How to make a request.
-  runRequest :: Request -> m Response
-  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
-    Nothing -> return $ "application"//"octet-stream"
-    Just t -> case parseAccept t of
-      Nothing -> throwServantError $ InvalidContentTypeHeader response
-      Just t' -> return t'
-
-decodedAs :: forall ct a m. (MimeUnrender ct a, RunClient m)
-  => Response -> Proxy ct -> m a
-decodedAs response contentType = do
-  responseContentType <- checkContentTypeHeader response
-  unless (any (matches responseContentType) accept) $
-    throwServantError $ UnsupportedContentType responseContentType response
-  case mimeUnrender contentType $ responseBody response of
-    Left err -> throwServantError $ DecodeFailure (T.pack err) response
-    Right val -> return val
-  where
-    accept = toList $ contentTypes contentType
-
-instance ClientF ~ f => RunClient (Free f) where
-    runRequest req  = liftF (RunRequest req id)
-    throwServantError = liftF . Throw
-
-{-
-Free and streaming?
-instance ClientF ~ f => RunStreamingClient (Free f) where
-    streamingRequest req = liftF (StreamingRequest req id)
--}

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

@@ -11,10 +11,7 @@ module Servant.Client.Core.Reexport
   , StreamingResponse
   , ResponseF(..)
 
-  -- * Generic Client
+  -- * Data types
-  , ClientLike(..)
-  , genericMkClientL
-  , genericMkClientP
   , ServantError(..)
   , EmptyClient(..)
 
@@ -27,8 +24,7 @@ module Servant.Client.Core.Reexport
   ) where
 
 
-import           Servant.Client.Core.Internal.BaseUrl
+import           Servant.Client.Core.BaseUrl
-import           Servant.Client.Core.Internal.Generic
+import           Servant.Client.Core.HasClient
-import           Servant.Client.Core.Internal.HasClient
+import           Servant.Client.Core.Response
-import           Servant.Client.Core.Internal.Response
+import           Servant.Client.Core.ClientError
-import           Servant.Client.Core.Internal.ClientError

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

@@ -8,8 +8,18 @@
 {-# LANGUAGE RankNTypes            #-}
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
-
+module Servant.Client.Core.Request (
-module Servant.Client.Core.Internal.Request where
+    Request,
+    RequestF (..),
+    RequestBody (..),
+    defaultRequest,
+    -- ** Modifiers
+    addHeader,
+    appendToPath,
+    appendToQueryString,
+    setRequestBody,
+    setRequestBodyLBS,
+    ) where
 
 import           Prelude ()
 import           Prelude.Compat
@@ -37,18 +47,14 @@ import           Data.Typeable
 import           GHC.Generics
                  (Generic)
 import           Network.HTTP.Media
-                 (MediaType, mainType, parameters, subType)
+                 (MediaType)
 import           Network.HTTP.Types
                  (Header, HeaderName, HttpVersion (..), Method, QueryItem,
                  http11, methodGet)
 import           Servant.API
                  (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)
 
-mediaTypeRnf :: MediaType -> ()
+import Servant.Client.Core.Internal (mediaTypeRnf)
-mediaTypeRnf mt =
-    rnf (mainType mt) `seq`
-    rnf (subType mt) `seq`
-    rnf (parameters mt)
 
 data RequestF body path = Request
   { requestPath        :: path
@@ -84,7 +90,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where
 
 type Request = RequestF RequestBody Builder.Builder
 
--- | The request body. A replica of the @http-client@ @RequestBody@.
+-- | The request body. R replica of the @http-client@ @RequestBody@.
 data RequestBody
   = RequestBodyLBS LBS.ByteString
   | RequestBodyBS BS.ByteString
@@ -95,6 +101,11 @@ instance Show RequestBody where
     showsPrec d (RequestBodyLBS lbs) = showParen (d > 10)
         $ showString "RequestBodyLBS "
         . showsPrec 11 lbs
+    showsPrec d (RequestBodyBS bs) = showParen (d > 10)
+        $ showString "RequestBodyBS "
+        . showsPrec 11 bs
+    showsPrec d (RequestBodySource _) = showParen (d > 10)
+        $ showString "RequestBodySource <IO>"
 
 -- A GET request to the top-level path
 defaultRequest :: Request

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

@@ -8,7 +8,11 @@
 {-# LANGUAGE ScopedTypeVariables   #-}
 {-# LANGUAGE TypeFamilies          #-}
 
-module Servant.Client.Core.Internal.Response where
+module Servant.Client.Core.Response (
+    Response,
+    StreamingResponse,
+    ResponseF (..),
+    ) where
 
 import           Prelude ()
 import           Prelude.Compat

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

@@ -0,0 +1,46 @@
+{-# LANGUAGE DeriveFunctor         #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE ScopedTypeVariables   #-}
+{-# LANGUAGE TypeFamilies          #-}
+-- | Types for possible backends to run client-side `Request` queries
+module Servant.Client.Core.RunClient (
+    RunClient (..),
+    RunStreamingClient (..),
+    ClientF (..),
+    ) where
+
+import           Prelude ()
+import           Prelude.Compat
+
+import           Control.Monad.Free
+                 (Free (..), liftF)
+
+import           Servant.Client.Core.ClientError
+import           Servant.Client.Core.Request
+import           Servant.Client.Core.Response
+
+class Monad m => RunClient m where
+  -- | How to make a request.
+  runRequest :: Request -> m Response
+  throwServantError :: ServantError -> m a
+
+class RunClient m =>  RunStreamingClient m where
+    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a
+
+-------------------------------------------------------------------------------
+-- Free
+-------------------------------------------------------------------------------
+
+-- | 'ClientF' cannot stream.
+--
+-- Compare to 'RunClient'.
+data ClientF a
+    = RunRequest Request (Response -> a)
+    | Throw ServantError
+  deriving (Functor)
+
+instance ClientF ~ f => RunClient (Free f) where
+    runRequest req  = liftF (RunRequest req id)
+    throwServantError = liftF . Throw

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

@@ -11,8 +11,8 @@ import           Control.Monad.Free
 import           Data.Proxy
                  (Proxy (..))
 import           Servant.Client.Core
-import           Servant.Client.Core.Internal.ClientF
 import           Servant.Client.Core.Reexport
+import           Servant.Client.Core.RunClient
 
 client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api
 client api = api `clientIn` (Proxy :: Proxy (Free ClientF))

servant-client-core/test/Servant/Client/Core/Internal/BaseUrlSpec.hs

@@ -8,7 +8,7 @@ import           Prelude.Compat
 import           Test.Hspec
 import           Test.QuickCheck
 
-import           Servant.Client.Core.Internal.BaseUrl
+import           Servant.Client.Core.BaseUrl
 
 spec :: Spec
 spec = do

servant-client-ghcjs/servant-client-ghcjs.cabal

@@ -36,10 +36,10 @@ library
     Servant.Client.Ghcjs
     Servant.Client.Internal.XhrClient
   build-depends:
-      base                  >= 4.7      && < 4.12
+      base                  >= 4.11     && < 4.12
     , bytestring            >= 0.10     && < 0.11
     , case-insensitive      >= 1.2.0.0  && < 1.3.0.0
-    , containers            >= 0.5      && < 0.6
+    , containers            >= 0.5      && < 0.7
     , exceptions            >= 0.8      && < 0.11
     , ghcjs-base            >= 0.2.0.0  && < 0.3.0.0
     , ghcjs-prim            >= 0.1.0.0  && < 0.2.0.0
@@ -47,7 +47,7 @@ library
     , http-types            >= 0.12     && < 0.13
     , monad-control         >= 1.0.0.4  && < 1.1
     , mtl                   >= 2.2.2    && < 2.3
-    , semigroupoids         >= 4.3      && < 5.3
+    , semigroupoids         >= 5.3      && < 5.4
     , string-conversions    >= 0.3      && < 0.5
     , transformers          >= 0.3      && < 0.6
     , transformers-base     >= 0.4.4    && < 0.5
@@ -55,10 +55,9 @@ library
 
   -- strict, as we re-export stuff
   build-depends:
-    servant-client-core   == 0.15
+    servant               == 0.15.*,
+    servant-client-core   == 0.15.*
 
   hs-source-dirs: src
   default-language: Haskell2010
-  ghc-options: -Wall
+  ghc-options: -Wall -Wno-redundant-constraints
-  if impl(ghc >= 8.0)
-    ghc-options: -Wno-redundant-constraints

servant-client-ghcjs/src/Servant/Client/Internal/XhrClient.hs

@@ -18,35 +18,48 @@ import           Control.Arrow
 import           Control.Concurrent
 import           Control.Exception
 import           Control.Monad
-import           Control.Monad.Base          (MonadBase (..))
+import           Control.Monad.Base
-import           Control.Monad.Catch         (MonadCatch, MonadThrow)
+                 (MonadBase (..))
-import           Control.Monad.Error.Class   (MonadError (..))
+import           Control.Monad.Catch
+                 (MonadCatch, MonadThrow)
+import           Control.Monad.Error.Class
+                 (MonadError (..))
 import           Control.Monad.Reader
-import           Control.Monad.Trans.Control (MonadBaseControl (..))
+import           Control.Monad.Trans.Control
+                 (MonadBaseControl (..))
 import           Control.Monad.Trans.Except
-import           Data.ByteString.Builder     (toLazyByteString)
+import           Data.Bifunctor
-import qualified Data.ByteString.Char8       as BS
+                 (bimap)
-import qualified Data.ByteString.Lazy        as BL
+import           Data.ByteString.Builder
+                 (toLazyByteString)
+import qualified Data.ByteString.Char8             as BS
+import qualified Data.ByteString.Lazy              as BL
 import           Data.CaseInsensitive
 import           Data.Char
-import           Data.Foldable               (toList)
+import           Data.Foldable
-import           Data.Functor.Alt            (Alt (..))
+                 (toList)
-import           Data.IORef                  (modifyIORef, newIORef, readIORef)
+import           Data.Functor.Alt
-import           Data.Proxy                  (Proxy (..))
+                 (Alt (..))
-import qualified Data.Sequence               as Seq
+import           Data.Proxy
+                 (Proxy (..))
+import qualified Data.Sequence                     as Seq
 import           Data.String.Conversions
-import           Data.Typeable           (Typeable)
+import           Data.Typeable
+                 (Typeable)
 import           Foreign.StablePtr
 import           GHC.Generics
-import qualified GHCJS.Buffer as Buffer
+import qualified GHCJS.Buffer                      as Buffer
 import           GHCJS.Foreign.Callback
 import           GHCJS.Prim
 import           GHCJS.Types
-import           JavaScript.TypedArray.ArrayBuffer ( ArrayBuffer )
+import           JavaScript.TypedArray.ArrayBuffer
+                 (ArrayBuffer)
 import           JavaScript.Web.Location
-import           Network.HTTP.Media          (renderHeader)
+import           Network.HTTP.Media
+                 (renderHeader)
 import           Network.HTTP.Types
 import           Servant.Client.Core
+import qualified Servant.Types.SourceT as S
 
 newtype JSXMLHttpRequest = JSXMLHttpRequest JSVal
 
@@ -110,9 +123,6 @@ instance RunClient ClientM where
   runRequest = performRequest
   throwServantError = throwError
 
-instance ClientLike (ClientM a) (ClientM a) where
-  mkClient = id
-
 runClientMOrigin :: ClientM a -> ClientEnv -> IO (Either ServantError a)
 runClientMOrigin cm env = runExceptT $ flip runReaderT env $ runClientM' cm
 
@@ -150,8 +160,9 @@ performRequest req = do
   resp <- toResponse xhr
 
   let status = statusCode (responseStatusCode resp)
-  unless (status >= 200 && status < 300) $
+  unless (status >= 200 && status < 300) $ do
-        throwError $ FailureResponse resp
+    let f b = (burl, BL.toStrict $ toLazyByteString b)
+    throwError $ FailureResponse (bimap (const ()) f req) resp
 
   pure resp
 
@@ -270,26 +281,17 @@ toBody request = case requestBody request of
   where
     go :: RequestBody -> IO ArrayBuffer
     go x = case x of
-      RequestBodyLBS x -> return $ mBody $ BL.toStrict x
+      RequestBodyLBS x     -> return $ mBody $ BL.toStrict x
-      RequestBodyBS x -> return $ mBody x
+      RequestBodyBS x      -> return $ mBody x
-      RequestBodyBuilder _ x -> return $ mBody $ BL.toStrict $ toLazyByteString x
+      RequestBodySource xs -> runExceptT (S.runSourceT xs) >>= \e -> case e of
-      RequestBodyStream _ x -> mBody <$> readBody x
+        Left err  -> fail err
-      RequestBodyStreamChunked x -> mBody <$> readBody x
+        Right bss -> return $ mBody $ BL.toStrict $ mconcat bss
-      RequestBodyIO x -> x >>= go
 
     mBody :: BS.ByteString -> ArrayBuffer
     mBody bs = js_bufferSlice offset len $ Buffer.getArrayBuffer buffer
       where
         (buffer, offset, len) = Buffer.fromByteString bs
 
-    readBody :: ((IO BS.ByteString -> IO ()) -> IO a) -> IO BS.ByteString
-    readBody writer = do
-      m <- newIORef mempty
-      _ <- writer (\bsAct -> do
-        bs <- bsAct
-        modifyIORef m (<> bs))
-      readIORef m
-
 foreign import javascript unsafe "$3.slice($1, $1 + $2)"
   js_bufferSlice :: Int -> Int -> ArrayBuffer -> ArrayBuffer
 
@@ -301,7 +303,7 @@ toResponse :: JSXMLHttpRequest -> ClientM Response
 toResponse xhr = do
   status <- liftIO $ getStatus xhr
   case status of
-    0 -> throwError $ ConnectionError "connection error"
+    0 -> throwError $ ConnectionError (SomeException (userError "connection error"))
     _ -> liftIO $ do
       statusText <- cs <$> getStatusText xhr
       headers <- parseHeaders <$> getAllResponseHeaders xhr

servant-client/servant-client.cabal

@@ -116,7 +116,6 @@ test-suite spec
   -- Additonal dependencies
   build-depends:
       entropy           >= 0.4.1.3  && < 0.5
-    , generics-sop      >= 0.4.0.1  && < 0.5
     , hspec             >= 2.6.0    && < 2.7
     , HUnit             >= 1.6.0.0  && < 1.7
     , network           >= 2.8.0.0  && < 3.1

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

@@ -143,9 +143,6 @@ instance RunClient ClientM where
   runRequest = performRequest
   throwServantError = throwError
 
-instance ClientLike (ClientM a) (ClientM a) where
-  mkClient = id
-
 runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)
 runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm
 

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

@@ -118,9 +118,6 @@ instance RunClient ClientM where
 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

servant-client/test/Servant/ClientSpec.hs

@@ -48,7 +48,6 @@ import           Data.Monoid ()
 import           Data.Proxy
 import           Data.Semigroup
                  ((<>))
-import qualified Generics.SOP                         as SOP
 import           GHC.Generics
                  (Generic)
 import qualified Network.HTTP.Client                  as C
@@ -72,8 +71,8 @@ import           Servant.API
                  Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
                  QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
 import           Servant.Client
-import qualified Servant.Client.Core.Internal.Auth    as Auth
+import qualified Servant.Client.Core.Auth    as Auth
-import qualified Servant.Client.Core.Internal.Request as Req
+import qualified Servant.Client.Core.Request as Req
 import           Servant.Server
 import           Servant.Server.Experimental.Auth
 import           Servant.Test.ComprehensiveAPI
@@ -88,7 +87,6 @@ spec = describe "Servant.Client" $ do
     wrappedApiSpec
     basicAuthSpec
     genAuthSpec
-    genericClientSpec
     hoistClientSpec
     connectionErrorSpec
 
@@ -258,53 +256,6 @@ genAuthServerContext = genAuthHandler :. EmptyContext
 genAuthServer :: Application
 genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
 
--- * generic client stuff
-
-type GenericClientAPI
-    = QueryParam "sqr" Int :> Get '[JSON] Int
- :<|> Capture "foo" String :> NestedAPI1
-
-data GenericClient = GenericClient
-  { getSqr          :: Maybe Int -> ClientM Int
-  , mkNestedClient1 :: String -> NestedClient1
-  } deriving Generic
-instance SOP.Generic GenericClient
-instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient
-
-type NestedAPI1
-    = QueryParam "int" Int :> NestedAPI2
- :<|> QueryParam "id" Char :> Get '[JSON] Char
-
-data NestedClient1 = NestedClient1
-  { mkNestedClient2 :: Maybe Int -> NestedClient2
-  , idChar          :: Maybe Char -> ClientM Char
-  } deriving Generic
-instance SOP.Generic NestedClient1
-instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
-
-type NestedAPI2
-    = "sum"  :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
- :<|> "void" :> Post '[JSON] ()
-
-data NestedClient2 = NestedClient2
-  { getSum    :: Int -> Int -> ClientM Int
-  , doNothing :: ClientM ()
-  } deriving Generic
-instance SOP.Generic NestedClient2
-instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
-
-genericClientServer :: Application
-genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
-       (\ mx -> case mx of
-                  Just x -> return (x*x)
-                  Nothing -> throwError $ ServantErr 400 "missing parameter" "" []
-       )
-  :<|> nestedServer1
- )
-  where
-    nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)
-    nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
-
 {-# NOINLINE manager' #-}
 manager' :: C.Manager
 manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
@@ -495,22 +446,6 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
       Left (FailureResponse _ r) <- runClient (getProtected authRequest) baseUrl
       responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
 
-genericClientSpec :: Spec
-genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
-  describe "Servant.Client.Generic" $ do
-
-    let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
-        NestedClient1{..} = mkNestedClient1 "example"
-        NestedClient2{..} = mkNestedClient2 (Just 42)
-
-    it "works for top-level client inClientM function" $ \(_, baseUrl) -> do
-      left show <$> runClient (getSqr (Just 5)) baseUrl `shouldReturn` Right 25
-
-    it "works for nested clients" $ \(_, baseUrl) -> do
-      left show <$> runClient (idChar (Just 'c')) baseUrl `shouldReturn` Right 'c'
-      left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
-      left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
-
 -- * hoistClient
 
 type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int

servant-http-streams/servant-http-streams.cabal

@@ -68,7 +68,7 @@ library
     , case-insensitive
     , http-streams          >= 0.8.6.1  && < 0.9
     , http-media            >= 0.7.1.3  && < 0.8
-    , io-streams            >=1.5.0.1   && < 1.6
+    , io-streams            >= 1.5.0.1  && < 1.6
     , http-types            >= 0.12.2   && < 0.13
     , http-common           >= 0.8.2.0  && < 0.9
     , exceptions            >= 0.10.0   && < 0.11
@@ -116,7 +116,6 @@ test-suite spec
   -- Additonal dependencies
   build-depends:
       entropy           >= 0.4.1.3  && < 0.5
-    , generics-sop      >= 0.4.0.1  && < 0.5
     , hspec             >= 2.6.0    && < 2.7
     , HUnit             >= 1.6.0.0  && < 1.7
     , network           >= 2.8.0.0  && < 3.1

servant-http-streams/src/Servant/HttpStreams/Internal.hs

@@ -141,9 +141,6 @@ instance RunClient ClientM where
 instance RunStreamingClient ClientM where
     withStreamingRequest = performWithStreamingRequest
 
-instance ClientLike (ClientM a) (ClientM a) where
-    mkClient = id
-
 runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)
 runClientM cm env = withClientM cm env (evaluate . force)
 

servant-http-streams/test/Servant/ClientSpec.hs

@@ -46,7 +46,6 @@ import           Data.Monoid ()
 import           Data.Proxy
 import           Data.Semigroup
                  ((<>))
-import qualified Generics.SOP                         as SOP
 import           GHC.Generics
                  (Generic)
 import qualified Network.HTTP.Types                   as HTTP
@@ -66,8 +65,8 @@ import           Servant.API
                  DeleteNoContent, EmptyAPI, FormUrlEncoded, Get, Header,
                  Headers, JSON, NoContent (NoContent), Post, Put, QueryFlag,
                  QueryParam, QueryParams, Raw, ReqBody, addHeader, getHeaders)
-import qualified Servant.Client.Core.Internal.Auth    as Auth
+import qualified Servant.Client.Core.Auth    as Auth
-import qualified Servant.Client.Core.Internal.Request as Req
+import qualified Servant.Client.Core.Request as Req
 import           Servant.HttpStreams
 import           Servant.Server
 import           Servant.Server.Experimental.Auth
@@ -83,7 +82,6 @@ spec = describe "Servant.HttpStreams" $ do
     wrappedApiSpec
     basicAuthSpec
     genAuthSpec
-    genericClientSpec
     hoistClientSpec
     connectionErrorSpec
 
@@ -256,53 +254,6 @@ genAuthServerContext = genAuthHandler :. EmptyContext
 genAuthServer :: Application
 genAuthServer = serveWithContext genAuthAPI genAuthServerContext (const (return alice))
 
--- * generic client stuff
-
-type GenericClientAPI
-    = QueryParam "sqr" Int :> Get '[JSON] Int
- :<|> Capture "foo" String :> NestedAPI1
-
-data GenericClient = GenericClient
-  { getSqr          :: Maybe Int -> ClientM Int
-  , mkNestedClient1 :: String -> NestedClient1
-  } deriving Generic
-instance SOP.Generic GenericClient
-instance (Client ClientM GenericClientAPI ~ client) => ClientLike client GenericClient
-
-type NestedAPI1
-    = QueryParam "int" Int :> NestedAPI2
- :<|> QueryParam "id" Char :> Get '[JSON] Char
-
-data NestedClient1 = NestedClient1
-  { mkNestedClient2 :: Maybe Int -> NestedClient2
-  , idChar          :: Maybe Char -> ClientM Char
-  } deriving Generic
-instance SOP.Generic NestedClient1
-instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
-
-type NestedAPI2
-    = "sum"  :> Capture "first" Int :> Capture "second" Int :> Get '[JSON] Int
- :<|> "void" :> Post '[JSON] ()
-
-data NestedClient2 = NestedClient2
-  { getSum    :: Int -> Int -> ClientM Int
-  , doNothing :: ClientM ()
-  } deriving Generic
-instance SOP.Generic NestedClient2
-instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
-
-genericClientServer :: Application
-genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
-       (\ mx -> case mx of
-                  Just x -> return (x*x)
-                  Nothing -> throwError $ ServantErr 400 "missing parameter" "" []
-       )
-  :<|> nestedServer1
- )
-  where
-    nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)
-    nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
-
 runClient :: NFData a => ClientM a -> BaseUrl -> IO (Either ServantError a)
 runClient x burl = withClientEnvIO burl (runClientM x)
 
@@ -487,22 +438,6 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
       Left (FailureResponse _ r) <- runClient (getProtected authRequest) baseUrl
       responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
 
-genericClientSpec :: Spec
-genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
-  describe "Servant.Client.Generic" $ do
-
-    let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
-        NestedClient1{..} = mkNestedClient1 "example"
-        NestedClient2{..} = mkNestedClient2 (Just 42)
-
-    it "works for top-level client inClientM function" $ \(_, baseUrl) -> do
-      left show <$> runClient (getSqr (Just 5)) baseUrl `shouldReturn` Right 25
-
-    it "works for nested clients" $ \(_, baseUrl) -> do
-      left show <$> runClient (idChar (Just 'c')) baseUrl `shouldReturn` Right 'c'
-      left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
-      left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
-
 -- * hoistClient
 
 type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int

stack.yaml

@@ -18,7 +18,6 @@ packages:
 extra-deps:
 - base-compat-0.10.5
 - conduit-1.3.1
-- generics-sop-0.4.0.1
 - hspec-2.6.0
 - hspec-core-2.6.0
 - hspec-discover-2.6.0