@@ -1,4 +1,5 @@
1{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
@@ -6,7 +7,6 @@
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE PolyKinds #-}
9{-# LANGUAGE PolyKinds #-}
9−{-# LANGUAGE QuantifiedConstraints #-}
10{-# LANGUAGE RankNTypes #-}
10{-# LANGUAGE RankNTypes #-}
11{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TypeApplications #-}
12{-# LANGUAGE TypeApplications #-}
@@ -14,13 +14,14 @@
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
17module Servant.Client.Core.HasClient (
21module Servant.Client.Core.HasClient (
19 HasClient (..),
23 HasClient (..),
20 EmptyClient (..),
24 EmptyClient (..),
24 foldMapUnion,
25 foldMapUnion,
25 matchUnion,
26 matchUnion,
@@ -32,11 +33,9 @@ import Control.Arrow
32 (left, (+++))
33 (left, (+++))
33import Control.Monad
34import Control.Monad
35−import qualified Data.ByteString as BS
36+import qualified Data.ByteString.Lazy as BL
36−import qualified Data.ByteString.Lazy as BL
37import Data.Either
37import Data.Either
38 (partitionEithers)
38 (partitionEithers)
39−import Data.Constraint (Dict(..))
40import Data.Foldable
39import Data.Foldable
42import Data.List
41import Data.List
@@ -45,8 +44,7 @@ import Data.Sequence
45 (fromList)
44 (fromList)
46import qualified Data.Text as T
45import qualified Data.Text as T
47import Network.HTTP.Media
46import Network.HTTP.Media
48− (MediaType, matches, parseAccept)
47+ (MediaType, matches, parseAccept, (//))
49−import qualified Network.HTTP.Media as Media
50import qualified Data.Sequence as Seq
48import qualified Data.Sequence as Seq
51import Data.SOP.BasicFunctors
49import Data.SOP.BasicFunctors
52 (I (I), (:.:) (Comp))
50 (I (I), (:.:) (Comp))
@@ -63,7 +61,7 @@ import Data.Text
63import Data.Proxy
61import Data.Proxy
64 (Proxy (Proxy))
62 (Proxy (Proxy))
65import GHC.TypeLits
63import GHC.TypeLits
66− (KnownNat, KnownSymbol, TypeError, symbolVal)
64+ (KnownSymbol, symbolVal)
67import Network.HTTP.Types
65import Network.HTTP.Types
69import qualified Network.HTTP.Types as H
67import qualified Network.HTTP.Types as H
@@ -74,22 +72,16 @@ import Servant.API
74 FromSourceIO (..), Header', Headers (..), HttpVersion,
72 FromSourceIO (..), Header', Headers (..), HttpVersion,
75 IsSecure, MimeRender (mimeRender),
73 IsSecure, MimeRender (mimeRender),
76 MimeUnrender (mimeUnrender), NoContent (NoContent),
74 MimeUnrender (mimeUnrender), NoContent (NoContent),
77− NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM,
75+ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw,
78 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
76 ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream,
79 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
77 StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault,
80− Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList,
78+ Verb, WithNamedContext, contentType, getHeadersHList,
81− getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes)
79+ getResponse, toQueryParam, toUrlPiece)
82−import Servant.API.Generic
83− (GenericMode(..), ToServant, ToServantApi
84− , GenericServant, toServant, fromServant)
85import Servant.API.ContentTypes
80import Servant.API.ContentTypes
86 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
81 (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender))
87−import Servant.API.Status
89import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
82import Servant.API.TypeLevel (FragmentUnique, AtLeastOneFragment)
90import Servant.API.Modifiers
83import Servant.API.Modifiers
91 (FoldRequired, RequiredArgument, foldRequiredArgument)
84 (FoldRequired, RequiredArgument, foldRequiredArgument)
92−import Servant.API.TypeErrors
93import Servant.API.UVerb
85import Servant.API.UVerb
94 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
86 (HasStatus, HasStatuses (Statuses, statuses), UVerb, Union, Unique, inject, statusOf, foldMapUnion, matchUnion)
@@ -208,7 +200,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
208 clientWithRoute pm (Proxy :: Proxy api)
200 clientWithRoute pm (Proxy :: Proxy api)
209 (appendToPath p req)
201 (appendToPath p req)
211− where p = toEncodedUrlPiece val
203+ where p = (toUrlPiece val)
213 hoistClientMonad pm _ f cl = \a ->
205 hoistClientMonad pm _ f cl = \a ->
214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
206 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
@@ -243,7 +235,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
243 clientWithRoute pm (Proxy :: Proxy sublayout)
235 clientWithRoute pm (Proxy :: Proxy sublayout)
244 (foldl' (flip appendToPath) req ps)
236 (foldl' (flip appendToPath) req ps)
246− where ps = map toEncodedUrlPiece vals
238+ where ps = map (toUrlPiece) vals
248 hoistClientMonad pm _ f cl = \as ->
240 hoistClientMonad pm _ f cl = \as ->
249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
241 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
@@ -251,11 +243,10 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
251instance {-# OVERLAPPABLE #-}
243instance {-# OVERLAPPABLE #-}
252 -- Note [Non-Empty Content Types]
244 -- Note [Non-Empty Content Types]
253 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
245 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
255 ) => HasClient m (Verb method status cts' a) where
246 ) => HasClient m (Verb method status cts' a) where
256 type Client m (Verb method status cts' a) = m a
247 type Client m (Verb method status cts' a) = m a
257 clientWithRoute _pm Proxy req = do
248 clientWithRoute _pm Proxy req = do
258− response <- runRequestAcceptStatus (Just [status]) req
249+ response <- runRequest req
259 { requestAccept = fromList $ toList accept
250 { requestAccept = fromList $ toList accept
260 , requestMethod = method
251 , requestMethod = method
@@ -263,20 +254,18 @@ instance {-# OVERLAPPABLE #-}
264 accept = contentTypes (Proxy :: Proxy ct)
255 accept = contentTypes (Proxy :: Proxy ct)
265 method = reflectMethod (Proxy :: Proxy method)
256 method = reflectMethod (Proxy :: Proxy method)
266− status = statusFromNat (Proxy :: Proxy status)
268 hoistClientMonad _ _ f ma = f ma
258 hoistClientMonad _ _ f ma = f ma
270instance {-# OVERLAPPING #-}
260instance {-# OVERLAPPING #-}
271− ( RunClient m, ReflectMethod method, KnownNat status
261+ ( RunClient m, ReflectMethod method
272 ) => HasClient m (Verb method status cts NoContent) where
262 ) => HasClient m (Verb method status cts NoContent) where
273 type Client m (Verb method status cts NoContent)
263 type Client m (Verb method status cts NoContent)
274 = m NoContent
264 = m NoContent
275 clientWithRoute _pm Proxy req = do
265 clientWithRoute _pm Proxy req = do
276− _response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
266+ _response <- runRequest req { requestMethod = method }
277 return NoContent
267 return NoContent
278 where method = reflectMethod (Proxy :: Proxy method)
268 where method = reflectMethod (Proxy :: Proxy method)
279− status = statusFromNat (Proxy :: Proxy status)
281 hoistClientMonad _ _ f ma = f ma
270 hoistClientMonad _ _ f ma = f ma
@@ -293,13 +282,13 @@ instance (RunClient m, ReflectMethod method) =>
294instance {-# OVERLAPPING #-}
283instance {-# OVERLAPPING #-}
295 -- Note [Non-Empty Content Types]
284 -- Note [Non-Empty Content Types]
296− ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls, KnownNat status
285+ ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
297 , ReflectMethod method, cts' ~ (ct ': cts)
286 , ReflectMethod method, cts' ~ (ct ': cts)
298 ) => HasClient m (Verb method status cts' (Headers ls a)) where
287 ) => HasClient m (Verb method status cts' (Headers ls a)) where
299 type Client m (Verb method status cts' (Headers ls a))
288 type Client m (Verb method status cts' (Headers ls a))
300 = m (Headers ls a)
289 = m (Headers ls a)
301 clientWithRoute _pm Proxy req = do
290 clientWithRoute _pm Proxy req = do
302− response <- runRequestAcceptStatus (Just [status]) req
291+ response <- runRequest req
303 { requestMethod = method
292 { requestMethod = method
304 , requestAccept = fromList $ toList accept
293 , requestAccept = fromList $ toList accept
@@ -307,51 +296,28 @@ instance {-# OVERLAPPING #-}
307 return $ Headers { getResponse = val
296 return $ Headers { getResponse = val
308 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
297 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
311− method = reflectMethod (Proxy :: Proxy method)
299+ where method = reflectMethod (Proxy :: Proxy method)
312− accept = contentTypes (Proxy :: Proxy ct)
300+ accept = contentTypes (Proxy :: Proxy ct)
313− status = statusFromNat (Proxy :: Proxy status)
315 hoistClientMonad _ _ f ma = f ma
302 hoistClientMonad _ _ f ma = f ma
317instance {-# OVERLAPPING #-}
304instance {-# OVERLAPPING #-}
318− ( RunClient m, BuildHeadersTo ls, ReflectMethod method, KnownNat status
305+ ( RunClient m, BuildHeadersTo ls, ReflectMethod method
319 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
306 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
320 type Client m (Verb method status cts (Headers ls NoContent))
307 type Client m (Verb method status cts (Headers ls NoContent))
321 = m (Headers ls NoContent)
308 = m (Headers ls NoContent)
322 clientWithRoute _pm Proxy req = do
309 clientWithRoute _pm Proxy req = do
310+ let method = reflectMethod (Proxy :: Proxy method)
323− response <- runRequestAcceptStatus (Just [status]) req { requestMethod = method }
311+ response <- runRequest req { requestMethod = method }
324 return $ Headers { getResponse = NoContent
312 return $ Headers { getResponse = NoContent
325 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
313 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
328− method = reflectMethod (Proxy :: Proxy method)
329− status = statusFromNat (Proxy :: Proxy status)
331 hoistClientMonad _ _ f ma = f ma
316 hoistClientMonad _ _ f ma = f ma
333data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
318data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus
334 deriving (Eq, Show)
319 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
355instance {-# OVERLAPPING #-}
321instance {-# OVERLAPPING #-}
356 ( RunClient m,
322 ( RunClient m,
357 contentTypes ~ (contentType ': otherContentTypes),
323 contentTypes ~ (contentType ': otherContentTypes),
@@ -360,7 +326,7 @@ instance {-# OVERLAPPING #-}
360 as ~ (a ': as'),
326 as ~ (a ': as'),
361 AllMime contentTypes,
327 AllMime contentTypes,
362 ReflectMethod method,
328 ReflectMethod method,
363− All (UnrenderResponse contentTypes) as,
329+ All (AllMimeUnrender contentTypes) as,
364 All HasStatus as, HasStatuses as',
330 All HasStatus as, HasStatuses as',
365 Unique (Statuses as)
331 Unique (Statuses as)
@@ -383,8 +349,7 @@ instance {-# OVERLAPPING #-}
384 let status = responseStatusCode response
350 let status = responseStatusCode response
385 body = responseBody response
351 body = responseBody response
386− headers = responseHeaders response
387− res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body
352+ res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) body
388 case res of
353 case res of
389 Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
354 Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response
390 Right x -> return x
355 Right x -> return x
@@ -405,14 +370,13 @@ instance {-# OVERLAPPING #-}
405 -- | Given a list of types, parses the given response body as each type
370 -- | Given a list of types, parses the given response body as each type
406 mimeUnrenders ::
371 mimeUnrenders ::
407 forall cts xs.
372 forall cts xs.
408− All (UnrenderResponse cts) xs =>
373+ All (AllMimeUnrender cts) xs =>
409 Proxy cts ->
374 Proxy cts ->
411 BL.ByteString ->
375 BL.ByteString ->
412 NP ([] :.: Either (MediaType, String)) xs
376 NP ([] :.: Either (MediaType, String)) xs
413− mimeUnrenders ctp headers body = cpure_NP
377+ mimeUnrenders ctp body = cpure_NP
414− (Proxy @(UnrenderResponse cts))
378+ (Proxy @(AllMimeUnrender cts))
415− (Comp . unrenderResponse headers body $ ctp)
379+ (Comp . map (\(mediaType, parser) -> left ((,) mediaType) (parser body)) . allMimeUnrender $ ctp)
417 hoistClientMonad _ _ nt s = nt s
381 hoistClientMonad _ _ nt s = nt s
@@ -569,7 +533,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
569 (Proxy :: Proxy mods) add (maybe req add) mparam
533 (Proxy :: Proxy mods) add (maybe req add) mparam
571 add :: a -> Request
535 add :: a -> Request
572− add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req
536+ add param = appendToQueryString pname (Just $ toQueryParam param) req
574 pname :: Text
538 pname :: Text
575 pname = pack $ symbolVal (Proxy :: Proxy sym)
539 pname = pack $ symbolVal (Proxy :: Proxy sym)
@@ -618,7 +582,7 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
620 where pname = pack $ symbolVal (Proxy :: Proxy sym)
584 where pname = pack $ symbolVal (Proxy :: Proxy sym)
621− paramlist' = map (Just . encodeQueryParamValue) paramlist
585+ paramlist' = map (Just . toQueryParam) paramlist
623 hoistClientMonad pm _ f cl = \as ->
587 hoistClientMonad pm _ f cl = \as ->
624 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
588 hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
@@ -674,16 +638,6 @@ instance RunClient m => HasClient m Raw where
675 hoistClientMonad _ _ f cl = \meth -> f (cl meth)
639 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)
687-- | If you use a 'ReqBody' in one of your endpoints in your API,
641-- | If you use a 'ReqBody' in one of your endpoints in your API,
688-- the corresponding querying function will automatically take
642-- the corresponding querying function will automatically take
689-- an additional argument of the type specified by your 'ReqBody'.
643-- an additional argument of the type specified by your 'ReqBody'.
@@ -750,7 +704,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
750 clientWithRoute pm (Proxy :: Proxy api)
704 clientWithRoute pm (Proxy :: Proxy api)
751 (appendToPath p req)
705 (appendToPath p req)
753− where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)
707+ where p = pack $ symbolVal (Proxy :: Proxy path)
755 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
709 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
@@ -786,14 +740,6 @@ instance HasClient m subapi =>
787 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
741 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
797instance ( HasClient m api
743instance ( HasClient m api
798 ) => HasClient m (AuthProtect tag :> api) where
744 ) => HasClient m (AuthProtect tag :> api) where
799 type Client m (AuthProtect tag :> api)
745 type Client m (AuthProtect tag :> api)
@@ -807,7 +753,7 @@ instance ( HasClient m api
808-- | Ignore @'Fragment'@ in client functions.
754-- | Ignore @'Fragment'@ in client functions.
809-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
755-- See <https://ietf.org/rfc/rfc2616.html#section-15.1.3> for more details.
811-- Example:
757-- Example:
813-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
759-- > type MyApi = "books" :> Fragment Text :> Get '[JSON] [Book]
@@ -819,12 +765,16 @@ instance ( HasClient m api
819-- > getBooks = client myApi
765-- > getBooks = client myApi
820-- > -- then you can just use "getBooksBy" to query that endpoint.
766-- > -- then you can just use "getBooksBy" to query that endpoint.
821-- > -- 'getBooks' for all books.
767-- > -- 'getBooks' for all books.
768+#ifdef HAS_TYPE_ERROR
822instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
769instance (AtLeastOneFragment api, FragmentUnique (Fragment a :> api), HasClient m api
771+instance ( HasClient m api
823 ) => HasClient m (Fragment a :> api) where
773 ) => HasClient m (Fragment a :> api) where
825 type Client m (Fragment a :> api) = Client m api
775 type Client m (Fragment a :> api) = Client m api
827− clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
777+ clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
829 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
779 hoistClientMonad pm _ = hoistClientMonad pm (Proxy :: Proxy api)
@@ -839,119 +789,6 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
839 hoistClientMonad pm _ f cl = \bauth ->
789 hoistClientMonad pm _ f cl = \bauth ->
840 hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
790 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
957{- Note [Non-Empty Content Types]
794{- Note [Non-Empty Content Types]
@@ -977,7 +814,7 @@ for empty and one for non-empty lists).
977checkContentTypeHeader :: RunClient m => Response -> m MediaType
814checkContentTypeHeader :: RunClient m => Response -> m MediaType
978checkContentTypeHeader response =
815checkContentTypeHeader response =
979 case lookup "Content-Type" $ toList $ responseHeaders response of
816 case lookup "Content-Type" $ toList $ responseHeaders response of
980− Nothing -> return $ "application" Media.// "octet-stream"
817+ Nothing -> return $ "application"//"octet-stream"
981 Just t -> case parseAccept t of
818 Just t -> case parseAccept t of
982 Nothing -> throwClientError $ InvalidContentTypeHeader response
819 Nothing -> throwClientError $ InvalidContentTypeHeader response
983 Just t' -> return t'
820 Just t' -> return t'
@@ -993,19 +830,3 @@ decodedAs response ct = do
993 Right val -> return val
830 Right val -> return val
995 accept = toList $ contentTypes ct
832 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