@@ -6,6 +6,7 @@
66{-# LANGUAGE MultiParamTypeClasses #-}
77{-# LANGUAGE OverloadedStrings #-}
88{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE RankNTypes #-}
910{-# LANGUAGE ScopedTypeVariables #-}
1011{-# LANGUAGE TypeFamilies #-}
1112{-# LANGUAGE TypeOperators #-}
@@ -97,6 +98,12 @@ clientIn p pm = clientWithRoute pm p defaultRequest
9798class RunClient m => HasClient m api where
9899 type Client (m :: * -> *) (api :: *) :: *
99100 clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
101+ hoistClientMonad
102+ :: Proxy m
103+ -> Proxy api
104+ -> (forall x. mon x -> mon' x)
105+ -> Client mon api
106+ -> Client mon' api
100107
101108
102109-- | A client querying function for @a ':<|>' b@ will actually hand you
@@ -118,6 +125,10 @@ instance (HasClient m a, HasClient m b) => HasClient m (a :<|> b) where
118125 clientWithRoute pm (Proxy :: Proxy a) req :<|>
119126 clientWithRoute pm (Proxy :: Proxy b) req
120127
128+ hoistClientMonad pm _ f (ca :<|> cb) =
129+ hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>
130+ hoistClientMonad pm (Proxy :: Proxy b) f cb
131+
121132-- | Singleton type representing a client for an empty API.
122133data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
123134
@@ -134,6 +145,7 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
134145instance RunClient m => HasClient m EmptyAPI where
135146 type Client m EmptyAPI = EmptyClient
136147 clientWithRoute _pm Proxy _ = EmptyClient
148+ hoistClientMonad _ _ _ EmptyClient = EmptyClient
137149
138150-- | If you use a 'Capture' in one of your endpoints in your API,
139151-- the corresponding querying function will automatically take
@@ -166,6 +178,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
166178
167179 where p = (toUrlPiece val)
168180
181+ hoistClientMonad pm _ f cl = \a ->
182+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
183+
169184-- | If you use a 'CaptureAll' in one of your endpoints in your API,
170185-- the corresponding querying function will automatically take an
171186-- additional argument of a list of the type specified by your
@@ -198,6 +213,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
198213
199214 where ps = map (toUrlPiece) vals
200215
216+ hoistClientMonad pm _ f cl = \as ->
217+ hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
218+
201219instance OVERLAPPABLE_
202220 -- Note [Non-Empty Content Types]
203221 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
@@ -213,6 +231,8 @@ instance OVERLAPPABLE_
213231 accept = contentTypes (Proxy :: Proxy ct)
214232 method = reflectMethod (Proxy :: Proxy method)
215233
234+ hoistClientMonad _ _ f ma = f ma
235+
216236instance OVERLAPPING_
217237 ( RunClient m, ReflectMethod method
218238 ) => HasClient m (Verb method status cts NoContent) where
@@ -223,6 +243,8 @@ instance OVERLAPPING_
223243 return NoContent
224244 where method = reflectMethod (Proxy :: Proxy method)
225245
246+ hoistClientMonad _ _ f ma = f ma
247+
226248instance OVERLAPPING_
227249 -- Note [Non-Empty Content Types]
228250 ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
@@ -244,6 +266,8 @@ instance OVERLAPPING_
244266 where method = reflectMethod (Proxy :: Proxy method)
245267 accept = contentTypes (Proxy :: Proxy ct)
246268
269+ hoistClientMonad _ _ f ma = f ma
270+
247271instance OVERLAPPING_
248272 ( RunClient m, BuildHeadersTo ls, ReflectMethod method
249273 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
@@ -256,6 +280,8 @@ instance OVERLAPPING_
256280 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
257281 }
258282
283+ hoistClientMonad _ _ f ma = f ma
284+
259285instance OVERLAPPABLE_
260286 ( RunClient m, MimeUnrender ct a, ReflectMethod method,
261287 FramingUnrender framing a, BuildFromStream a (f a)
@@ -304,6 +330,7 @@ instance OVERLAPPABLE_
304330 processResult (Left err, _) = Just (Left err)
305331 k go
306332
333+ hoistClientMonad _ _ f ma = f ma
307334
308335-- | If you use a 'Header' in one of your endpoints in your API,
309336-- the corresponding querying function will automatically take
@@ -345,6 +372,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
345372 add :: a -> Request
346373 add value = addHeader hname value req
347374
375+ hoistClientMonad pm _ f cl = \arg ->
376+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
377+
348378-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
349379-- functions.
350380instance HasClient m api
@@ -356,18 +386,24 @@ instance HasClient m api
356386 clientWithRoute pm Proxy =
357387 clientWithRoute pm (Proxy :: Proxy api)
358388
389+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
390+
359391-- | Ignore @'Summary'@ in client functions.
360392instance HasClient m api => HasClient m (Summary desc :> api) where
361393 type Client m (Summary desc :> api) = Client m api
362394
363395 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
364396
397+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
398+
365399-- | Ignore @'Description'@ in client functions.
366400instance HasClient m api => HasClient m (Description desc :> api) where
367401 type Client m (Description desc :> api) = Client m api
368402
369403 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
370404
405+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
406+
371407-- | If you use a 'QueryParam' in one of your endpoints in your API,
372408-- the corresponding querying function will automatically take
373409-- an additional argument of the type specified by your 'QueryParam',
@@ -410,6 +446,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
410446 pname :: Text
411447 pname = pack $ symbolVal (Proxy :: Proxy sym)
412448
449+ hoistClientMonad pm _ f cl = \arg ->
450+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
451+
413452-- | If you use a 'QueryParams' in one of your endpoints in your API,
414453-- the corresponding querying function will automatically take
415454-- an additional argument, a list of values of the type specified
@@ -453,6 +492,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
453492 where pname = pack $ symbolVal (Proxy :: Proxy sym)
454493 paramlist' = map (Just . toQueryParam) paramlist
455494
495+ hoistClientMonad pm _ f cl = \as ->
496+ hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
497+
456498-- | If you use a 'QueryFlag' in one of your endpoints in your API,
457499-- the corresponding querying function will automatically take
458500-- an additional 'Bool' argument.
@@ -489,6 +531,8 @@ instance (KnownSymbol sym, HasClient m api)
489531
490532 where paramname = pack $ symbolVal (Proxy :: Proxy sym)
491533
534+ hoistClientMonad pm _ f cl = \b ->
535+ hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
492536
493537-- | Pick a 'Method' and specify where the server you want to query is. You get
494538-- back the full `Response`.
@@ -500,6 +544,8 @@ instance RunClient m => HasClient m Raw where
500544 clientWithRoute _pm Proxy req httpMethod = do
501545 runRequest req { requestMethod = httpMethod }
502546
547+ hoistClientMonad _ _ f cl = \meth -> f (cl meth)
548+
503549-- | If you use a 'ReqBody' in one of your endpoints in your API,
504550-- the corresponding querying function will automatically take
505551-- an additional argument of the type specified by your 'ReqBody'.
@@ -533,6 +579,9 @@ instance (MimeRender ct a, HasClient m api)
533579 req
534580 )
535581
582+ hoistClientMonad pm _ f cl = \a ->
583+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
584+
536585-- | Make the querying function append @path@ to the request path.
537586instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
538587 type Client m (path :> api) = Client m api
@@ -543,30 +592,40 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
543592
544593 where p = pack $ symbolVal (Proxy :: Proxy path)
545594
595+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
596+
546597instance HasClient m api => HasClient m (Vault :> api) where
547598 type Client m (Vault :> api) = Client m api
548599
549600 clientWithRoute pm Proxy req =
550601 clientWithRoute pm (Proxy :: Proxy api) req
551602
603+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
604+
552605instance HasClient m api => HasClient m (RemoteHost :> api) where
553606 type Client m (RemoteHost :> api) = Client m api
554607
555608 clientWithRoute pm Proxy req =
556609 clientWithRoute pm (Proxy :: Proxy api) req
557610
611+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
612+
558613instance HasClient m api => HasClient m (IsSecure :> api) where
559614 type Client m (IsSecure :> api) = Client m api
560615
561616 clientWithRoute pm Proxy req =
562617 clientWithRoute pm (Proxy :: Proxy api) req
563618
619+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
620+
564621instance HasClient m subapi =>
565622 HasClient m (WithNamedContext name context subapi) where
566623
567624 type Client m (WithNamedContext name context subapi) = Client m subapi
568625 clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
569626
627+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
628+
570629instance ( HasClient m api
571630 ) => HasClient m (AuthProtect tag :> api) where
572631 type Client m (AuthProtect tag :> api)
@@ -575,6 +634,9 @@ instance ( HasClient m api
575634 clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
576635 clientWithRoute pm (Proxy :: Proxy api) (func val req)
577636
637+ hoistClientMonad pm _ f cl = \authreq ->
638+ hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)
639+
578640-- * Basic Authentication
579641
580642instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
@@ -583,6 +645,9 @@ instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
583645 clientWithRoute pm Proxy req val =
584646 clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
585647
648+ hoistClientMonad pm _ f cl = \bauth ->
649+ hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
650+
586651
587652{- Note [Non-Empty Content Types]
588653~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~