@@ -4,20 +4,19 @@
44{-# LANGUAGE FlexibleInstances #-}
55{-# LANGUAGE InstanceSigs #-}
66{-# LANGUAGE OverloadedStrings #-}
7+{-# LANGUAGE PolyKinds #-}
78{-# LANGUAGE ScopedTypeVariables #-}
89{-# LANGUAGE TypeFamilies #-}
910{-# LANGUAGE TypeOperators #-}
1011{-# LANGUAGE UndecidableInstances #-}
11−{-# LANGUAGE RankNTypes #-}
12−#if !MIN_VERSION_base(4,8,0)
13−{-# LANGUAGE OverlappingInstances #-}
14−#endif
12+
13+#include "overlapping-compat.h"
1514-- | This module provides 'client' which can automatically generate
1615-- querying functions for each endpoint just from the type representing your
1716-- API.
1817module Servant.Reflex
1918 ( client
20− , HasReflexClient(..)
19+ , HasClient(..)
2120 , ServantError(..)
2221 , module Servant.Common.BaseUrl
2322 ) where
@@ -25,11 +24,8 @@ module Servant.Reflex
2524#if !MIN_VERSION_base(4,8,0)
2625import Control.Applicative ((<$>))
2726#endif
28−import Control.Monad
29−import Control.Monad.Trans (liftIO)
3027import Control.Monad.Trans.Except
3128import Data.ByteString.Lazy (ByteString)
32−import Data.Default
3329import Data.List
3430import Data.Proxy
3531import Data.String.Conversions
@@ -41,570 +37,387 @@ import qualified Network.HTTP.Types.Header as HTTP
4137import Servant.API
4238import Servant.Common.BaseUrl
4339import Servant.Common.Req
44−import Reflex
45−import Reflex.Dom
46−import Web.HttpApiData
47−import Reflex.Dom.Xhr
40+import Reflex.Dom.Xhr
4841
4942-- * Accessing APIs as a Client
5043
5144-- | 'client' allows you to produce operations to query an API from a client.
5245--
5346-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
54−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
47+-- > :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books
5548-- >
5649-- > myApi :: Proxy MyApi
5750-- > myApi = Proxy
5851-- >
59−-- > getAllBooks :: ExceptT String IO [Book]
60−-- > postNewBook :: Book -> ExceptT String IO Book
52+-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
53+-- > postNewBook :: Behavior t (Maybe Book) -> Event t ()
54+-- -> m (Event t (Either XhrError (Book,Book)))
6155-- > (getAllBooks :<|> postNewBook) = client myApi host
62−-- > where host = BaseUrl Http "localhost" 8080
63−client :: HasReflexClient layout
64− => Proxy layout
65− -> BaseUrl
66− -> Client (Input layout) (Output layout)
56+-- > where host = constDyn $ BaseUrl Http "localhost" 8080
57+client :: (HasClient layout) => Proxy layout -> Dynamic t BaseUrl -> Client layout
6758client p baseurl = clientWithRoute p defReq baseurl
6859
69−data a ::> b = a ::> b deriving (Eq,Ord,Show,Read)
70−
71−infixr 3 ::>
72−
73−type Client ins outs = MonadWidget t m => Event t ins -> m (Event t (ins,outs))
74−
7560-- | This class lets us define how each API combinator
7661-- influences the creation of an HTTP request. It's mostly
7762-- an internal class, you can just use 'client'.
78−class HasReflexClient layout where
79− type Input layout :: *
80− type Output layout :: *
81− -- clientWithRoute :: MonadWidget t m => Proxy layout -> Req -> BaseUrl
82− -- -> Event t (Input layout) -> m (Event t (Input layout, Output layout))
83− clientWithRoute :: MonadWidget t m
84− => Proxy layout -> Req -> BaseUrl
85− -> Event t (Input layout) -> m (Event t (Input layout, Output layout))
86−
87−
88−-- | If you have a 'Get' endpoint in your API, the client
89−-- side querying function that is created when calling 'client'
90−-- will just require an argument that specifies the scheme, host
91−-- and port to send the request to.
92−instance
93−#if MIN_VERSION_base(4,8,0)
94− {-# OVERLAPPABLE #-}
95−#endif
96− (MimeUnrender ct result) => HasReflexClient (Get (ct ': cts) result) where
97− type Input (Get (ct ': cts) result) = ()
98− type Output (Get (ct ': cts) result) = result
99− -- type Client (Get (ct ': cts) result) = MonadWidget t m => Event t (Input layout) -> m (Event t result)
100− clientWithRoute Proxy req baseurl trigEvents = undefined -- performAJAX requestBuilder responseParser
101−-- where
102−-- requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
103−-- responseParser xhrResp = undefined
104−
105−performAJAX
106− :: (MonadWidget t m)
107− => (a -> XhrRequest)
108− -- ^ Function to build the request
109− -> (XhrResponse -> b)
110− -- ^ Function to parse the response
111− -> Event t a
112− -> m (Event t (a, b))
113−performAJAX mkRequest parseResponse req =
114− performEventAsync $ ffor req $ \a cb -> do
115− _ <- newXMLHttpRequest (mkRequest a) $ \response ->
116− liftIO $ cb (a, parseResponse response)
117− return ()
118−
119−
120−instance
121−#if MIN_VERSION_base(4,8,0)
122− {-# OVERLAPPING #-}
123−#endif
124− HasReflexClient (Get (ct ': cts) ()) where
125− type Input (Get (ct ': cts) ()) = ()
126− type Output (Get (ct ': cts) ()) = ()
127− -- type Client (Get (ct ': cts) ()) = MonadWidget t m => Event t () -> m (Event t ())
128− clientWithRoute Proxy req baseurl trigEvents =
129− performAJAX requestBuilder responseParser trigEvents
130− where
131− requestBuilder _ = XhrRequest "GET" (showBaseUrl baseurl) def
132− responseParser _ = ()
133−
134−-- -- | Pick a 'Method' and specify where the server you want to query is. You get
135−-- -- back the full `Response`.
136−-- instance HasReflexClient Raw where
137−-- type Input Raw = H.Method ::> ()
138−-- type Client Raw = Final (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
139−
140−-- clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Input Raw -> Client Raw
141−-- clientWithRoute Proxy req baseurl (httpMethod ::> ()) = do
142−-- performRequest httpMethod req baseurl
143−
144−-- -- | If you have a 'Get xs (Headers ls x)' endpoint, the client expects the
145−-- -- corresponding headers.
146−-- instance
147−-- #if MIN_VERSION_base(4,8,0)
148−-- {-# OVERLAPPING #-}
149−-- #endif
150−-- ( MimeUnrender ct a, BuildHeadersTo ls
151−-- ) => HasReflexClient (Get (ct ': cts) (Headers ls a)) where
152−-- type Input (Get (ct ': cts) (Headers ls a)) = ()
153−-- type Client (Get (ct ': cts) (Headers ls a)) = Final (Headers ls a)
154−-- clientWithRoute Proxy req baseurl _ = do
155−-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodGet req baseurl
156−-- return $ Headers { getResponse = resp
157−-- , getHeadersHList = buildHeadersTo hdrs
158−-- }
63+class HasClient layout where
64+ type Client layout :: *
65+ clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Client layout
66+
67+
68+instance (HasClient a, HasClient b) => HasClient (a :<|> b) where
69+ type Client (a :<|> b) = Client a :<|> Client b
70+ clientWithRoute Proxy req baseurl manager =
71+ clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>
72+ clientWithRoute (Proxy :: Proxy b) req baseurl manager
73+
74+-- Capture. Example:
75+-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
76+-- >
77+-- > myApi :: Proxy MyApi = Proxy
78+-- >
79+-- > getBook :: MonadWidget t m
80+-- => Dynamic t BaseUrl
81+-- -> Behavior t (Maybe Text)
82+-- -> Event t ()
83+-- -> m (Event t (Either XhrError (Text, Book)))
84+-- > getBook = client myApi (constDyn host)
85+instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout)
86+ => HasClient (Capture capture a :> sublayout) where
87+
88+ type Client (Capture capture a :> sublayout) =
89+ a -> Client sublayout
90+
91+ clientWithRoute Proxy req baseurl manager val =
92+ clientWithRoute (Proxy :: Proxy sublayout)
93+ (appendToPath p req)
94+ baseurl
95+ manager
96+
97+ where p = unpack (toUrlPiece val)
98+
99+-- VERB (Returning content) --
100+instance OVERLAPPABLE_
101+ -- Note [Non-Empty Content Types]
102+ (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)
103+ ) => HasClient (Verb method status cts' a) where
104+ type Client (Verb method status cts' a) = ExceptT ServantError IO a
105+ clientWithRoute Proxy req baseurl manager =
106+ snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager
107+ where method = reflectMethod (Proxy :: Proxy method)
108+
109+-- VERB (No content) --
110+instance OVERLAPPING_
111+ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where
112+ type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent
113+ clientWithRoute Proxy req baseurl manager =
114+ performRequestNoBody method req baseurl manager >> return NoContent
115+ where method = reflectMethod (Proxy :: Proxy method)
116+
117+-- HEADERS Verb (Content) --
118+instance OVERLAPPING_
119+ -- Note [Non-Empty Content Types]
120+ ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)
121+ ) => HasClient (Verb method status cts' (Headers ls a)) where
122+ type Client (Verb method status cts' (Headers ls a))
123+ = ExceptT ServantError IO (Headers ls a)
124+ clientWithRoute Proxy req baseurl manager = do
125+ let method = reflectMethod (Proxy :: Proxy method)
126+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager
127+ return $ Headers { getResponse = resp
128+ , getHeadersHList = buildHeadersTo hdrs
129+ }
130+
131+-- HEADERS Verb (No content) --
132+instance OVERLAPPING_
133+ ( BuildHeadersTo ls, ReflectMethod method
134+ ) => HasClient (Verb method status cts (Headers ls NoContent)) where
135+ type Client (Verb method status cts (Headers ls NoContent))
136+ = ExceptT ServantError IO (Headers ls NoContent)
137+ clientWithRoute Proxy req baseurl manager = do
138+ let method = reflectMethod (Proxy :: Proxy method)
139+ hdrs <- performRequestNoBody method req baseurl manager
140+ return $ Headers { getResponse = NoContent
141+ , getHeadersHList = buildHeadersTo hdrs
142+ }
143+
144+
145+-- | If you use a 'Header' in one of your endpoints in your API,
146+-- the corresponding querying function will automatically take
147+-- an additional argument of the type specified by your 'Header',
148+-- wrapped in Maybe.
159149--
160−-- | A client querying function for @a ':<|>' b@ will actually hand you
161−-- one function for querying @a@ and another one for querying @b@,
162−-- stitching them together with ':<|>', which really is just like a pair.
150+-- That function will take care of encoding this argument as Text
151+-- in the request headers.
163152--
164−-- > type MyApi = "books" :> Get '[JSON] [Book] -- GET /books
165−-- > :<|> "books" :> ReqBody '[JSON] Book :> Post Book -- POST /books
153+-- All you need is for your type to have a 'ToHttpApiData' instance.
154+--
155+-- Example:
156+--
157+-- > newtype Referer = Referer { referrer :: Text }
158+-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
159+-- >
160+-- > -- GET /view-my-referer
161+-- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
166162-- >
167163-- > myApi :: Proxy MyApi
168164-- > myApi = Proxy
169165-- >
170−-- > getAllBooks :: ExceptT String IO [Book]
171−-- > postNewBook :: Book -> ExceptT String IO Book
172−-- > (getAllBooks :<|> postNewBook) = client myApi host
166+-- > viewReferer :: Maybe Referer -> ExceptT String IO Book
167+-- > viewReferer = client myApi host
173168-- > where host = BaseUrl Http "localhost" 8080
174−instance (HasReflexClient a, HasReflexClient b) => HasReflexClient (a :<|> b) where
175− type Input (a :<|> b) = Input a :<|> Input b
176− type Output (a :<|> b) = Output a :<|> Output b
177− clientWithRoute Proxy req baseurl (a :<|> b) = undefined
178−-- clientWithRoute (Proxy :: Proxy a) req baseurl a :<|>
179−-- clientWithRoute (Proxy :: Proxy b) req baseurl b
180−
181−-- ------------------------------------------------------------------------------
182−-- -- | If you use a 'Capture' in one of your endpoints in your API,
183−-- -- the corresponding querying function will automatically take
184−-- -- an additional argument of the type specified by your 'Capture'.
185−-- -- That function will take care of inserting a textual representation
186−-- -- of this value at the right place in the request path.
187−-- --
188−-- -- You can control how values for this type are turned into
189−-- -- text by specifying a 'ToHttpApiData' instance for your type.
190−-- --
191−-- -- Example:
192−-- --
193−-- -- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
194−-- -- >
195−-- -- > myApi :: Proxy MyApi
196−-- -- > myApi = Proxy
197−-- -- >
198−-- -- > getBook :: Text -> ExceptT String IO Book
199−-- -- > getBook = client myApi host
200−-- -- > where host = BaseUrl Http "localhost" 8080
201−-- -- > -- then you can just use "getBook" to query that endpoint
202−-- instance (KnownSymbol capture, ToHttpApiData a, HasReflexClient sublayout)
203−-- => HasReflexClient (Capture capture a :> sublayout) where
204−--
205−-- type Input (Capture cap a :> sublayout) = a ::> Input sublayout
206−-- type Client (Capture capture a :> sublayout) = Client sublayout
207−--
208−-- clientWithRoute Proxy req baseurl (val ::> rest) =
209−-- clientWithRoute (Proxy :: Proxy sublayout)
210−-- (appendToPath p req) baseurl rest
211−--
212−-- where p = unpack (toUrlPiece val)
213−--
214−-- -- | If you have a 'Delete' endpoint in your API, the client
215−-- -- side querying function that is created when calling 'client'
216−-- -- will just require an argument that specifies the scheme, host
217−-- -- and port to send the request to.
218−-- instance
219−-- #if MIN_VERSION_base(4,8,0)
220−-- {-# OVERLAPPABLE #-}
221−-- #endif
222−-- (MimeUnrender ct a, cts' ~ (ct ': cts)) => HasReflexClient (Delete cts' a) where
223−-- type Input (Delete cts' a) = ()
224−-- type Client (Delete cts' a) = Final a
225−-- clientWithRoute Proxy req baseurl val =
226−-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl val
227−--
228−-- instance
229−-- #if MIN_VERSION_base(4,8,0)
230−-- {-# OVERLAPPING #-}
231−-- #endif
232−-- HasReflexClient (Delete cts ()) where
233−-- type Input (Delete cts ()) = ()
234−-- type Client (Delete cts ()) = Final ()
235−-- clientWithRoute Proxy req baseurl val =
236−-- void $ performRequestNoBody H.methodDelete req baseurl val
237−--
238−-- -- | If you have a 'Delete xs (Headers ls x)' endpoint, the client expects the
239−-- -- corresponding headers.
240−-- instance
241−-- #if MIN_VERSION_base(4,8,0)
242−-- {-# OVERLAPPING #-}
243−-- #endif
244−-- ( MimeUnrender ct a, BuildHeadersTo ls, cts' ~ (ct ': cts)
245−-- ) => HasReflexClient (Delete cts' (Headers ls a)) where
246−-- type Input (Delete cts' (Headers ls a)) = ()
247−-- type Client (Delete cts' (Headers ls a)) = Final (Headers ls a)
248−-- clientWithRoute Proxy req baseurl _ = do
249−-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodDelete req baseurl
250−-- return $ Headers { getResponse = resp
251−-- , getHeadersHList = buildHeadersTo hdrs
252−-- }
253−--
254−-- -- | If you use a 'Header' in one of your endpoints in your API,
255−-- -- the corresponding querying function will automatically take
256−-- -- an additional argument of the type specified by your 'Header',
257−-- -- wrapped in Maybe.
258−-- --
259−-- -- That function will take care of encoding this argument as Text
260−-- -- in the request headers.
261−-- --
262−-- -- All you need is for your type to have a 'ToHttpApiData' instance.
263−-- --
264−-- -- Example:
265−-- --
266−-- -- > newtype Referer = Referer { referrer :: Text }
267−-- -- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
268−-- -- >
269−-- -- > -- GET /view-my-referer
270−-- -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer
271−-- -- >
272−-- -- > myApi :: Proxy MyApi
273−-- -- > myApi = Proxy
274−-- -- >
275−-- -- > viewReferer :: Maybe Referer -> ExceptT String IO Book
276−-- -- > viewReferer = client myApi host
277−-- -- > where host = BaseUrl Http "localhost" 8080
278−-- -- > -- then you can just use "viewRefer" to query that endpoint
279−-- -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
280−-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
281−-- => HasReflexClient (Header sym a :> sublayout) where
282−--
283−-- type Input (Header sym a :> sublayout) = Maybe a ::> Input sublayout
284−-- type Client (Header sym a :> sublayout) = Client sublayout
285−--
286−-- clientWithRoute Proxy req baseurl (mval ::> rest) =
287−-- clientWithRoute (Proxy :: Proxy sublayout)
288−-- (maybe req
289−-- (\value -> Servant.Common.Req.addHeader hname value req)
290−-- mval
291−-- )
292−-- baseurl rest
293−--
294−-- where hname = symbolVal (Proxy :: Proxy sym)
295−--
296−-- -- | If you have a 'Post' endpoint in your API, the client
297−-- -- side querying function that is created when calling 'client'
298−-- -- will just require an argument that specifies the scheme, host
299−-- -- and port to send the request to.
300−-- instance
301−-- #if MIN_VERSION_base(4,8,0)
302−-- {-# OVERLAPPABLE #-}
303−-- #endif
304−-- (MimeUnrender ct a) => HasReflexClient (Post (ct ': cts) a) where
305−-- type Input (Post (ct ': cts) a) = ()
306−-- type Client (Post (ct ': cts) a) = Final a
307−-- clientWithRoute Proxy req baseurl _ =
308−-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
309−--
310−-- instance
311−-- #if MIN_VERSION_base(4,8,0)
312−-- {-# OVERLAPPING #-}
313−-- #endif
314−-- HasReflexClient (Post (ct ': cts) ()) where
315−-- type Input (Post (ct ': cts) ()) = ()
316−-- type Client (Post (ct ': cts) ()) = Final ()
317−-- clientWithRoute Proxy req baseurl _ =
318−-- void $ performRequestNoBody H.methodPost req baseurl
319−--
320−-- -- | If you have a 'Post xs (Headers ls x)' endpoint, the client expects the
321−-- -- corresponding headers.
322−-- instance
323−-- #if MIN_VERSION_base(4,8,0)
324−-- {-# OVERLAPPING #-}
325−-- #endif
326−-- ( MimeUnrender ct a, BuildHeadersTo ls
327−-- ) => HasReflexClient (Post (ct ': cts) (Headers ls a)) where
328−-- type Input (Post (ct ': cts) (Headers ls a)) = ()
329−-- type Client (Post (ct ': cts) (Headers ls a)) = Final (Headers ls a)
330−-- clientWithRoute Proxy req baseurl _ = do
331−-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPost req baseurl
332−-- return $ Headers { getResponse = resp
333−-- , getHeadersHList = buildHeadersTo hdrs
334−-- }
335−--
336−-- -- | If you have a 'Put' endpoint in your API, the client
337−-- -- side querying function that is created when calling 'client'
338−-- -- will just require an argument that specifies the scheme, host
339−-- -- and port to send the request to.
340−-- instance
341−-- #if MIN_VERSION_base(4,8,0)
342−-- {-# OVERLAPPABLE #-}
343−-- #endif
344−-- (MimeUnrender ct a) => HasReflexClient (Put (ct ': cts) a) where
345−-- type Input (Put (ct ': cts) a) = ()
346−-- type Client (Put (ct ': cts) a) = Final a
347−-- clientWithRoute Proxy req baseurl _ =
348−-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
349−--
350−-- instance
351−-- #if MIN_VERSION_base(4,8,0)
352−-- {-# OVERLAPPING #-}
353−-- #endif
354−-- HasReflexClient (Put (ct ': cts) ()) where
355−-- type Input (Put (ct ': cts) ()) = ()
356−-- type Client (Put (ct ': cts) ()) = Final ()
357−-- clientWithRoute Proxy req baseurl _ =
358−-- void $ performRequestNoBody H.methodPut req baseurl
359−--
360−-- -- | If you have a 'Put xs (Headers ls x)' endpoint, the client expects the
361−-- -- corresponding headers.
362−-- instance
363−-- #if MIN_VERSION_base(4,8,0)
364−-- {-# OVERLAPPING #-}
365−-- #endif
366−-- ( MimeUnrender ct a, BuildHeadersTo ls
367−-- ) => HasReflexClient (Put (ct ': cts) (Headers ls a)) where
368−-- type Input (Put (ct ': cts) (Headers ls a)) = ()
369−-- type Client (Put (ct ': cts) (Headers ls a)) = Final (Headers ls a)
370−-- clientWithRoute Proxy req baseurl _ = do
371−-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPut req baseurl
372−-- return $ Headers { getResponse = resp
373−-- , getHeadersHList = buildHeadersTo hdrs
374−-- }
375−--
376−-- -- | If you have a 'Patch' endpoint in your API, the client
377−-- -- side querying function that is created when calling 'client'
378−-- -- will just require an argument that specifies the scheme, host
379−-- -- and port to send the request to.
380−-- instance
381−-- #if MIN_VERSION_base(4,8,0)
382−-- {-# OVERLAPPABLE #-}
383−-- #endif
384−-- (MimeUnrender ct a) => HasReflexClient (Patch (ct ': cts) a) where
385−-- type Input (Patch (ct ': cts) a) = ()
386−-- type Client (Patch (ct ': cts) a) = Final a
387−-- clientWithRoute Proxy req baseurl _ =
388−-- snd <$> performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
389−--
390−-- instance
391−-- #if MIN_VERSION_base(4,8,0)
392−-- {-# OVERLAPPING #-}
393−-- #endif
394−-- HasReflexClient (Patch (ct ': cts) ()) where
395−-- type Input (Patch (ct ': cts) ()) = ()
396−-- type Client (Patch (ct ': cts) ()) = Final ()
397−-- clientWithRoute Proxy req baseurl _ =
398−-- void $ performRequestNoBody H.methodPatch req baseurl
399−--
400−-- -- | If you have a 'Patch xs (Headers ls x)' endpoint, the client expects the
401−-- -- corresponding headers.
402−-- instance
403−-- #if MIN_VERSION_base(4,8,0)
404−-- {-# OVERLAPPING #-}
405−-- #endif
406−-- ( MimeUnrender ct a, BuildHeadersTo ls
407−-- ) => HasReflexClient (Patch (ct ': cts) (Headers ls a)) where
408−-- type Input (Patch (ct ': cts) (Headers ls a)) = ()
409−-- type Client (Patch (ct ': cts) (Headers ls a)) = Final (Headers ls a)
410−-- clientWithRoute Proxy req baseurl _ = do
411−-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) H.methodPatch req baseurl
412−-- return $ Headers { getResponse = resp
413−-- , getHeadersHList = buildHeadersTo hdrs
414−-- }
169+-- > -- then you can just use "viewRefer" to query that endpoint
170+-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
171+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
172+ => HasClient (Header sym a :> sublayout) where
173+
174+ type Client (Header sym a :> sublayout) =
175+ Maybe a -> Client sublayout
176+
177+ clientWithRoute Proxy req baseurl manager mval =
178+ clientWithRoute (Proxy :: Proxy sublayout)
179+ (maybe req
180+ (\value -> Servant.Common.Req.addHeader hname value req)
181+ mval
182+ )
183+ baseurl
184+ manager
185+
186+ where hname = symbolVal (Proxy :: Proxy sym)
187+
188+-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
189+-- functions.
190+instance HasClient sublayout
191+ => HasClient (HttpVersion :> sublayout) where
192+
193+ type Client (HttpVersion :> sublayout) =
194+ Client sublayout
195+
196+ clientWithRoute Proxy =
197+ clientWithRoute (Proxy :: Proxy sublayout)
198+
199+-- | If you use a 'QueryParam' in one of your endpoints in your API,
200+-- the corresponding querying function will automatically take
201+-- an additional argument of the type specified by your 'QueryParam',
202+-- enclosed in Maybe.
415203--
416−-- -- | If you use a 'QueryParam' in one of your endpoints in your API,
417−-- -- the corresponding querying function will automatically take
418−-- -- an additional argument of the type specified by your 'QueryParam',
419−-- -- enclosed in Maybe.
420−-- --
421−-- -- If you give Nothing, nothing will be added to the query string.
422−-- --
423−-- -- If you give a non-'Nothing' value, this function will take care
424−-- -- of inserting a textual representation of this value in the query string.
425−-- --
426−-- -- You can control how values for your type are turned into
427−-- -- text by specifying a 'ToHttpApiData' instance for your type.
428−-- --
429−-- -- Example:
430−-- --
431−-- -- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
432−-- -- >
433−-- -- > myApi :: Proxy MyApi
434−-- -- > myApi = Proxy
435−-- -- >
436−-- -- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
437−-- -- > getBooksBy = client myApi host
438−-- -- > where host = BaseUrl Http "localhost" 8080
439−-- -- > -- then you can just use "getBooksBy" to query that endpoint.
440−-- -- > -- 'getBooksBy Nothing' for all books
441−-- -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
442−-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
443−-- => HasReflexClient (QueryParam sym a :> sublayout) where
204+-- If you give Nothing, nothing will be added to the query string.
444205--
445−-- type Input (QueryParam sym a :> sublayout) = Maybe a ::> Input sublayout
446−-- type Client (QueryParam sym a :> sublayout) = Client sublayout
206+-- If you give a non-'Nothing' value, this function will take care
207+-- of inserting a textual representation of this value in the query string.
447208--
448−-- -- if mparam = Nothing, we don't add it to the query string
449−-- clientWithRoute Proxy req baseurl (mparam ::> rest) =
450−-- clientWithRoute (Proxy :: Proxy sublayout)
451−-- (maybe req
452−-- (flip (appendToQueryString pname) req . Just)
453−-- mparamText
454−-- )
455−-- baseurl rest
209+-- You can control how values for your type are turned into
210+-- text by specifying a 'ToHttpApiData' instance for your type.
456211--
457−-- where pname = cs pname'
458−-- pname' = symbolVal (Proxy :: Proxy sym)
459−-- mparamText = fmap toQueryParam mparam
212+-- Example:
460213--
461−-- -- | If you use a 'QueryParams' in one of your endpoints in your API,
462−-- -- the corresponding querying function will automatically take
463−-- -- an additional argument, a list of values of the type specified
464−-- -- by your 'QueryParams'.
465−-- --
466−-- -- If you give an empty list, nothing will be added to the query string.
467−-- --
468−-- -- Otherwise, this function will take care
469−-- -- of inserting a textual representation of your values in the query string,
470−-- -- under the same query string parameter name.
471−-- --
472−-- -- You can control how values for your type are turned into
473−-- -- text by specifying a 'ToHttpApiData' instance for your type.
474−-- --
475−-- -- Example:
476−-- --
477−-- -- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
478−-- -- >
479−-- -- > myApi :: Proxy MyApi
480−-- -- > myApi = Proxy
481−-- -- >
482−-- -- > getBooksBy :: [Text] -> ExceptT String IO [Book]
483−-- -- > getBooksBy = client myApi host
484−-- -- > where host = BaseUrl Http "localhost" 8080
485−-- -- > -- then you can just use "getBooksBy" to query that endpoint.
486−-- -- > -- 'getBooksBy []' for all books
487−-- -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
488−-- -- > -- to get all books by Asimov and Heinlein
489−-- instance (KnownSymbol sym, ToHttpApiData a, HasReflexClient sublayout)
490−-- => HasReflexClient (QueryParams sym a :> sublayout) where
214+-- > type MyApi = "books" :> QueryParam "author" Text :> Get '[JSON] [Book]
215+-- >
216+-- > myApi :: Proxy MyApi
217+-- > myApi = Proxy
218+-- >
219+-- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]
220+-- > getBooksBy = client myApi host
221+-- > where host = BaseUrl Http "localhost" 8080
222+-- > -- then you can just use "getBooksBy" to query that endpoint.
223+-- > -- 'getBooksBy Nothing' for all books
224+-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
225+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
226+ => HasClient (QueryParam sym a :> sublayout) where
227+
228+ type Client (QueryParam sym a :> sublayout) =
229+ Maybe a -> Client sublayout
230+
231+ -- if mparam = Nothing, we don't add it to the query string
232+ clientWithRoute Proxy req baseurl manager mparam =
233+ clientWithRoute (Proxy :: Proxy sublayout)
234+ (maybe req
235+ (flip (appendToQueryString pname) req . Just)
236+ mparamText
237+ )
238+ baseurl
239+ manager
240+
241+ where pname = cs pname'
242+ pname' = symbolVal (Proxy :: Proxy sym)
243+ mparamText = fmap toQueryParam mparam
244+
245+-- | If you use a 'QueryParams' in one of your endpoints in your API,
246+-- the corresponding querying function will automatically take
247+-- an additional argument, a list of values of the type specified
248+-- by your 'QueryParams'.
491249--
492−-- type Input (QueryParams sym a :> sublayout) = [a] ::> Input sublayout
493−-- type Client (QueryParams sym a :> sublayout) = Client sublayout
250+-- If you give an empty list, nothing will be added to the query string.
494251--
495−-- clientWithRoute Proxy req baseurl (paramlist ::> rest) =
496−-- clientWithRoute (Proxy :: Proxy sublayout)
497−-- (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
498−-- req
499−-- paramlist'
500−-- )
501−-- baseurl rest
252+-- Otherwise, this function will take care
253+-- of inserting a textual representation of your values in the query string,
254+-- under the same query string parameter name.
502255--
503−-- where pname = cs pname'
504−-- pname' = symbolVal (Proxy :: Proxy sym)
505−-- paramlist' = map (Just . toQueryParam) paramlist
256+-- You can control how values for your type are turned into
257+-- text by specifying a 'ToHttpApiData' instance for your type.
506258--
507−-- -- | If you use a 'QueryFlag' in one of your endpoints in your API,
508−-- -- the corresponding querying function will automatically take
509−-- -- an additional 'Bool' argument.
510−-- --
511−-- -- If you give 'False', nothing will be added to the query string.
512−-- --
513−-- -- Otherwise, this function will insert a value-less query string
514−-- -- parameter under the name associated to your 'QueryFlag'.
515−-- --
516−-- -- Example:
517−-- --
518−-- -- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
519−-- -- >
520−-- -- > myApi :: Proxy MyApi
521−-- -- > myApi = Proxy
522−-- -- >
523−-- -- > getBooks :: Bool -> ExceptT String IO [Book]
524−-- -- > getBooks = client myApi host
525−-- -- > where host = BaseUrl Http "localhost" 8080
526−-- -- > -- then you can just use "getBooks" to query that endpoint.
527−-- -- > -- 'getBooksBy False' for all books
528−-- -- > -- 'getBooksBy True' to only get _already published_ books
529−-- instance (KnownSymbol sym, HasReflexClient sublayout)
530−-- => HasReflexClient (QueryFlag sym :> sublayout) where
259+-- Example:
531260--
532−-- type Input (QueryFlag sym :> sublayout) = Bool ::> Input sublayout
533−-- type Client (QueryFlag sym :> sublayout) = Client sublayout
261+-- > type MyApi = "books" :> QueryParams "authors" Text :> Get '[JSON] [Book]
262+-- >
263+-- > myApi :: Proxy MyApi
264+-- > myApi = Proxy
265+-- >
266+-- > getBooksBy :: [Text] -> ExceptT String IO [Book]
267+-- > getBooksBy = client myApi host
268+-- > where host = BaseUrl Http "localhost" 8080
269+-- > -- then you can just use "getBooksBy" to query that endpoint.
270+-- > -- 'getBooksBy []' for all books
271+-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
272+-- > -- to get all books by Asimov and Heinlein
273+instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)
274+ => HasClient (QueryParams sym a :> sublayout) where
275+
276+ type Client (QueryParams sym a :> sublayout) =
277+ [a] -> Client sublayout
278+
279+ clientWithRoute Proxy req baseurl manager paramlist =
280+ clientWithRoute (Proxy :: Proxy sublayout)
281+ (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
282+ req
283+ paramlist'
284+ )
285+ baseurl manager
286+
287+ where pname = cs pname'
288+ pname' = symbolVal (Proxy :: Proxy sym)
289+ paramlist' = map (Just . toQueryParam) paramlist
290+
291+-- | If you use a 'QueryFlag' in one of your endpoints in your API,
292+-- the corresponding querying function will automatically take
293+-- an additional 'Bool' argument.
534294--
535−-- clientWithRoute Proxy req baseurl (flag ::> rest) =
536−-- clientWithRoute (Proxy :: Proxy sublayout)
537−-- (if flag
538−-- then appendToQueryString paramname Nothing req
539−-- else req
540−-- )
541−-- baseurl rest
295+-- If you give 'False', nothing will be added to the query string.
542296--
543−-- where paramname = cs $ symbolVal (Proxy :: Proxy sym)
297+-- Otherwise, this function will insert a value-less query string
298+-- parameter under the name associated to your 'QueryFlag'.
544299--
300+-- Example:
545301--
546−-- -- | If you use a 'ReqBody' in one of your endpoints in your API,
547−-- -- the corresponding querying function will automatically take
548−-- -- an additional argument of the type specified by your 'ReqBody'.
549−-- -- That function will take care of encoding this argument as JSON and
550−-- -- of using it as the request body.
551−-- --
552−-- -- All you need is for your type to have a 'ToJSON' instance.
553−-- --
554−-- -- Example:
555−-- --
556−-- -- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
557−-- -- >
558−-- -- > myApi :: Proxy MyApi
559−-- -- > myApi = Proxy
560−-- -- >
561−-- -- > addBook :: Book -> ExceptT String IO Book
562−-- -- > addBook = client myApi host
563−-- -- > where host = BaseUrl Http "localhost" 8080
564−-- -- > -- then you can just use "addBook" to query that endpoint
565−-- instance (MimeRender ct a, HasReflexClient sublayout)
566−-- => HasReflexClient (ReqBody (ct ': cts) a :> sublayout) where
302+-- > type MyApi = "books" :> QueryFlag "published" :> Get '[JSON] [Book]
303+-- >
304+-- > myApi :: Proxy MyApi
305+-- > myApi = Proxy
306+-- >
307+-- > getBooks :: Bool -> ExceptT String IO [Book]
308+-- > getBooks = client myApi host
309+-- > where host = BaseUrl Http "localhost" 8080
310+-- > -- then you can just use "getBooks" to query that endpoint.
311+-- > -- 'getBooksBy False' for all books
312+-- > -- 'getBooksBy True' to only get _already published_ books
313+instance (KnownSymbol sym, HasClient sublayout)
314+ => HasClient (QueryFlag sym :> sublayout) where
315+
316+ type Client (QueryFlag sym :> sublayout) =
317+ Bool -> Client sublayout
318+
319+ clientWithRoute Proxy req baseurl manager flag =
320+ clientWithRoute (Proxy :: Proxy sublayout)
321+ (if flag
322+ then appendToQueryString paramname Nothing req
323+ else req
324+ )
325+ baseurl manager
326+
327+ where paramname = cs $ symbolVal (Proxy :: Proxy sym)
328+
329+
330+-- | Pick a 'Method' and specify where the server you want to query is. You get
331+-- back the full `Response`.
332+instance HasClient Raw where
333+ type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)
334+
335+ clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw
336+ clientWithRoute Proxy req baseurl manager httpMethod = do
337+ performRequest httpMethod req baseurl manager
338+
339+-- | If you use a 'ReqBody' in one of your endpoints in your API,
340+-- the corresponding querying function will automatically take
341+-- an additional argument of the type specified by your 'ReqBody'.
342+-- That function will take care of encoding this argument as JSON and
343+-- of using it as the request body.
567344--
568−-- type Input (ReqBody (ct ': cts) a :> sublayout) = a ::> Input sublayout
569−-- type Client (ReqBody (ct ': cts) a :> sublayout) = Client sublayout
345+-- All you need is for your type to have a 'ToJSON' instance.
570346--
571−-- clientWithRoute Proxy req baseurl (body ::> rest) =
572−-- clientWithRoute (Proxy :: Proxy sublayout)
573−-- (let ctProxy = Proxy :: Proxy ct
574−-- in setRQBody (mimeRender ctProxy body)
575−-- (contentType ctProxy)
576−-- req
577−-- )
578−-- baseurl rest
347+-- Example:
579348--
349+-- > type MyApi = "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book
350+-- >
351+-- > myApi :: Proxy MyApi
352+-- > myApi = Proxy
353+-- >
354+-- > addBook :: Book -> ExceptT String IO Book
355+-- > addBook = client myApi host manager
356+-- > where host = BaseUrl Http "localhost" 8080
357+-- > -- then you can just use "addBook" to query that endpoint
358+instance (MimeRender ct a, HasClient sublayout)
359+ => HasClient (ReqBody (ct ': cts) a :> sublayout) where
360+
361+ type Client (ReqBody (ct ': cts) a :> sublayout) =
362+ a -> Client sublayout
363+
364+ clientWithRoute Proxy req baseurl manager body =
365+ clientWithRoute (Proxy :: Proxy sublayout)
366+ (let ctProxy = Proxy :: Proxy ct
367+ in setRQBody (mimeRender ctProxy body)
368+ (contentType ctProxy)
369+ req
370+ )
371+ baseurl manager
372+
580373-- | Make the querying function append @path@ to the request path.
581−instance (KnownSymbol path, HasReflexClient sublayout) => HasReflexClient (path :> sublayout) where
582− type Input (path :> sublayout) = Input sublayout
583− type Output (path :> sublayout) = Output sublayout
584− clientWithRoute Proxy req baseurl val =
374+instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
375+ type Client (path :> sublayout) = Client sublayout
376+
377+ clientWithRoute Proxy req baseurl manager =
585378 clientWithRoute (Proxy :: Proxy sublayout)
586379 (appendToPath p req)
587− baseurl val
380+ baseurl manager
588381
589382 where p = symbolVal (Proxy :: Proxy path)
590383
591−-- instance HasReflexClient api => HasReflexClient (Vault :> api) where
592−-- type Input (Vault :> api) = Input api
593−-- type Client (Vault :> api) = Client api
594−--
595−-- clientWithRoute Proxy req baseurl val =
596−-- clientWithRoute (Proxy :: Proxy api) req baseurl val
597−--
598−-- instance HasReflexClient api => HasReflexClient (RemoteHost :> api) where
599−-- type Input (RemoteHost :> api) = Input api
600−-- type Client (RemoteHost :> api) = Client api
601−--
602−-- clientWithRoute Proxy req baseurl val =
603−-- clientWithRoute (Proxy :: Proxy api) req baseurl val
604−--
605−-- instance HasReflexClient api => HasReflexClient (IsSecure :> api) where
606−-- type Input (IsSecure :> api) = Input api
607−-- type Client (IsSecure :> api) = Client api
608−--
609−-- clientWithRoute Proxy req baseurl val =
610−-- clientWithRoute (Proxy :: Proxy api) req baseurl val
384+instance HasClient api => HasClient (Vault :> api) where
385+ type Client (Vault :> api) = Client api
386+
387+ clientWithRoute Proxy req baseurl manager =
388+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
389+
390+instance HasClient api => HasClient (RemoteHost :> api) where
391+ type Client (RemoteHost :> api) = Client api
392+
393+ clientWithRoute Proxy req baseurl manager =
394+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
395+
396+instance HasClient api => HasClient (IsSecure :> api) where
397+ type Client (IsSecure :> api) = Client api
398+
399+ clientWithRoute Proxy req baseurl manager =
400+ clientWithRoute (Proxy :: Proxy api) req baseurl manager
401+
402+instance HasClient subapi =>
403+ HasClient (WithNamedConfig name config subapi) where
404+
405+ type Client (WithNamedConfig name config subapi) = Client subapi
406+ clientWithRoute Proxy = clientWithRoute (Proxy :: Proxy subapi)
407+
408+
409+{- Note [Non-Empty Content Types]
410+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
411+Rather than have
412+
413+ instance (..., cts' ~ (ct ': cts)) => ... cts' ...
414+
415+It may seem to make more sense to have:
416+
417+ instance (...) => ... (ct ': cts) ...
418+
419+But this means that if another instance exists that does *not* require
420+non-empty lists, but is otherwise more specific, no instance will be overall
421+more specific. This in turn generally means adding yet another instance (one
422+for empty and one for non-empty lists).
423+-}