@@ -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
@@ -72,16 +74,22 @@ import Servant.API
72 FromSourceIO (..), Header', Headers (..), HttpVersion,
74 FromSourceIO (..), Header', Headers (..), HttpVersion,
73 IsSecure, MimeRender (mimeRender),
75 IsSecure, MimeRender (mimeRender),
74 MimeUnrender (mimeUnrender), NoContent (NoContent),
76 MimeUnrender (mimeUnrender), NoContent (NoContent),
75− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
77+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,
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, WithResource, 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)
@@ -638,6 +674,16 @@ instance RunClient m => HasClient m Raw where
639 hoistClientMonad _ _ f cl = \meth -> f (cl meth)
675 hoistClientMonad _ _ f cl = \meth -> f (cl meth)
677+instance RunClient m => HasClient m RawM where
679+ = H.Method -> m Response
681+ clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM
682+ clientWithRoute _pm Proxy req httpMethod = do
683+ runRequest req { requestMethod = httpMethod }
685+ hoistClientMonad _ _ f cl = \meth -> f (cl meth)
641-- | If you use a 'ReqBody' in one of your endpoints in your API,
687-- | If you use a 'ReqBody' in one of your endpoints in your API,
642-- the corresponding querying function will automatically take
688-- the corresponding querying function will automatically take
643-- an additional argument of the type specified by your 'ReqBody'.
689-- an additional argument of the type specified by your 'ReqBody'.
@@ -704,7 +750,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
704 clientWithRoute pm (Proxy :: Proxy api)
750 clientWithRoute pm (Proxy :: Proxy api)
705 (appendToPath p req)
751 (appendToPath p req)
707− where p = pack $ symbolVal (Proxy :: Proxy path)
753+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
709 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
755 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
@@ -740,6 +786,14 @@ instance HasClient m subapi =>
741 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
787 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
789+instance HasClient m subapi =>
790+ HasClient m (WithResource res :> subapi) where
792+ type Client m (WithResource res :> subapi) = Client m subapi
793+ clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
795+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
743instance ( HasClient m api
797instance ( HasClient m api
744 ) => HasClient m (AuthProtect tag :> api) where
798 ) => HasClient m (AuthProtect tag :> api) where
745 type Client m (AuthProtect tag :> api)
799 type Client m (AuthProtect tag :> api)
@@ -753,7 +807,7 @@ instance ( HasClient m api
754-- | Ignore @'Fragment'@ in client functions.
808-- | Ignore @'Fragment'@ in client functions.
755-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
809-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
757-- Example:
811-- Example:
759-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
813-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -765,16 +819,12 @@ instance ( HasClient m api
765-- > getBooks = client myApi
819-- > getBooks = client myApi
766-- > -- then you can just use "getBooksBy" to query that endpoint.
820-- > -- then you can just use "getBooksBy" to query that endpoint.
767-- > -- 'getBooks' for all books.
821-- > -- 'getBooks' for all books.
768−#ifdef HAS_TYPE_ERROR
769instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
822instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
771−instance ( HasClient m api
773 ) => HasClient m (Fragment a :> api) where
823 ) => HasClient m (Fragment a :> api) where
775 type Client m (Fragment a :> api) = Client m api
825 type Client m (Fragment a :> api) = Client m api
777− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
827+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
779 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
829 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
@@ -789,6 +839,119 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
789 hoistClientMonad pm _ f cl = \bauth ->
839 hoistClientMonad pm _ f cl = \bauth ->
790 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
840 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
842+-- | A type that specifies that an API record contains a client implementation.
843+data AsClientT (m :: * -> *)
844+instance GenericMode (AsClientT m) where
845+ type AsClientT m :- api = Client m api
848+type GClientConstraints api m =
849+ ( GenericServant api (AsClientT m)
850+ , Client m (ToServantApi api) ~ ToServant api (AsClientT m)
853+class GClient (api :: * -> *) m where
854+ gClientProof :: Dict (GClientConstraints api m)
856+instance GClientConstraints api m => GClient api m where
860+ ( forall n. GClient api n
861+ , HasClient m (ToServantApi api)
864+ => HasClient m (NamedRoutes api) where
865+ type Client m (NamedRoutes api) = api (AsClientT m)
867+ clientWithRoute :: Proxy m -> Proxy (NamedRoutes api) -> Request -> Client m (NamedRoutes api)
868+ clientWithRoute pm _ request =
869+ case gClientProof @api @m of
870+ Dict -> fromServant $ clientWithRoute pm (Proxy @(ToServantApi api)) request
875+ -> Proxy (NamedRoutes api)
876+ -> (forall x. ma x -> mb x)
877+ -> Client ma (NamedRoutes api)
878+ -> Client mb (NamedRoutes api)
879+ hoistClientMonad _ _ nat clientA =
880+ case (gClientProof @api @ma, gClientProof @api @mb) of
882+ fromServant @api @(AsClientT mb) $
883+ hoistClientMonad @m @(ToServantApi api) @ma @mb Proxy Proxy nat $
884+ toServant @api @(AsClientT ma) clientA
889+-- | Helper to make code using records of clients more readable.
891+-- Can be mixed with (/:) for supplying arguments.
896+-- type Api = NamedRoutes RootApi
898+-- data RootApi mode = RootApi
899+-- { subApi :: mode :- NamedRoutes SubApi
901+-- } deriving Generic
903+-- data SubApi mode = SubApi
904+-- { endpoint :: mode :- Get '[JSON] Person
906+-- } deriving Generic
911+-- rootClient :: RootApi (AsClientT ClientM)
912+-- rootClient = client api
914+-- endpointClient :: ClientM Person
915+-- endpointClient = client \/\/ subApi \/\/ endpoint
917+(//) :: a -> (a -> b) -> b
920+-- | Convenience function for supplying arguments to client functions when
921+-- working with records of clients.
923+-- Intended to be used in conjunction with '(//)'.
928+-- type Api = NamedRoutes RootApi
930+-- data RootApi mode = RootApi
931+-- { subApi :: mode :- Capture "token" String :> NamedRoutes SubApi
932+-- , hello :: mode :- Capture "name" String :> Get '[JSON] String
934+-- } deriving Generic
936+-- data SubApi mode = SubApi
937+-- { endpoint :: mode :- Get '[JSON] Person
939+-- } deriving Generic
944+-- rootClient :: RootApi (AsClientT ClientM)
945+-- rootClient = client api
947+-- hello :: String -> ClientM String
948+-- hello name = rootClient \/\/ hello \/: name
950+-- endpointClient :: ClientM Person
951+-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint
953+(/:) :: (a -> b -> c) -> b -> a -> c
794{- Note [Non-Empty Content Types]
957{- Note [Non-Empty Content Types]
@@ -814,7 +977,7 @@ for empty and one for non-empty lists).
814checkContentTypeHeader :: RunClient m => Response -> m MediaType
977checkContentTypeHeader :: RunClient m => Response -> m MediaType
815checkContentTypeHeader response =
978checkContentTypeHeader response =
816 case lookup "Content-Type" $ toList $ responseHeaders response of
979 case lookup "Content-Type" $ toList $ responseHeaders response of
817− Nothing -> return $ "application"//"octet-stream"
980+ Nothing -> return $ "application" Media.// "octet-stream"
818 Just t -> case parseAccept t of
981 Just t -> case parseAccept t of
819 Nothing -> throwClientError $ InvalidContentTypeHeader response
982 Nothing -> throwClientError $ InvalidContentTypeHeader response
820 Just t' -> return t'
983 Just t' -> return t'
@@ -830,3 +993,19 @@ decodedAs response ct = do
830 Right val -> return val
993 Right val -> return val
832 accept = toList $ contentTypes ct
995 accept = toList $ contentTypes ct
997+-------------------------------------------------------------------------------
998+-- Custom type errors
999+-------------------------------------------------------------------------------
1001+-- Erroring instance for HasClient' when a combinator is not fully applied
1002+instance (RunClient m, TypeError (PartialApplication HasClient arr)) => HasClient m ((arr :: a -> b) :> sub)
1004+ type Client m (arr :> sub) = TypeError (PartialApplication HasClient arr)
1005+ clientWithRoute _ _ _ = error "unreachable"
1006+ hoistClientMonad _ _ _ _ = error "unreachable"
1008+-- Erroring instances for 'HasClient' for unknown API combinators
1009+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceForSub (HasClient m) ty)) => HasClient m (ty :> sub)
1011+instance {-# OVERLAPPABLE #-} (RunClient m, TypeError (NoInstanceFor (HasClient m api))) => HasClient m api