@@ -1,5 +1,4 @@
1{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -7,6 +6,7 @@
7{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE PolyKinds #-}
8{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE QuantifiedConstraints #-}
10{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeApplications #-}
12{-# LANGUAGE TypeApplications #-}
@@ -14,14 +14,13 @@
14{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
17−#if MIN_VERSION_base(4,9,0) && __GLASGOW_HASKELL__ >= 802
18−#define HAS_TYPE_ERROR
21module Servant.Client.Core.HasClient (
17module Servant.Client.Core.HasClient (
23 HasClient (..),
19 HasClient (..),
24 EmptyClient (..),
20 EmptyClient (..),
25 foldMapUnion,
24 foldMapUnion,
26 matchUnion,
25 matchUnion,
@@ -33,9 +32,11 @@ import Control.Arrow
33 (left, (+++))
32 (left, (+++))
34import Control.Monad
33import Control.Monad
36−import qualified Data.ByteString.Lazy as BL
35+import qualified Data.ByteString as BS
36+import qualified Data.ByteString.Lazy as BL
37import Data.Either
37import Data.Either
38 (partitionEithers)
38 (partitionEithers)
39+import Data.Constraint (Dict(..))
39import Data.Foldable
40import Data.Foldable
41import Data.List
42import Data.List
@@ -44,7 +45,8 @@ import Data.Sequence
44 (fromList)
45 (fromList)
45import qualified Data.Text as T
46import qualified Data.Text as T
46import Network.HTTP.Media
47import Network.HTTP.Media
47− (MediaType, matches, parseAccept, (//))
48+ (MediaType, matches, parseAccept)
49+import qualified Network.HTTP.Media as Media
48import qualified Data.Sequence as Seq
50import qualified Data.Sequence as Seq
49import Data.SOP.BasicFunctors
51import Data.SOP.BasicFunctors
50 (I (I), (:.:) (Comp))
52 (I (I), (:.:) (Comp))
@@ -61,7 +63,7 @@ import Data.Text
61import Data.Proxy
63import Data.Proxy
62 (Proxy (Proxy))
64 (Proxy (Proxy))
63import GHC.TypeLits
65import GHC.TypeLits
64− (KnownSymbol, symbolVal)
66+ (KnownNat, KnownSymbol, TypeError, symbolVal)
65import Network.HTTP.Types
67import Network.HTTP.Types
67import qualified Network.HTTP.Types as H
69import qualified Network.HTTP.Types as H
@@ -75,13 +77,19 @@ import Servant.API
75 NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
77 NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
76 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
78 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
77 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
79 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
78− Verb, WithNamedContext, contentType, getHeadersHList,
80+ Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList,
79− getResponse, toQueryParam, toUrlPiece)
81+ getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
82+import Servant.API.Generic
83+ (GenericMode(..), ToServant, ToServantApi
84+ , GenericServant, toServant, fromServant)
80import Servant.API.ContentTypes
85import Servant.API.ContentTypes
81 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
86 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87+import Servant.API.Status
82import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
83import Servant.API.Modifiers
90import Servant.API.Modifiers
84 (FoldRequired, RequiredArgument, foldRequiredArgument)
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
92+import Servant.API.TypeErrors
85import Servant.API.UVerb
93import Servant.API.UVerb
86 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
94 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
@@ -200,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
200 clientWithRoute pm (Proxy :: Proxy api)
208 clientWithRoute pm (Proxy :: Proxy api)
201 (appendToPath p req)
209 (appendToPath p req)
203− where p = (toUrlPiece val)
211+ where p = toEncodedUrlPiece val
205 hoistClientMonad pm _ f cl = \a ->
213 hoistClientMonad pm _ f cl = \a ->
206 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -235,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
235 clientWithRoute pm (Proxy :: Proxy sublayout)
243 clientWithRoute pm (Proxy :: Proxy sublayout)
236 (foldl' (flip appendToPath) req ps)
244 (foldl' (flip appendToPath) req ps)
238− where ps = map (toUrlPiece) vals
246+ where ps = map toEncodedUrlPiece vals
240 hoistClientMonad pm _ f cl = \as ->
248 hoistClientMonad pm _ f cl = \as ->
241 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -243,10 +251,11 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243instance {-# OVERLAPPABLE #-}
251instance {-# OVERLAPPABLE #-}
244 -- Note [Non-Empty Content Types]
252 -- Note [Non-Empty Content Types]
245 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
246 ) => HasClient m (Verb method status cts' a) where
255 ) => HasClient m (Verb method status cts' a) where
247 type Client m (Verb method status cts' a) = m a
256 type Client m (Verb method status cts' a) = m a
248 clientWithRoute _pm Proxy req = do
257 clientWithRoute _pm Proxy req = do
249− response <- runRequest req
258+ response <- runRequestAcceptStatus (Just [status]) req
250 { requestAccept = fromList $ toList accept
259 { requestAccept = fromList $ toList accept
251 , requestMethod = method
260 , requestMethod = method
@@ -254,18 +263,20 @@ instance {-# OVERLAPPABLE #-}
255 accept = contentTypes (Proxy :: Proxy ct)
264 accept = contentTypes (Proxy :: Proxy ct)
256 method = reflectMethod (Proxy :: Proxy method)
265 method = reflectMethod (Proxy :: Proxy method)
266+ status = statusFromNat (Proxy :: Proxy status)
258 hoistClientMonad _ _ f ma = f ma
268 hoistClientMonad _ _ f ma = f ma
260instance {-# OVERLAPPING #-}
270instance {-# OVERLAPPING #-}
261− ( RunClient m, ReflectMethod method
271+ ( RunClient m, ReflectMethod method, KnownNat status
262 ) => HasClient m (Verb method status cts NoContent) where
272 ) => HasClient m (Verb method status cts NoContent) where
263 type Client m (Verb method status cts NoContent)
273 type Client m (Verb method status cts NoContent)
264 = m NoContent
274 = m NoContent
265 clientWithRoute _pm Proxy req = do
275 clientWithRoute _pm Proxy req = do
266− _response <- runRequest req { requestMethod = method }
276+ _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
267 return NoContent
277 return NoContent
268 where method = reflectMethod (Proxy :: Proxy method)
278 where method = reflectMethod (Proxy :: Proxy method)
279+ status = statusFromNat (Proxy :: Proxy status)
270 hoistClientMonad _ _ f ma = f ma
281 hoistClientMonad _ _ f ma = f ma
@@ -282,13 +293,13 @@ instance (RunClient m, ReflectMethod method) =>
283instance {-# OVERLAPPING #-}
294instance {-# OVERLAPPING #-}
284 -- Note [Non-Empty Content Types]
295 -- Note [Non-Empty Content Types]
285− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
296+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
286 , ReflectMethod method, cts' ~ (ct ': cts)
297 , ReflectMethod method, cts' ~ (ct ': cts)
287 ) => HasClient m (Verb method status cts' (Headers ls a)) where
298 ) => HasClient m (Verb method status cts' (Headers ls a)) where
288 type Client m (Verb method status cts' (Headers ls a))
299 type Client m (Verb method status cts' (Headers ls a))
289 = m (Headers ls a)
300 = m (Headers ls a)
290 clientWithRoute _pm Proxy req = do
301 clientWithRoute _pm Proxy req = do
291− response <- runRequest req
302+ response <- runRequestAcceptStatus (Just [status]) req
292 { requestMethod = method
303 { requestMethod = method
293 , requestAccept = fromList $ toList accept
304 , requestAccept = fromList $ toList accept
@@ -296,28 +307,51 @@ instance {-# OVERLAPPING #-}
296 return $ Headers { getResponse = val
307 return $ Headers { getResponse = val
297 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
299− where method = reflectMethod (Proxy :: Proxy method)
311+ method = reflectMethod (Proxy :: Proxy method)
300− accept = contentTypes (Proxy :: Proxy ct)
312+ accept = contentTypes (Proxy :: Proxy ct)
313+ status = statusFromNat (Proxy :: Proxy status)
302 hoistClientMonad _ _ f ma = f ma
315 hoistClientMonad _ _ f ma = f ma
304instance {-# OVERLAPPING #-}
317instance {-# OVERLAPPING #-}
305− ( RunClient m, BuildHeadersTo ls, ReflectMethod method
318+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
306 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
307 type Client m (Verb method status cts (Headers ls NoContent))
320 type Client m (Verb method status cts (Headers ls NoContent))
308 = m (Headers ls NoContent)
321 = m (Headers ls NoContent)
309 clientWithRoute _pm Proxy req = do
322 clientWithRoute _pm Proxy req = do
310− let method = reflectMethod (Proxy :: Proxy method)
311− response <- runRequest req { requestMethod = method }
323+ response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
312 return $ Headers { getResponse = NoContent
324 return $ Headers { getResponse = NoContent
313 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
328+ method = reflectMethod (Proxy :: Proxy method)
329+ status = statusFromNat (Proxy :: Proxy status)
316 hoistClientMonad _ _ f ma = f ma
331 hoistClientMonad _ _ f ma = f ma
318data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
333data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
319 deriving (Eq, Show)
334 deriving (Eq, Show)
336+class UnrenderResponse (cts :: [*]) (a :: *) where
337+ unrenderResponse :: Seq.Seq H.Header -> BL.ByteString -> Proxy cts
338+ -> [Either (MediaType, String) a]
340+instance {-# OVERLAPPABLE #-} AllMimeUnrender cts a => UnrenderResponse cts a where
341+ unrenderResponse _ body = map parse . allMimeUnrender
342+ where parse (mediaType, parser) = left ((,) mediaType) (parser body)
344+instance {-# OVERLAPPING #-} forall cts a h . (UnrenderResponse cts a, BuildHeadersTo h)
345+ => UnrenderResponse cts (Headers h a) where
346+ unrenderResponse hs body = (map . fmap) setHeaders . unrenderResponse hs body
348+ setHeaders :: a -> Headers h a
349+ setHeaders x = Headers x (buildHeadersTo (toList hs))
351+instance {-# OVERLAPPING #-} UnrenderResponse cts a
352+ => UnrenderResponse cts (WithStatus n a) where
353+ unrenderResponse hs body = (map . fmap) WithStatus . unrenderResponse hs body
321instance {-# OVERLAPPING #-}
355instance {-# OVERLAPPING #-}
322 ( RunClient m,
356 ( RunClient m,
323 contentTypes ~ (contentType ': otherContentTypes),
357 contentTypes ~ (contentType ': otherContentTypes),
@@ -326,7 +360,7 @@ instance {-# OVERLAPPING #-}
326 as ~ (a ': as'),
360 as ~ (a ': as'),
327 AllMime contentTypes,
361 AllMime contentTypes,
328 ReflectMethod method,
362 ReflectMethod method,
329− All (AllMimeUnrender contentTypes) as,
363+ All (UnrenderResponse contentTypes) as,
330 All HasStatus as, HasStatuses as',
364 All HasStatus as, HasStatuses as',
331 Unique (Statuses as)
365 Unique (Statuses as)
@@ -349,7 +383,8 @@ instance {-# OVERLAPPING #-}
350 let status = responseStatusCode response
384 let status = responseStatusCode response
351 body = responseBody response
385 body = responseBody response
386+ headers = responseHeaders response
352− res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) body
387+ res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body
353 case res of
388 case res of
354 Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
389 Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
355 Right x -> return x
390 Right x -> return x
@@ -370,13 +405,14 @@ instance {-# OVERLAPPING #-}
370 -- | Given a list of types, parses the given response body as each type
405 -- | Given a list of types, parses the given response body as each type
371 mimeUnrenders ::
406 mimeUnrenders ::
372 forall cts xs.
407 forall cts xs.
373− All (AllMimeUnrender cts) xs =>
408+ All (UnrenderResponse cts) xs =>
374 Proxy cts ->
409 Proxy cts ->
375 BL.ByteString ->
411 BL.ByteString ->
376 NP ([] :.: Either (MediaType, String)) xs
412 NP ([] :.: Either (MediaType, String)) xs
377− mimeUnrenders ctp body = cpure_NP
413+ mimeUnrenders ctp headers body = cpure_NP
378− (Proxy @(AllMimeUnrender cts))
414+ (Proxy @(UnrenderResponse cts))
379− (Comp . map (\(mediaType, parser) -> left ((,) mediaType) (parser body)) . allMimeUnrender $ ctp)
415+ (Comp . unrenderResponse headers body $ ctp)
381 hoistClientMonad _ _ nt s = nt s
417 hoistClientMonad _ _ nt s = nt s
@@ -533,7 +569,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
533 (Proxy :: Proxy mods) add (maybe req add) mparam
569 (Proxy :: Proxy mods) add (maybe req add) mparam
535 add :: a -> Request
571 add :: a -> Request
536− add param = appendToQueryString pname (Just $ toQueryParam param) req
572+ add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
538 pname :: Text
574 pname :: Text
539 pname = pack $ symbolVal (Proxy :: Proxy sym)
575 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -582,7 +618,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
584 where pname = pack $ symbolVal (Proxy :: Proxy sym)
620 where pname = pack $ symbolVal (Proxy :: Proxy sym)
585− paramlist' = map (Just . toQueryParam) paramlist
621+ paramlist' = map (Just . encodeQueryParamValue) paramlist
587 hoistClientMonad pm _ f cl = \as ->
623 hoistClientMonad pm _ f cl = \as ->
588 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -704,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
704 clientWithRoute pm (Proxy :: Proxy api)
740 clientWithRoute pm (Proxy :: Proxy api)
705 (appendToPath p req)
741 (appendToPath p req)
707− where p = pack $ symbolVal (Proxy :: Proxy path)
743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
709 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
@@ -753,7 +789,7 @@ instance ( HasClient m api
754-- | Ignore @'Fragment'@ in client functions.
790-- | Ignore @'Fragment'@ in client functions.
755-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
791-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
757-- Example:
793-- Example:
759-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
795-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -765,16 +801,12 @@ instance ( HasClient m api
765-- > getBooks = client myApi
801-- > getBooks = client myApi
766-- > -- then you can just use "getBooksBy" to query that endpoint.
802-- > -- then you can just use "getBooksBy" to query that endpoint.
767-- > -- 'getBooks' for all books.
803-- > -- 'getBooks' for all books.
768−#ifdef HAS_TYPE_ERROR
769instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
804instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
771−instance ( HasClient m api
773 ) => HasClient m (Fragment a :> api) where
805 ) => HasClient m (Fragment a :> api) where
775 type Client m (Fragment a :> api) = Client m api
807 type Client m (Fragment a :> api) = Client m api
777− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
809+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
779 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
811 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
@@ -789,6 +821,119 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
789 hoistClientMonad pm _ f cl = \bauth ->
821 hoistClientMonad pm _ f cl = \bauth ->
790 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
822 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
824+-- | A type that specifies that an API record contains a client implementation.
825+data AsClientT (m :: * -> *)
826+instance GenericMode (AsClientT m) where
827+ type AsClientT m :- api = Client m api
830+type GClientConstraints api m =
831+ ( GenericServant api (AsClientT m)
832+ , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
835+class GClient (api :: * -> *) m where
836+ gClientProof :: Dict (GClientConstraints api m)
838+instance GClientConstraints api m => GClient api m where
842+ ( forall n. GClient api n
843+ , HasClient m (ToServantApi api)
846+ => HasClient m (NamedRoutes api) where
847+ type Client m (NamedRoutes api) = api (AsClientT m)
849+ clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
850+ clientWithRoute pm _ request =
851+ case gClientProof @api @m of
852+ Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
857+ -> Proxy (NamedRoutes api)
858+ -> (forall x. ma x -> mb x)
859+ -> Client ma (NamedRoutes api)
860+ -> Client mb (NamedRoutes api)
861+ hoistClientMonad _ _ nat clientA =
862+ case (gClientProof @api @ma, gClientProof @api @mb) of
864+ fromServant @api @(AsClientT mb) $
865+ hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
866+ toServant @api @(AsClientT ma) clientA
871+-- | Helper to make code using records of clients more readable.
873+-- Can be mixed with (/:) for supplying arguments.
878+-- type Api = NamedRoutes RootApi
880+-- data RootApi mode = RootApi
881+-- { subApi :: mode :- NamedRoutes SubApi
883+-- } deriving Generic
885+-- data SubApi mode = SubApi
886+-- { endpoint :: mode :- Get '[JSON] Person
888+-- } deriving Generic
893+-- rootClient :: RootApi (AsClientT ClientM)
894+-- rootClient = client api
896+-- endpointClient :: ClientM Person
897+-- endpointClient = client // subApi // endpoint
899+(//) :: a -> (a -> b) -> b
902+-- | Convenience function for supplying arguments to client functions when
903+-- working with records of clients.
905+-- Intended to be used in conjunction with '(//)'.
910+-- type Api = NamedRoutes RootApi
912+-- data RootApi mode = RootApi
913+-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi
914+-- , hello :: mode :- Capture "name" String :> Get '[JSON] String
916+-- } deriving Generic
918+-- data SubApi mode = SubApi
919+-- { endpoint :: mode :- Get '[JSON] Person
921+-- } deriving Generic
926+-- rootClient :: RootApi (AsClientT ClientM)
927+-- rootClient = client api
929+-- hello :: String -> ClientM String
930+-- hello name = rootClient // hello /: name
932+-- endpointClient :: ClientM Person
933+-- endpointClient = client // subApi /: "foobar123" // endpoint
935+(/:) :: (a -> b -> c) -> b -> a -> c
794{- Note [Non-Empty Content Types]
939{- Note [Non-Empty Content Types]
@@ -814,7 +959,7 @@ for empty and one for non-empty lists).
814checkContentTypeHeader :: RunClient m => Response -> m MediaType
959checkContentTypeHeader :: RunClient m => Response -> m MediaType
815checkContentTypeHeader response =
960checkContentTypeHeader response =
816 case lookup "Content-Type" $ toList $ responseHeaders response of
961 case lookup "Content-Type" $ toList $ responseHeaders response of
817− Nothing -> return $ "application"//"octet-stream"
962+ Nothing -> return $ "application" Media.// "octet-stream"
818 Just t -> case parseAccept t of
963 Just t -> case parseAccept t of
819 Nothing -> throwClientError $ InvalidContentTypeHeader response
964 Nothing -> throwClientError $ InvalidContentTypeHeader response
820 Just t' -> return t'
965 Just t' -> return t'
@@ -830,3 +975,19 @@ decodedAs response ct = do
830 Right val -> return val
975 Right val -> return val
832 accept = toList $ contentTypes ct
977 accept = toList $ contentTypes ct
979+-------------------------------------------------------------------------------
980+-- Custom type errors
981+-------------------------------------------------------------------------------
983+-- Erroring instance for HasClient' when a combinator is not fully applied
984+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
986+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
987+ clientWithRoute _ _ _ = error "unreachable"
988+ hoistClientMonad _ _ _ _ = error "unreachable"
990+-- Erroring instances for 'HasClient' for unknown API combinators
991+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
993+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api