@@ -1,16 +1,24 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE FlexibleContexts #-}
4−{-# LANGUAGE FlexibleInstances #-}
5−{-# LANGUAGE InstanceSigs #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−{-# LANGUAGE PolyKinds #-}
8−{-# LANGUAGE ScopedTypeVariables #-}
9−{-# LANGUAGE TupleSections #-}
10−{-# LANGUAGE TypeFamilies #-}
11−{-# LANGUAGE TypeOperators #-}
12−{-# LANGUAGE UndecidableInstances #-}
1+{-# LANGUAGE AllowAmbiguousTypes #-}
2+{-# LANGUAGE CPP #-}
3+{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE FlexibleContexts #-}
5+{-# LANGUAGE FlexibleInstances #-}
6+{-# LANGUAGE InstanceSigs #-}
7+{-# LANGUAGE OverloadedStrings #-}
8+{-# LANGUAGE PolyKinds #-}
9+{-# LANGUAGE ScopedTypeVariables #-}
10+{-# LANGUAGE TupleSections #-}
11+{-# LANGUAGE TypeFamilies #-}
12+{-# LANGUAGE TypeOperators #-}
13+{-# LANGUAGE UndecidableInstances #-}
1314{-# LANGUAGE MultiParamTypeClasses #-}
15+{-# LANGUAGE OverloadedStrings #-}
16+{-# LANGUAGE PolyKinds #-}
17+{-# LANGUAGE ScopedTypeVariables #-}
18+{-# LANGUAGE TupleSections #-}
19+{-# LANGUAGE TypeFamilies #-}
20+{-# LANGUAGE TypeOperators #-}
21+{-# LANGUAGE UndecidableInstances #-}
1422
1523-- #include "overlapping-compat.h"
1624-- | This module provides 'client' which can automatically generate
@@ -18,17 +26,20 @@
1826-- API.
1927module Servant.Reflex
2028 ( client
29+ , BuildHeaderKeysTo(..)
30+ , toHeaders
2131 , HasClient(..)
2232 , module Servant.Common.Req
2333 , module Servant.Common.BaseUrl
2434 ) where
2535
26−-------------------------------------------------------------------------------
36+------------------------------------------------------------------------------
2737import Control.Applicative
2838import Data.Monoid ((<>))
2939import qualified Data.Set as Set
3040import qualified Data.Text.Encoding as E
3141import Data.CaseInsensitive (mk)
42+import Data.Functor.Identity
3243import Data.Proxy (Proxy (..))
3344import qualified Data.Map as Map
3445import Data.Text (Text)
@@ -43,24 +54,31 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,
4354 QueryParams, Raw, ReflectMethod(..),
4455 RemoteHost, ReqBody,
4556 ToHttpApiData(..), Vault, Verb)
57+
58+import Reflex.Dom (Dynamic, Event, Reflex,
59+ XhrRequest(..),
60+ XhrResponseHeaders(..),
61+ XhrResponse(..), attachPromptlyDynWith, constDyn, ffor, fmapMaybe,
62+ leftmost, performRequestsAsync,
63+ )
64+------------------------------------------------------------------------------
4665import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
4766 showBaseUrl,
4867 SupportsServantReflex)
4968import Servant.Common.Req (Req, ReqResult(..), QParam(..),
5069 QueryPart(..), addHeader, authData,
51− defReq, prependToPathParts,
52− performRequestCT,
53− performRequestNoBody,
70+ defReq, evalResponse, prependToPathParts,
71+ -- performRequestCT,
72+ performRequestsCT,
73+ -- performRequestNoBody,
74+ performRequestsNoBody,
75+ performSomeRequestsAsync,
5476 qParamToQueryPart, reqBody,
5577 reqSuccess, reqFailure,
5678 reqMethod, respHeaders, response,
79+ reqTag,
5780 qParams)
58−import Reflex.Dom (Dynamic, Event, Reflex,
59− XhrRequest(..),
60− XhrResponseHeaders(..),
61− XhrResponse(..), ffor, fmapMaybe,
62− leftmost, performRequestAsync,
63− tagPromptlyDyn )
81+
6482
6583-- * Accessing APIs as a Client
6684
@@ -72,28 +90,31 @@ import Reflex.Dom (Dynamic, Event, Reflex,
7290-- > myApi :: Proxy MyApi
7391-- > myApi = Proxy
7492-- >
75−-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
76−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t ()
77−-- -> m (Event t (Either XhrError (Book,Book)))
93+-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
94+-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
95+-- -> m (Event t (l, ReqResult Book)))
7896-- > (getAllBooks :<|> postNewBook) = client myApi host
7997-- > where host = constDyn $ BaseUrl Http "localhost" 8080
80−client :: (HasClient t m layout)
81− => Proxy layout -> Proxy m -> Dynamic t BaseUrl -> Client t m layout
82−client p q baseurl = clientWithRoute p q defReq baseurl
98+client :: (HasClient t m layout tag)
99+ => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag
100+client p q t baseurl = clientWithRoute p q t defReq baseurl
101+
83102
84103-- | This class lets us define how each API combinator
85104-- influences the creation of an HTTP request. It's mostly
86105-- an internal class, you can just use 'client'.
87−class HasClient t m layout where
88− type Client t m layout :: *
89− clientWithRoute :: Proxy layout -> Proxy m -> Req t -> Dynamic t BaseUrl -> Client t m layout
106+class HasClient t m layout (tag :: *) where
107+ type Client t m layout tag :: *
108+ clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> Client t m layout tag
90109
91110
92−instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
93− type Client t m (a :<|> b) = Client t m a :<|> Client t m b
94− clientWithRoute Proxy q req baseurl =
95− clientWithRoute (Proxy :: Proxy a) q req baseurl :<|>
96− clientWithRoute (Proxy :: Proxy b) q req baseurl
111+instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
112+ type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
113+
114+ clientWithRoute Proxy q pTag req baseurl =
115+ clientWithRoute (Proxy :: Proxy a) q pTag req baseurl :<|>
116+ clientWithRoute (Proxy :: Proxy b) q pTag req baseurl
117+
97118
98119-- Capture. Example:
99120-- > type MyApi = "books" :> Capture "isbn" Text :> Get '[JSON] Book
@@ -103,50 +124,54 @@ instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
103124-- > getBook :: SupportsServantReflex t m
104125-- => Dynamic t BaseUrl
105126-- -> Dynamic t (Maybe Text)
106−-- -> Event t ()
107−-- -> m (Event t (Either XhrError (Text, Book)))
127+-- -> Event t l
128+-- -> m (Event t (l, ReqResult Book))
108129-- > getBook = client myApi (constDyn host)
109−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)
110− => HasClient t m (Capture capture a :> sublayout) where
111130
112− type Client t m (Capture capture a :> sublayout) =
113− Dynamic t (Either Text a) -> Client t m sublayout
131+instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)
132+ => HasClient t m (Capture capture a :> sublayout) tag where
133+
134+ type Client t m (Capture capture a :> sublayout) tag =
135+ Dynamic t (Either Text a) -> Client t m sublayout tag
114136
115− clientWithRoute Proxy q req baseurl val =
137+ clientWithRoute Proxy q t req baseurl val =
116138 clientWithRoute (Proxy :: Proxy sublayout)
117− q
139+ q t
118140 (prependToPathParts p req)
119141 baseurl
120−
121142 where p = (fmap . fmap) (toUrlPiece) val
122143
144+
123145-- VERB (Returning content) --
124146instance {-# OVERLAPPABLE #-}
125147 -- Note [Non-Empty Content Types]
126148 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
127− ) => HasClient t m (Verb method status cts' a) where
128− type Client t m (Verb method status cts' a) =
129− Event t () -> m (Event t (ReqResult a))
149+ ) => HasClient t m (Verb method status cts' a) tag where
150+ type Client t m (Verb method status cts' a) tag =
151+ Event t tag -> m (Event t (ReqResult tag a))
130152 -- TODO how to access input types here?
131153 -- ExceptT ServantError IO a
132− clientWithRoute Proxy _ req baseurl =
133− performRequestCT (Proxy :: Proxy ct) method req' baseurl
154+ clientWithRoute Proxy _ _ req baseurl trigs =
155+ -- performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
156+ fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity $ req') baseurl trigs
134157 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
135158 req' = req { reqMethod = method }
136159
160+
137161-- -- VERB (No content) --
138162instance {-# OVERLAPPING #-}
139163 (ReflectMethod method, SupportsServantReflex t m) =>
140− HasClient t m (Verb method status cts NoContent) where
141− type Client t m (Verb method status cts NoContent) =
142− Event t () -> m (Event t (ReqResult NoContent))
164+ HasClient t m (Verb method status cts NoContent) tag where
165+ type Client t m (Verb method status cts NoContent) tag =
166+ Event t tag -> m (Event t (ReqResult tag NoContent))
143167 -- TODO: how to access input types here?
144168 -- ExceptT ServantError IO NoContent
145− clientWithRoute Proxy _ req baseurl =
146− performRequestNoBody method req baseurl
169+ clientWithRoute Proxy _ _ req baseurl =
170+ (fmap . fmap) runIdentity . performRequestsNoBody method (constDyn $ Identity req) baseurl
147171 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
148172
149−toHeaders :: BuildHeadersTo ls => ReqResult a -> ReqResult (Headers ls a)
173+
174+toHeaders :: BuildHeadersTo ls => ReqResult tag a -> ReqResult tag (Headers ls a)
150175toHeaders r =
151176 let toBS = E.encodeUtf8
152177 hdrs = maybe []
@@ -162,8 +187,8 @@ instance {-# OVERLAPPABLE #-} BuildHeaderKeysTo '[]
162187 where buildHeaderKeysTo _ = []
163188
164189instance {-# OVERLAPPABLE #-} (BuildHeaderKeysTo xs, KnownSymbol h)
165− => BuildHeaderKeysTo '[(Header h v) ': xs] where
166− buildHeaderKeysTo _ = (T.pack $ symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
190+ => BuildHeaderKeysTo ((Header h v) ': xs) where
191+ buildHeaderKeysTo _ = T.pack (symbolVal (Proxy :: Proxy h)) : buildHeaderKeysTo (Proxy :: Proxy xs)
167192
168193-- HEADERS Verb (Content) --
169194-- Headers combinator not treated in fully general case,
@@ -175,33 +200,35 @@ instance {-# OVERLAPPABLE #-}
175200 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
176201 ReflectMethod method, cts' ~ (ct ': cts),
177202 SupportsServantReflex t m
178− ) => HasClient t m (Verb method status cts' (Headers ls a)) where
179− type Client t m (Verb method status cts' (Headers ls a)) =
180− Event t () -> m (Event t (ReqResult (Headers ls a)))
181− clientWithRoute Proxy _ req baseurl = do
203+ ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
204+ type Client t m (Verb method status cts' (Headers ls a)) tag =
205+ Event t tag -> m (Event t (ReqResult tag (Headers ls a)))
206+ clientWithRoute Proxy _ _ req baseurl trigs = do
182207 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
183− resp <- performRequestCT (Proxy :: Proxy ct) method req' baseurl
184− return $ (fmap . fmap) toHeaders resp
208+ resp <- fmap runIdentity <$> performRequestsCT (Proxy :: Proxy ct) method (constDyn $ Identity req') baseurl trigs
209+ return $ toHeaders <$> resp
185210 where req' = req { respHeaders =
186211 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
187212 }
188213
214+
189215-- HEADERS Verb (No content) --
190216instance {-# OVERLAPPABLE #-}
191217 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
192218 SupportsServantReflex t m
193− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
194− type Client t m (Verb method status cts (Headers ls NoContent))
195− = Event t () -> m (Event t (ReqResult (Headers ls NoContent)))
196− clientWithRoute Proxy _ req baseurl = do
219+ ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
220+ type Client t m (Verb method status cts (Headers ls NoContent)) tag
221+ = Event t tag -> m (Event t (ReqResult tag (Headers ls NoContent)))
222+ clientWithRoute Proxy _ _ req baseurl trigs = do
197223 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
198− resp <- performRequestNoBody method req' baseurl
199− return $ (fmap . fmap) toHeaders resp
224+ resp <- fmap runIdentity <$> performRequestsNoBody method (constDyn $ Identity req') baseurl trigs
225+ return $ toHeaders <$> resp
200226 where req' = req {respHeaders =
201227 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
202228 }
203229
204230
231+
205232-- HEADER
206233-- > newtype Referer = Referer { referrer :: Text }
207234-- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)
@@ -216,29 +243,32 @@ instance {-# OVERLAPPABLE #-}
216243-- > -- then you can just use "viewRefer" to query that endpoint
217244-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
218245instance (KnownSymbol sym, ToHttpApiData a,
219− HasClient t m sublayout, SupportsServantReflex t m)
220− => HasClient t m (Header sym a :> sublayout) where
246+ HasClient t m sublayout tag, SupportsServantReflex t m)
247+ => HasClient t m (Header sym a :> sublayout) tag where
221248
222− type Client t m (Header sym a :> sublayout) =
223− Dynamic t (Either Text a) -> Client t m sublayout
249+ type Client t m (Header sym a :> sublayout) tag =
250+ Dynamic t (Either Text a) -> Client t m sublayout tag
224251
225− clientWithRoute Proxy q req baseurl eVal =
252+ clientWithRoute Proxy q t req baseurl eVal =
226253 clientWithRoute (Proxy :: Proxy sublayout)
227− q
254+ q t
228255 (Servant.Common.Req.addHeader hname eVal req)
229256 baseurl
230257 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
231258
259+
260+
261+
232262-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
233263-- functions.
234−instance HasClient t m sublayout
235− => HasClient t m (HttpVersion :> sublayout) where
264+instance HasClient t m sublayout tag
265+ => HasClient t m (HttpVersion :> sublayout) tag where
236266
237− type Client t m (HttpVersion :> sublayout) =
238− Client t m sublayout
267+ type Client t m (HttpVersion :> sublayout) tag =
268+ Client t m sublayout tag
239269
240− clientWithRoute Proxy q =
241− clientWithRoute (Proxy :: Proxy sublayout) q
270+ clientWithRoute Proxy q t =
271+ clientWithRoute (Proxy :: Proxy sublayout) q t
242272
243273
244274-- | If you use a 'QueryParam' in one of your endpoints in your API,
@@ -267,15 +297,15 @@ instance HasClient t m sublayout
267297-- > -- then you can just use "getBooksBy" to query that endpoint.
268298-- > -- 'getBooksBy Nothing' for all books
269299-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
270−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
271− => HasClient t m (QueryParam sym a :> sublayout) where
300+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
301+ => HasClient t m (QueryParam sym a :> sublayout) tag where
272302
273− type Client t m (QueryParam sym a :> sublayout) =
274− Dynamic t (QParam a) -> Client t m sublayout
303+ type Client t m (QueryParam sym a :> sublayout) tag =
304+ Dynamic t (QParam a) -> Client t m sublayout tag
275305
276306 -- if mparam = Nothing, we don't add it to the query string
277− clientWithRoute Proxy q req baseurl mparam =
278− clientWithRoute (Proxy :: Proxy sublayout) q
307+ clientWithRoute Proxy q t req baseurl mparam =
308+ clientWithRoute (Proxy :: Proxy sublayout) q t
279309 (req {qParams = paramPair : qParams req}) baseurl
280310
281311 where pname = symbolVal (Proxy :: Proxy sym)
@@ -284,6 +314,8 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
284314 p prm = QueryPartParam $ fmap qParamToQueryPart prm -- (fmap . fmap) (unpack . toQueryParam) prm
285315 paramPair = (T.pack pname, p mparam)
286316
317+
318+
287319-- | If you use a 'QueryParams' in one of your endpoints in your API,
288320-- the corresponding querying function will automatically take
289321-- an additional argument, a list of values of the type specified
@@ -312,21 +344,22 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
312344-- > -- 'getBooksBy []' for all books
313345-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
314346-- > -- to get all books by Asimov and Heinlein
315−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
316− => HasClient t m (QueryParams sym a :> sublayout) where
347+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
348+ => HasClient t m (QueryParams sym a :> sublayout) tag where
317349
318− type Client t m (QueryParams sym a :> sublayout) =
319− Dynamic t [a] -> Client t m sublayout
350+ type Client t m (QueryParams sym a :> sublayout) tag =
351+ Dynamic t [a] -> Client t m sublayout tag
320352
321− clientWithRoute Proxy q req baseurl paramlist =
322− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
353+ clientWithRoute Proxy q t req baseurl paramlist =
354+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
323355
324356 where req' = req { qParams = (T.pack pname, params') : qParams req }
325357 pname = symbolVal (Proxy :: Proxy sym)
326− params' = QueryPartParams $ (fmap . fmap) (toQueryParam)
358+ params' = QueryPartParams $ (fmap . fmap) toQueryParam
327359 paramlist
328360
329361
362+
330363-- | If you use a 'QueryFlag' in one of your endpoints in your API,
331364-- the corresponding querying function will automatically take
332365-- an additional 'Bool' argument.
@@ -351,49 +384,42 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
351384-- > -- 'getBooksBy True' to only get _already published_ books
352385
353386-- TODO Bring back
354−instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)
355− => HasClient t m (QueryFlag sym :> sublayout) where
387+instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
388+ => HasClient t m (QueryFlag sym :> sublayout) tag where
356389
357− type Client t m (QueryFlag sym :> sublayout) =
358− Dynamic t Bool -> Client t m sublayout
390+ type Client t m (QueryFlag sym :> sublayout) tag =
391+ Dynamic t Bool -> Client t m sublayout tag
359392
360− clientWithRoute Proxy q req baseurl flag =
361− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
393+ clientWithRoute Proxy q t req baseurl flag =
394+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
362395
363396 where req' = req { qParams = thisPair : qParams req }
364397 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
365398 pName = symbolVal (Proxy :: Proxy sym)
366399
367400
368−-- | Pick a 'Method' and specify where the server you want to query is. You get
369−-- back the full `Response`.
370−-- TODO redo
371−instance SupportsServantReflex t m => HasClient t m Raw where
372− type Client t m Raw = Dynamic t (Either Text (XhrRequest ()))
373− -> Event t ()
374− -> m (Event t (ReqResult ()))
375−
376− -- clientWithRoute :: Proxy Raw -> Proxy m -> Req -> BaseUrl -> Client t m Raw
377− clientWithRoute _ _ _ baseurl xhrs triggers = do
378− let xhrs' = liftA2 (\x path -> case x of
379− Left e -> Left e
380− Right jx -> Right $ jx {_xhrRequest_url = path
381− <> _xhrRequest_url jx})
382− xhrs
383− (showBaseUrl <$> baseurl)
384− reqs = tagPromptlyDyn xhrs' triggers
385− okReq = fmapMaybe hush reqs
386− badReq = fmapMaybe tattle reqs
387− resps <- performRequestAsync okReq
388− return $ leftmost [fmap (ResponseSuccess () ) resps
389− ,fmap RequestFailure badReq]
390−
391−
392−hush :: Either e a -> Maybe a
393−hush = either (const Nothing) Just
394−
395−tattle :: Either e a -> Maybe e
396−tattle = either Just (const Nothing)
401+
402+-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
403+instance SupportsServantReflex t m => HasClient t m Raw tag where
404+ type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
405+ -> Event t tag
406+ -> m (Event t (ReqResult tag ()))
407+
408+ clientWithRoute _ _ _ _ baseurl xhrs triggers = do
409+
410+ let xhrs' = liftA2 (\x path -> case x of
411+ Left e -> Left e
412+ Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
413+ ) xhrs (showBaseUrl <$> baseurl)
414+ xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
415+ badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
416+ okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
417+
418+ resps <- performRequestsAsync okReq
419+ return $ leftmost [ uncurry RequestFailure <$> badReq
420+ , evalResponse (const $ Right ()) <$> resps
421+ ]
422+
397423
398424-- | If you use a 'ReqBody' in one of your endpoints in your API,
399425-- the corresponding querying function will automatically take
@@ -415,14 +441,14 @@ tattle = either Just (const Nothing)
415441-- > where host = BaseUrl Http "localhost" 8080
416442-- > -- then you can just use "addBook" to query that endpoint
417443
418−instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
419− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
444+instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
445+ => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
420446
421− type Client t m (ReqBody (ct ': cts) a :> sublayout) =
422− Dynamic t (Either Text a) -> Client t m sublayout
447+ type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
448+ Dynamic t (Either Text a) -> Client t m sublayout tag
423449
424− clientWithRoute Proxy q req baseurl body =
425− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
450+ clientWithRoute Proxy q t req baseurl body =
451+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
426452 where req' = req { reqBody = bodyBytesCT }
427453 ctProxy = Proxy :: Proxy ct
428454 ctString = T.pack $ show $ contentType ctProxy
@@ -430,43 +456,49 @@ instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
430456 (\b -> (mimeRender ctProxy b, ctString))
431457 body
432458
459+
460+
433461-- | Make the querying function append @path@ to the request path.
434−instance (KnownSymbol path, HasClient t m sublayout, Reflex t) => HasClient t m (path :> sublayout) where
435− type Client t m (path :> sublayout) = Client t m sublayout
462+instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
463+ type Client t m (path :> sublayout) tag = Client t m sublayout tag
436464
437− clientWithRoute Proxy q req baseurl =
438− clientWithRoute (Proxy :: Proxy sublayout) q
439− (prependToPathParts (pure (Right $ T.pack p)) req)
440− baseurl
465+ clientWithRoute Proxy q t req baseurl =
466+ clientWithRoute (Proxy :: Proxy sublayout) q t
467+ (prependToPathParts (pure (Right $ T.pack p)) req) baseurl
441468
442469 where p = symbolVal (Proxy :: Proxy path)
443470
444−instance HasClient t m api => HasClient t m (Vault :> api) where
445− type Client t m (Vault :> api) = Client t m api
446471
447− clientWithRoute Proxy q req baseurl =
448− clientWithRoute (Proxy :: Proxy api) q req baseurl
472+instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
473+ type Client t m (Vault :> api) tag = Client t m api tag
474+
475+ clientWithRoute Proxy q t req baseurl =
476+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
477+
478+
479+instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
480+ type Client t m (RemoteHost :> api) tag = Client t m api tag
481+
482+ clientWithRoute Proxy q t req baseurl =
483+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
484+
449485
450−instance HasClient t m api => HasClient t m (RemoteHost :> api) where
451− type Client t m (RemoteHost :> api) = Client t m api
452486
453− clientWithRoute Proxy q req baseurl =
454− clientWithRoute (Proxy :: Proxy api) q req baseurl
487+instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
488+ type Client t m (IsSecure :> api) tag = Client t m api tag
455489
456−instance HasClient t m api => HasClient t m (IsSecure :> api) where
457− type Client t m (IsSecure :> api) = Client t m api
490+ clientWithRoute Proxy q t req baseurl =
491+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
458492
459− clientWithRoute Proxy q req baseurl =
460− clientWithRoute (Proxy :: Proxy api) q req baseurl
461493
462−instance (HasClient t m api, Reflex t)
463− => HasClient t m (BasicAuth realm usr :> api) where
494+instance (HasClient t m api tag, Reflex t)
495+ => HasClient t m (BasicAuth realm usr :> api) tag where
464496
465− type Client t m (BasicAuth realm usr :> api) = Dynamic t (Maybe BasicAuthData)
466− -> Client t m api
497+ type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
498+ -> Client t m api tag
467499
468− clientWithRoute Proxy q req baseurl authdata =
469− clientWithRoute (Proxy :: Proxy api) q req' baseurl
500+ clientWithRoute Proxy q t req baseurl authdata =
501+ clientWithRoute (Proxy :: Proxy api) q t req' baseurl
470502 where
471503 req' = req { authData = Just authdata }
472504