git.iko.soy/typeable/servant
on master help sign in
Merge pull request #936 from haskell-servant/alp/hoistClient
6be8291Oleg Grenrus
doc/tutorial/Client.lhs+57
compare with master
unifiedsplit
@@ -155,6 +155,63 @@ Email {from = "great@company.com", to = "alp@foo.com", subject = "Hey Alp, we mi
155
155
156The types of the arguments for the functions are the same as for (server-side) request handlers.
156The types of the arguments for the functions are the same as for (server-side) request handlers.
157
157
158+## Changing the monad the client functions live in
159+
160+Just like `hoistServer` allows us to change the monad in which request handlers
161+of a web application live in, we also have `hoistClient` for changing the monad
162+in which _client functions_ live. Consider the following trivial API:
163+
164+``` haskell
165+type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
166+
167+hoistClientAPI :: Proxy HoistClientAPI
168+hoistClientAPI = Proxy
169+```
170+
171+We already know how to derive client functions for this API, and as we have
172+seen above they all return results in the `ClientM` monad when using `servant-client`.
173+However, `ClientM` rarely (or never) is the actual monad we need to use the client
174+functions in. Sometimes we need to run them in IO, sometimes in a custom monad
175+stack. `hoistClient` is a very simple solution to the problem of "changing" the monad
176+the clients run in.
177+
178+``` haskell ignore
179+hoistClient
180+ :: HasClient ClientM api -- we need a valid API
181+ => Proxy api -- a Proxy to the API type
182+ -> (forall a. m a -> n a) -- a "monad conversion function" (natural transformation)
183+ -> Client m api -- clients in the source monad
184+ -> Client n api -- result: clients in the target monad
185+```
186+
187+The "conversion function" argument above, just like the ones given to `hoistServer`, must
188+be able to turn an `m a` into an `n a` for any choice of type `a`.
189+
190+Let's see this in action on our example. We first derive our client functions as usual,
191+with all of them returning a result in `ClientM`.
192+
193+``` haskell
194+getIntClientM :: ClientM Int
195+postIntClientM :: Int -> ClientM Int
196+getIntClientM :<|> postIntClientM = client hoistClientAPI
197+```
198+
199+And we finally decide that we want the handlers to run in IO instead, by
200+"post-applying" `runClientM` to a fixed client environment.
201+
202+``` haskell
203+-- our conversion function has type: forall a. ClientM a -> IO a
204+-- the result has type:
205+-- Client IO HoistClientAPI = IO Int :<|> (Int -> IO Int)
206+getClients :: ClientEnv -> Client IO HoistClientAPI
207+getClients clientEnv
208+ = hoistClient hoistClientAPI
209+ ( fmap (either (error . show) id)
210+ . flip runClientM clientEnv
211+ )
212+ (client hoistClientAPI)
213+```
214+
158## Querying Streaming APIs.
215## Querying Streaming APIs.
159
216
160Consider the following streaming API type:
217Consider the following streaming API type:
nix/shell.nix+1−1
@@ -1,5 +1,5 @@
1{ pkgs ? import <nixpkgs> {}
1{ pkgs ? import <nixpkgs> {}
2−, compiler ? "ghc821"
2+, compiler ? "ghc822"
3, tutorial ? false
3, tutorial ? false
4}:
4}:
5
5
servant-client-core/CHANGELOG.md+7
@@ -1,6 +1,13 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
4+0.14
5+----
6+
7+- Add a `hoistClientMonad` method to the `HasClient` typeclass, for
8+ changing the monad in which client functions run.
9+ ([#936](https://github.com/haskell-servant/servant/pull/936))
10+
40.13
110.13
5----
12----
6
13
servant-client-core/src/Servant/Client/Core/Internal/HasClient.hs+65
@@ -6,6 +6,7 @@
6{-# LANGUAGE MultiParamTypeClasses #-}
6{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE OverloadedStrings #-}
7{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE PolyKinds #-}
8{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeOperators #-}
12{-# LANGUAGE TypeOperators #-}
@@ -97,6 +98,12 @@ clientIn p pm = clientWithRoute pm p defaultRequest
97class RunClient m => HasClient m api where
98class RunClient m => HasClient m api where
98 type Client (m :: * -> *) (api :: *) :: *
99 type Client (m :: * -> *) (api :: *) :: *
99 clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api
100 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
100
107
101
108
102-- | A client querying function for @a ':<|>' b@ will actually hand you
109-- | 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
118 clientWithRoute pm (Proxy :: Proxy a) req :<|>
125 clientWithRoute pm (Proxy :: Proxy a) req :<|>
119 clientWithRoute pm (Proxy :: Proxy b) req
126 clientWithRoute pm (Proxy :: Proxy b) req
120
127
128+ hoistClientMonad pm _ f (ca :<|> cb) =
129+ hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>
130+ hoistClientMonad pm (Proxy :: Proxy b) f cb
131+
121-- | Singleton type representing a client for an empty API.
132-- | Singleton type representing a client for an empty API.
122data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
133data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
123
134
@@ -134,6 +145,7 @@ data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum)
134instance RunClient m => HasClient m EmptyAPI where
145instance RunClient m => HasClient m EmptyAPI where
135 type Client m EmptyAPI = EmptyClient
146 type Client m EmptyAPI = EmptyClient
136 clientWithRoute _pm Proxy _ = EmptyClient
147 clientWithRoute _pm Proxy _ = EmptyClient
148+ hoistClientMonad _ _ _ EmptyClient = EmptyClient
137
149
138-- | If you use a 'Capture' in one of your endpoints in your API,
150-- | If you use a 'Capture' in one of your endpoints in your API,
139-- the corresponding querying function will automatically take
151-- the corresponding querying function will automatically take
@@ -166,6 +178,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)
166
178
167 where p = (toUrlPiece val)
179 where p = (toUrlPiece val)
168
180
181+ hoistClientMonad pm _ f cl = \a ->
182+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
183+
169-- | If you use a 'CaptureAll' in one of your endpoints in your API,
184-- | If you use a 'CaptureAll' in one of your endpoints in your API,
170-- the corresponding querying function will automatically take an
185-- the corresponding querying function will automatically take an
171-- additional argument of a list of the type specified by your
186-- additional argument of a list of the type specified by your
@@ -198,6 +213,9 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)
198
213
199 where ps = map (toUrlPiece) vals
214 where ps = map (toUrlPiece) vals
200
215
216+ hoistClientMonad pm _ f cl = \as ->
217+ hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)
218+
201instance OVERLAPPABLE_
219instance OVERLAPPABLE_
202 -- Note [Non-Empty Content Types]
220 -- Note [Non-Empty Content Types]
203 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
221 ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
@@ -213,6 +231,8 @@ instance OVERLAPPABLE_
213 accept = contentTypes (Proxy :: Proxy ct)
231 accept = contentTypes (Proxy :: Proxy ct)
214 method = reflectMethod (Proxy :: Proxy method)
232 method = reflectMethod (Proxy :: Proxy method)
215
233
234+ hoistClientMonad _ _ f ma = f ma
235+
216instance OVERLAPPING_
236instance OVERLAPPING_
217 ( RunClient m, ReflectMethod method
237 ( RunClient m, ReflectMethod method
218 ) => HasClient m (Verb method status cts NoContent) where
238 ) => HasClient m (Verb method status cts NoContent) where
@@ -223,6 +243,8 @@ instance OVERLAPPING_
223 return NoContent
243 return NoContent
224 where method = reflectMethod (Proxy :: Proxy method)
244 where method = reflectMethod (Proxy :: Proxy method)
225
245
246+ hoistClientMonad _ _ f ma = f ma
247+
226instance OVERLAPPING_
248instance OVERLAPPING_
227 -- Note [Non-Empty Content Types]
249 -- Note [Non-Empty Content Types]
228 ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
250 ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls
@@ -244,6 +266,8 @@ instance OVERLAPPING_
244 where method = reflectMethod (Proxy :: Proxy method)
266 where method = reflectMethod (Proxy :: Proxy method)
245 accept = contentTypes (Proxy :: Proxy ct)
267 accept = contentTypes (Proxy :: Proxy ct)
246
268
269+ hoistClientMonad _ _ f ma = f ma
270+
247instance OVERLAPPING_
271instance OVERLAPPING_
248 ( RunClient m, BuildHeadersTo ls, ReflectMethod method
272 ( RunClient m, BuildHeadersTo ls, ReflectMethod method
249 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
273 ) => HasClient m (Verb method status cts (Headers ls NoContent)) where
@@ -256,6 +280,8 @@ instance OVERLAPPING_
256 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
280 , getHeadersHList = buildHeadersTo . toList $ responseHeaders response
257 }
281 }
258
282
283+ hoistClientMonad _ _ f ma = f ma
284+
259instance OVERLAPPABLE_
285instance OVERLAPPABLE_
260 ( RunClient m, MimeUnrender ct a, ReflectMethod method,
286 ( RunClient m, MimeUnrender ct a, ReflectMethod method,
261 FramingUnrender framing a, BuildFromStream a (f a)
287 FramingUnrender framing a, BuildFromStream a (f a)
@@ -304,6 +330,7 @@ instance OVERLAPPABLE_
304 processResult (Left err, _) = Just (Left err)
330 processResult (Left err, _) = Just (Left err)
305 k go
331 k go
306
332
333+ hoistClientMonad _ _ f ma = f ma
307
334
308-- | If you use a 'Header' in one of your endpoints in your API,
335-- | If you use a 'Header' in one of your endpoints in your API,
309-- the corresponding querying function will automatically take
336-- the corresponding querying function will automatically take
@@ -345,6 +372,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
345 add :: a -> Request
372 add :: a -> Request
346 add value = addHeader hname value req
373 add value = addHeader hname value req
347
374
375+ hoistClientMonad pm _ f cl = \arg ->
376+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
377+
348-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
378-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
349-- functions.
379-- functions.
350instance HasClient m api
380instance HasClient m api
@@ -356,18 +386,24 @@ instance HasClient m api
356 clientWithRoute pm Proxy =
386 clientWithRoute pm Proxy =
357 clientWithRoute pm (Proxy :: Proxy api)
387 clientWithRoute pm (Proxy :: Proxy api)
358
388
389+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
390+
359-- | Ignore @'Summary'@ in client functions.
391-- | Ignore @'Summary'@ in client functions.
360instance HasClient m api => HasClient m (Summary desc :> api) where
392instance HasClient m api => HasClient m (Summary desc :> api) where
361 type Client m (Summary desc :> api) = Client m api
393 type Client m (Summary desc :> api) = Client m api
362
394
363 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
395 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
364
396
397+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
398+
365-- | Ignore @'Description'@ in client functions.
399-- | Ignore @'Description'@ in client functions.
366instance HasClient m api => HasClient m (Description desc :> api) where
400instance HasClient m api => HasClient m (Description desc :> api) where
367 type Client m (Description desc :> api) = Client m api
401 type Client m (Description desc :> api) = Client m api
368
402
369 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
403 clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api)
370
404
405+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
406+
371-- | If you use a 'QueryParam' in one of your endpoints in your API,
407-- | If you use a 'QueryParam' in one of your endpoints in your API,
372-- the corresponding querying function will automatically take
408-- the corresponding querying function will automatically take
373-- an additional argument of the type specified by your 'QueryParam',
409-- an additional argument of the type specified by your 'QueryParam',
@@ -410,6 +446,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequire
410 pname :: Text
446 pname :: Text
411 pname = pack $ symbolVal (Proxy :: Proxy sym)
447 pname = pack $ symbolVal (Proxy :: Proxy sym)
412
448
449+ hoistClientMonad pm _ f cl = \arg ->
450+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)
451+
413-- | If you use a 'QueryParams' in one of your endpoints in your API,
452-- | If you use a 'QueryParams' in one of your endpoints in your API,
414-- the corresponding querying function will automatically take
453-- the corresponding querying function will automatically take
415-- an additional argument, a list of values of the type specified
454-- an additional argument, a list of values of the type specified
@@ -453,6 +492,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient m api)
453 where pname = pack $ symbolVal (Proxy :: Proxy sym)
492 where pname = pack $ symbolVal (Proxy :: Proxy sym)
454 paramlist' = map (Just . toQueryParam) paramlist
493 paramlist' = map (Just . toQueryParam) paramlist
455
494
495+ hoistClientMonad pm _ f cl = \as ->
496+ hoistClientMonad pm (Proxy :: Proxy api) f (cl as)
497+
456-- | If you use a 'QueryFlag' in one of your endpoints in your API,
498-- | If you use a 'QueryFlag' in one of your endpoints in your API,
457-- the corresponding querying function will automatically take
499-- the corresponding querying function will automatically take
458-- an additional 'Bool' argument.
500-- an additional 'Bool' argument.
@@ -489,6 +531,8 @@ instance (KnownSymbol sym, HasClient m api)
489
531
490 where paramname = pack $ symbolVal (Proxy :: Proxy sym)
532 where paramname = pack $ symbolVal (Proxy :: Proxy sym)
491
533
534+ hoistClientMonad pm _ f cl = \b ->
535+ hoistClientMonad pm (Proxy :: Proxy api) f (cl b)
492
536
493-- | Pick a 'Method' and specify where the server you want to query is. You get
537-- | Pick a 'Method' and specify where the server you want to query is. You get
494-- back the full `Response`.
538-- back the full `Response`.
@@ -500,6 +544,8 @@ instance RunClient m => HasClient m Raw where
500 clientWithRoute _pm Proxy req httpMethod = do
544 clientWithRoute _pm Proxy req httpMethod = do
501 runRequest req { requestMethod = httpMethod }
545 runRequest req { requestMethod = httpMethod }
502
546
547+ hoistClientMonad _ _ f cl = \meth -> f (cl meth)
548+
503-- | If you use a 'ReqBody' in one of your endpoints in your API,
549-- | If you use a 'ReqBody' in one of your endpoints in your API,
504-- the corresponding querying function will automatically take
550-- the corresponding querying function will automatically take
505-- an additional argument of the type specified by your 'ReqBody'.
551-- an additional argument of the type specified by your 'ReqBody'.
@@ -533,6 +579,9 @@ instance (MimeRender ct a, HasClient m api)
533 req
579 req
534 )
580 )
535
581
582+ hoistClientMonad pm _ f cl = \a ->
583+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)
584+
536-- | Make the querying function append @path@ to the request path.
585-- | Make the querying function append @path@ to the request path.
537instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
586instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
538 type Client m (path :> api) = Client m api
587 type Client m (path :> api) = Client m api
@@ -543,30 +592,40 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where
543
592
544 where p = pack $ symbolVal (Proxy :: Proxy path)
593 where p = pack $ symbolVal (Proxy :: Proxy path)
545
594
595+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
596+
546instance HasClient m api => HasClient m (Vault :> api) where
597instance HasClient m api => HasClient m (Vault :> api) where
547 type Client m (Vault :> api) = Client m api
598 type Client m (Vault :> api) = Client m api
548
599
549 clientWithRoute pm Proxy req =
600 clientWithRoute pm Proxy req =
550 clientWithRoute pm (Proxy :: Proxy api) req
601 clientWithRoute pm (Proxy :: Proxy api) req
551
602
603+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
604+
552instance HasClient m api => HasClient m (RemoteHost :> api) where
605instance HasClient m api => HasClient m (RemoteHost :> api) where
553 type Client m (RemoteHost :> api) = Client m api
606 type Client m (RemoteHost :> api) = Client m api
554
607
555 clientWithRoute pm Proxy req =
608 clientWithRoute pm Proxy req =
556 clientWithRoute pm (Proxy :: Proxy api) req
609 clientWithRoute pm (Proxy :: Proxy api) req
557
610
611+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
612+
558instance HasClient m api => HasClient m (IsSecure :> api) where
613instance HasClient m api => HasClient m (IsSecure :> api) where
559 type Client m (IsSecure :> api) = Client m api
614 type Client m (IsSecure :> api) = Client m api
560
615
561 clientWithRoute pm Proxy req =
616 clientWithRoute pm Proxy req =
562 clientWithRoute pm (Proxy :: Proxy api) req
617 clientWithRoute pm (Proxy :: Proxy api) req
563
618
619+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl
620+
564instance HasClient m subapi =>
621instance HasClient m subapi =>
565 HasClient m (WithNamedContext name context subapi) where
622 HasClient m (WithNamedContext name context subapi) where
566
623
567 type Client m (WithNamedContext name context subapi) = Client m subapi
624 type Client m (WithNamedContext name context subapi) = Client m subapi
568 clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
625 clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi)
569
626
627+ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl
628+
570instance ( HasClient m api
629instance ( HasClient m api
571 ) => HasClient m (AuthProtect tag :> api) where
630 ) => HasClient m (AuthProtect tag :> api) where
572 type Client m (AuthProtect tag :> api)
631 type Client m (AuthProtect tag :> api)
@@ -575,6 +634,9 @@ instance ( HasClient m api
575 clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
634 clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) =
576 clientWithRoute pm (Proxy :: Proxy api) (func val req)
635 clientWithRoute pm (Proxy :: Proxy api) (func val req)
577
636
637+ hoistClientMonad pm _ f cl = \authreq ->
638+ hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)
639+
578-- * Basic Authentication
640-- * Basic Authentication
579
641
580instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where
642instance 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
583 clientWithRoute pm Proxy req val =
645 clientWithRoute pm Proxy req val =
584 clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
646 clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)
585
647
648+ hoistClientMonad pm _ f cl = \bauth ->
649+ hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth)
650+
586
651
587{- Note [Non-Empty Content Types]
652{- Note [Non-Empty Content Types]
588~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
653~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
servant-client/CHANGELOG.md+7
@@ -1,6 +1,13 @@
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
1[The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
2[Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md)
3
3
4+0.14
5+----
6+
7+- Add `hoistClient` for changing the monad in which
8+ client functions run.
9+ ([#936](https://github.com/haskell-servant/servant/pull/936))
10+
40.13
110.13
5----
12----
6
13
servant-client/src/Servant/Client.hs+1
@@ -9,6 +9,7 @@ module Servant.Client
9 , runClientM
9 , runClientM
10 , ClientEnv(..)
10 , ClientEnv(..)
11 , mkClientEnv
11 , mkClientEnv
12+ , hoistClient
12 , module Servant.Client.Core.Reexport
13 , module Servant.Client.Core.Reexport
13 ) where
14 ) where
14
15
servant-client/src/Servant/Client/Internal/HttpClient.hs+23
@@ -6,6 +6,7 @@
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
7{-# LANGUAGE MultiParamTypeClasses #-}
8{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
9+{-# LANGUAGE RankNTypes #-}
9{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE ScopedTypeVariables #-}
10{-# LANGUAGE TypeFamilies #-}
11{-# LANGUAGE TypeFamilies #-}
11module Servant.Client.Internal.HttpClient where
12module Servant.Client.Internal.HttpClient where
@@ -70,6 +71,28 @@ mkClientEnv mgr burl = ClientEnv mgr burl Nothing
70client :: HasClient ClientM api => Proxy api -> Client ClientM api
71client :: HasClient ClientM api => Proxy api -> Client ClientM api
71client api = api `clientIn` (Proxy :: Proxy ClientM)
72client api = api `clientIn` (Proxy :: Proxy ClientM)
72
73
74+-- | Change the monad the client functions live in, by
75+-- supplying a conversion function
76+-- (a natural transformation to be precise).
77+--
78+-- For example, assuming you have some @manager :: 'Manager'@ and
79+-- @baseurl :: 'BaseUrl'@ around:
80+--
81+-- > type API = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
82+-- > api :: Proxy API
83+-- > api = Proxy
84+-- > getInt :: IO Int
85+-- > postInt :: Int -> IO Int
86+-- > getInt :<|> postInt = hoistClient api (flip runClientM cenv) (client api)
87+-- > where cenv = mkClientEnv manager baseurl
88+hoistClient
89+ :: HasClient ClientM api
90+ => Proxy api
91+ -> (forall a. m a -> n a)
92+ -> Client m api
93+ -> Client n api
94+hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)
95+
73-- | @ClientM@ is the monad in which client functions run. Contains the
96-- | @ClientM@ is the monad in which client functions run. Contains the
74-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
97-- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment.
75newtype ClientM a = ClientM
98newtype ClientM a = ClientM
servant-client/test/Servant/ClientSpec.hs+23
@@ -89,6 +89,7 @@ spec = describe "Servant.Client" $ do
89 basicAuthSpec
89 basicAuthSpec
90 genAuthSpec
90 genAuthSpec
91 genericClientSpec
91 genericClientSpec
92+ hoistClientSpec
92
93
93-- * test data types
94-- * test data types
94
95
@@ -491,6 +492,28 @@ genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWa
491 left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
492 left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7
492 left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
493 left show <$> runClient doNothing baseUrl `shouldReturn` Right ()
493
494
495+-- * hoistClient
496+
497+type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int
498+
499+hoistClientAPI :: Proxy HoistClientAPI
500+hoistClientAPI = Proxy
501+
502+hoistClientServer :: Application -- implements HoistClientAPI
503+hoistClientServer = serve hoistClientAPI $ return 5 :<|> (\n -> return n)
504+
505+hoistClientSpec :: Spec
506+hoistClientSpec = beforeAll (startWaiApp hoistClientServer) $ afterAll endWaiApp $ do
507+ describe "Servant.Client.hoistClient" $ do
508+ it "allows us to GET/POST/... requests in IO instead of ClientM" $ \(_, baseUrl) -> do
509+ let (getInt :<|> postInt)
510+ = hoistClient hoistClientAPI
511+ (fmap (either (error . show) id) . flip runClient baseUrl)
512+ (client hoistClientAPI)
513+
514+ getInt `shouldReturn` 5
515+ postInt 5 `shouldReturn` 5
516+
494-- * utils
517-- * utils
495
518
496startWaiApp :: Application -> IO (ThreadId, BaseUrl)
519startWaiApp :: Application -> IO (ThreadId, BaseUrl)