@@ -50,9 +50,9 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,
5050import Reflex.Dom (Dynamic, Event, Reflex,
5151 XhrRequest(..),
5252 XhrResponseHeaders(..),
53− XhrResponse(..), ffor, fmapMaybe,
54− leftmost, performRequestAsync,
55− tagPromptlyDyn )
53+ XhrResponse(..), attachPromptlyDynWith, ffor, fmapMaybe,
54+ leftmost, performRequestsAsync,
55+ )
5656------------------------------------------------------------------------------
5757import Servant.Common.BaseUrl (BaseUrl(..), Scheme(..), baseUrlWidget,
5858 showBaseUrl,
@@ -80,30 +80,30 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),
8080-- > myApi :: Proxy MyApi
8181-- > myApi = Proxy
8282-- >
83−-- > getAllBooks :: Event t () -> m (Event t (Either XhrError ((),[Book])))
84−-- > postNewBook :: Dynamic t (Maybe Book) -> Event t ()
85−-- -> m (Event t (Either XhrError (Book,Book)))
83+-- > getAllBooks :: Event t l -> m (Event t (l, ReqResult [Book]))
84+-- > postNewBook :: Dynamic t (Maybe Book) -> Event t l
85+-- -> m (Event t (l, ReqResult Book)))
8686-- > (getAllBooks :<|> postNewBook) = client myApi host
8787-- > where host = constDyn $ BaseUrl Http "localhost" 8080
88−client :: (HasClient t m layout)
89− => Proxy layout -> Proxy m -> Dynamic t BaseUrl -> Client t m layout
90−client p q baseurl = clientWithRoute p q defReq baseurl
88+client :: (HasClient t m layout tag)
89+ => Proxy layout -> Proxy m -> Proxy tag -> Dynamic t BaseUrl -> Client t m layout tag
90+client p q t baseurl = clientWithRoute p q t defReq baseurl
9191
9292
9393-- | This class lets us define how each API combinator
9494-- influences the creation of an HTTP request. It's mostly
9595-- an internal class, you can just use 'client'.
96−class HasClient t m layout where
97− type Client t m layout :: *
98− clientWithRoute :: Proxy layout -> Proxy m -> Req t -> Dynamic t BaseUrl -> Client t m layout
96+class HasClient t m layout (tag :: *) where
97+ type Client t m layout tag :: *
98+ clientWithRoute :: Proxy layout -> Proxy m -> Proxy tag -> Req t -> Dynamic t BaseUrl -> Client t m layout tag
9999
100100
101−instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
102− type Client t m (a :<|> b) = Client t m a :<|> Client t m b
101+instance (HasClient t m a tag, HasClient t m b tag) => HasClient t m (a :<|> b) tag where
102+ type Client t m (a :<|> b) tag = Client t m a tag :<|> Client t m b tag
103103
104− clientWithRoute Proxy q req baseurl =
105− clientWithRoute (Proxy :: Proxy a) q req baseurl :<|>
106− clientWithRoute (Proxy :: Proxy b) q req baseurl
104+ clientWithRoute Proxy q pTag req baseurl =
105+ clientWithRoute (Proxy :: Proxy a) q pTag req baseurl :<|>
106+ clientWithRoute (Proxy :: Proxy b) q pTag req baseurl
107107
108108
109109-- Capture. Example:
@@ -114,19 +114,19 @@ instance (HasClient t m a, HasClient t m b) => HasClient t m (a :<|> b) where
114114-- > getBook :: SupportsServantReflex t m
115115-- => Dynamic t BaseUrl
116116-- -> Dynamic t (Maybe Text)
117−-- -> Event t ()
118−-- -> m (Event t (Either XhrError (Text, Book)))
117+-- -> Event t l
118+-- -> m (Event t (l, ReqResult Book))
119119-- > getBook = client myApi (constDyn host)
120120
121−instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)
122− => HasClient t m (Capture capture a :> sublayout) where
121+instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout tag)
122+ => HasClient t m (Capture capture a :> sublayout) tag where
123123
124− type Client t m (Capture capture a :> sublayout) =
125− Dynamic t (Either Text a) -> Client t m sublayout
124+ type Client t m (Capture capture a :> sublayout) tag =
125+ Dynamic t (Either Text a) -> Client t m sublayout tag
126126
127− clientWithRoute Proxy q req baseurl val =
127+ clientWithRoute Proxy q t req baseurl val =
128128 clientWithRoute (Proxy :: Proxy sublayout)
129− q
129+ q t
130130 (prependToPathParts p req)
131131 baseurl
132132 where p = (fmap . fmap) (toUrlPiece) val
@@ -136,28 +136,26 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClient t m sublayout)
136136instance {-# OVERLAPPABLE #-}
137137 -- Note [Non-Empty Content Types]
138138 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts), SupportsServantReflex t m
139− ) => HasClient t m (Verb method status cts' a) where
140− type Client t m (Verb method status cts' a) =
141− Event t () -> m (Event t (ReqResult a))
139+ ) => HasClient t m (Verb method status cts' a) tag where
140+ type Client t m (Verb method status cts' a) tag =
141+ Event t tag -> m (Event t (tag, ReqResult a))
142142 -- TODO how to access input types here?
143143 -- ExceptT ServantError IO a
144− clientWithRoute Proxy _ req baseurl =
145− performRequestCT (Proxy :: Proxy ct) method req' baseurl
144+ clientWithRoute Proxy _ _ req baseurl trigs =
145+ performRequestCT (Proxy :: Proxy ct) method req' baseurl trigs
146146 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
147147 req' = req { reqMethod = method }
148148
149149
150−
151−
152150-- -- VERB (No content) --
153151instance {-# OVERLAPPING #-}
154152 (ReflectMethod method, SupportsServantReflex t m) =>
155− HasClient t m (Verb method status cts NoContent) where
156− type Client t m (Verb method status cts NoContent) =
157− Event t () -> m (Event t (ReqResult NoContent))
153+ HasClient t m (Verb method status cts NoContent) tag where
154+ type Client t m (Verb method status cts NoContent) tag =
155+ Event t tag -> m (Event t (tag, ReqResult NoContent))
158156 -- TODO: how to access input types here?
159157 -- ExceptT ServantError IO NoContent
160− clientWithRoute Proxy _ req baseurl =
158+ clientWithRoute Proxy _ _ req baseurl =
161159 performRequestNoBody method req baseurl
162160 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
163161
@@ -191,13 +189,13 @@ instance {-# OVERLAPPABLE #-}
191189 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
192190 ReflectMethod method, cts' ~ (ct ': cts),
193191 SupportsServantReflex t m
194− ) => HasClient t m (Verb method status cts' (Headers ls a)) where
195− type Client t m (Verb method status cts' (Headers ls a)) =
196− Event t () -> m (Event t (ReqResult (Headers ls a)))
197− clientWithRoute Proxy _ req baseurl = do
192+ ) => HasClient t m (Verb method status cts' (Headers ls a)) tag where
193+ type Client t m (Verb method status cts' (Headers ls a)) tag =
194+ Event t tag -> m (Event t (tag, ReqResult (Headers ls a)))
195+ clientWithRoute Proxy _ _ req baseurl = do
198196 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
199197 resp <- performRequestCT (Proxy :: Proxy ct) method req' baseurl
200− return $ (fmap . fmap) toHeaders resp
198+ return $ (fmap . fmap) toHeaders <$> resp
201199 where req' = req { respHeaders =
202200 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
203201 }
@@ -207,13 +205,13 @@ instance {-# OVERLAPPABLE #-}
207205instance {-# OVERLAPPABLE #-}
208206 ( BuildHeadersTo ls, BuildHeaderKeysTo ls, ReflectMethod method,
209207 SupportsServantReflex t m
210− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
211− type Client t m (Verb method status cts (Headers ls NoContent))
212− = Event t () -> m (Event t (ReqResult (Headers ls NoContent)))
213− clientWithRoute Proxy _ req baseurl = do
208+ ) => HasClient t m (Verb method status cts (Headers ls NoContent)) tag where
209+ type Client t m (Verb method status cts (Headers ls NoContent)) tag
210+ = Event t tag -> m (Event t (tag, ReqResult (Headers ls NoContent)))
211+ clientWithRoute Proxy _ _ req baseurl = do
214212 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
215213 resp <- performRequestNoBody method req' baseurl
216− return $ (fmap . fmap) toHeaders resp
214+ return $ (fmap . fmap) toHeaders <$> resp
217215 where req' = req {respHeaders =
218216 OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
219217 }
@@ -234,15 +232,15 @@ instance {-# OVERLAPPABLE #-}
234232-- > -- then you can just use "viewRefer" to query that endpoint
235233-- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments
236234instance (KnownSymbol sym, ToHttpApiData a,
237− HasClient t m sublayout, SupportsServantReflex t m)
238− => HasClient t m (Header sym a :> sublayout) where
235+ HasClient t m sublayout tag, SupportsServantReflex t m)
236+ => HasClient t m (Header sym a :> sublayout) tag where
239237
240− type Client t m (Header sym a :> sublayout) =
241− Dynamic t (Either Text a) -> Client t m sublayout
238+ type Client t m (Header sym a :> sublayout) tag =
239+ Dynamic t (Either Text a) -> Client t m sublayout tag
242240
243− clientWithRoute Proxy q req baseurl eVal =
241+ clientWithRoute Proxy q t req baseurl eVal =
244242 clientWithRoute (Proxy :: Proxy sublayout)
245− q
243+ q t
246244 (Servant.Common.Req.addHeader hname eVal req)
247245 baseurl
248246 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
@@ -252,14 +250,14 @@ instance (KnownSymbol sym, ToHttpApiData a,
252250
253251-- | Using a 'HttpVersion' combinator in your API doesn't affect the client
254252-- functions.
255−instance HasClient t m sublayout
256− => HasClient t m (HttpVersion :> sublayout) where
253+instance HasClient t m sublayout tag
254+ => HasClient t m (HttpVersion :> sublayout) tag where
257255
258− type Client t m (HttpVersion :> sublayout) =
259− Client t m sublayout
256+ type Client t m (HttpVersion :> sublayout) tag =
257+ Client t m sublayout tag
260258
261− clientWithRoute Proxy q =
262− clientWithRoute (Proxy :: Proxy sublayout) q
259+ clientWithRoute Proxy q t =
260+ clientWithRoute (Proxy :: Proxy sublayout) q t
263261
264262
265263
@@ -289,15 +287,15 @@ instance HasClient t m sublayout
289287-- > -- then you can just use "getBooksBy" to query that endpoint.
290288-- > -- 'getBooksBy Nothing' for all books
291289-- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov
292−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
293− => HasClient t m (QueryParam sym a :> sublayout) where
290+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
291+ => HasClient t m (QueryParam sym a :> sublayout) tag where
294292
295− type Client t m (QueryParam sym a :> sublayout) =
296− Dynamic t (QParam a) -> Client t m sublayout
293+ type Client t m (QueryParam sym a :> sublayout) tag =
294+ Dynamic t (QParam a) -> Client t m sublayout tag
297295
298296 -- if mparam = Nothing, we don't add it to the query string
299− clientWithRoute Proxy q req baseurl mparam =
300− clientWithRoute (Proxy :: Proxy sublayout) q
297+ clientWithRoute Proxy q t req baseurl mparam =
298+ clientWithRoute (Proxy :: Proxy sublayout) q t
301299 (req {qParams = paramPair : qParams req}) baseurl
302300
303301 where pname = symbolVal (Proxy :: Proxy sym)
@@ -336,14 +334,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
336334-- > -- 'getBooksBy []' for all books
337335-- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'
338336-- > -- to get all books by Asimov and Heinlein
339−instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
340− => HasClient t m (QueryParams sym a :> sublayout) where
337+instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout tag, Reflex t)
338+ => HasClient t m (QueryParams sym a :> sublayout) tag where
341339
342− type Client t m (QueryParams sym a :> sublayout) =
343− Dynamic t [a] -> Client t m sublayout
340+ type Client t m (QueryParams sym a :> sublayout) tag =
341+ Dynamic t [a] -> Client t m sublayout tag
344342
345− clientWithRoute Proxy q req baseurl paramlist =
346− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
343+ clientWithRoute Proxy q t req baseurl paramlist =
344+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
347345
348346 where req' = req { qParams = (T.pack pname, params') : qParams req }
349347 pname = symbolVal (Proxy :: Proxy sym)
@@ -376,14 +374,14 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout, Reflex t)
376374-- > -- 'getBooksBy True' to only get _already published_ books
377375
378376-- TODO Bring back
379−instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)
380− => HasClient t m (QueryFlag sym :> sublayout) where
377+instance (KnownSymbol sym, HasClient t m sublayout tag, Reflex t)
378+ => HasClient t m (QueryFlag sym :> sublayout) tag where
381379
382− type Client t m (QueryFlag sym :> sublayout) =
383− Dynamic t Bool -> Client t m sublayout
380+ type Client t m (QueryFlag sym :> sublayout) tag =
381+ Dynamic t Bool -> Client t m sublayout tag
384382
385− clientWithRoute Proxy q req baseurl flag =
386− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
383+ clientWithRoute Proxy q t req baseurl flag =
384+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
387385
388386 where req' = req { qParams = thisPair : qParams req }
389387 thisPair = (T.pack pName, QueryPartFlag flag) :: (Text, QueryPart t)
@@ -391,36 +389,26 @@ instance (KnownSymbol sym, HasClient t m sublayout, Reflex t)
391389
392390
393391
394−-- | Pick a 'Method' and specify where the server you want to query is. You get
395−-- back the full `Response`.
396−-- TODO redo
397−instance SupportsServantReflex t m => HasClient t m Raw where
398− type Client t m Raw = Dynamic t (Either Text (XhrRequest ()))
399− -> Event t ()
400− -> m (Event t (ReqResult ()))
401−
402− -- clientWithRoute :: Proxy Raw -> Proxy m -> Req -> BaseUrl -> Client t m Raw
403− clientWithRoute _ _ _ baseurl xhrs triggers = do
404− let xhrs' = liftA2 (\x path -> case x of
405− Left e -> Left e
406− Right jx -> Right $ jx {_xhrRequest_url = path
407− <> _xhrRequest_url jx})
408− xhrs
409− (showBaseUrl <$> baseurl)
410− reqs = tagPromptlyDyn xhrs' triggers
411− okReq = fmapMaybe hush reqs
412− badReq = fmapMaybe tattle reqs
413− resps <- performRequestAsync okReq
414− return $ leftmost [fmap (ResponseSuccess () ) resps
415− ,fmap RequestFailure badReq]
392+-- | Send a raw 'XhrRequest ()' directly to 'baseurl'
393+instance SupportsServantReflex t m => HasClient t m Raw tag where
394+ type Client t m Raw tag = Dynamic t (Either Text (XhrRequest ()))
395+ -> Event t tag
396+ -> m (Event t (tag, ReqResult ()))
416397
398+ clientWithRoute _ _ _ _ baseurl xhrs triggers = do
417399
400+ let xhrs' = liftA2 (\x path -> case x of
401+ Left e -> Left e
402+ Right jx -> Right $ jx { _xhrRequest_url = path <> _xhrRequest_url jx }
403+ ) xhrs (showBaseUrl <$> baseurl)
404+ xhrs'' = attachPromptlyDynWith (flip (,)) xhrs' triggers :: Event t (tag, Either Text (XhrRequest ()))
405+ badReq = fmapMaybe (\(t,x) -> either (Just . (t,)) (const Nothing) x) xhrs'' :: Event t (tag, Text)
406+ okReq = fmapMaybe (\(t,x) -> either (const Nothing) (Just . (t,)) x) xhrs'' :: Event t (tag, XhrRequest ())
418407
419−hush :: Either e a -> Maybe a
420−hush = either (const Nothing) Just
408+ resps <- performRequestsAsync okReq
409+ return $ leftmost [ fmap (ResponseSuccess ()) <$> resps
410+ , fmap (RequestFailure) <$> badReq ]
421411
422−tattle :: Either e a -> Maybe e
423−tattle = either Just (const Nothing)
424412
425413-- | If you use a 'ReqBody' in one of your endpoints in your API,
426414-- the corresponding querying function will automatically take
@@ -442,14 +430,14 @@ tattle = either Just (const Nothing)
442430-- > where host = BaseUrl Http "localhost" 8080
443431-- > -- then you can just use "addBook" to query that endpoint
444432
445−instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
446− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
433+instance (MimeRender ct a, HasClient t m sublayout tag, Reflex t)
434+ => HasClient t m (ReqBody (ct ': cts) a :> sublayout) tag where
447435
448− type Client t m (ReqBody (ct ': cts) a :> sublayout) =
449− Dynamic t (Either Text a) -> Client t m sublayout
436+ type Client t m (ReqBody (ct ': cts) a :> sublayout) tag =
437+ Dynamic t (Either Text a) -> Client t m sublayout tag
450438
451− clientWithRoute Proxy q req baseurl body =
452− clientWithRoute (Proxy :: Proxy sublayout) q req' baseurl
439+ clientWithRoute Proxy q t req baseurl body =
440+ clientWithRoute (Proxy :: Proxy sublayout) q t req' baseurl
453441 where req' = req { reqBody = bodyBytesCT }
454442 ctProxy = Proxy :: Proxy ct
455443 ctString = T.pack $ show $ contentType ctProxy
@@ -460,47 +448,47 @@ instance (MimeRender ct a, HasClient t m sublayout, Reflex t)
460448
461449
462450-- | Make the querying function append @path@ to the request path.
463−instance (KnownSymbol path, HasClient t m sublayout, Reflex t) => HasClient t m (path :> sublayout) where
464− type Client t m (path :> sublayout) = Client t m sublayout
451+instance (KnownSymbol path, HasClient t m sublayout tag, Reflex t) => HasClient t m (path :> sublayout) tag where
452+ type Client t m (path :> sublayout) tag = Client t m sublayout tag
465453
466− clientWithRoute Proxy q req baseurl =
467− clientWithRoute (Proxy :: Proxy sublayout) q
454+ clientWithRoute Proxy q t req baseurl =
455+ clientWithRoute (Proxy :: Proxy sublayout) q t
468456 (prependToPathParts (pure (Right $ T.pack p)) req)
469457 baseurl
470458
471459 where p = symbolVal (Proxy :: Proxy path)
472460
473461
474−instance HasClient t m api => HasClient t m (Vault :> api) where
475− type Client t m (Vault :> api) = Client t m api
462+instance HasClient t m api tag => HasClient t m (Vault :> api) tag where
463+ type Client t m (Vault :> api) tag = Client t m api tag
476464
477− clientWithRoute Proxy q req baseurl =
478− clientWithRoute (Proxy :: Proxy api) q req baseurl
465+ clientWithRoute Proxy q t req baseurl =
466+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
479467
480468
481−instance HasClient t m api => HasClient t m (RemoteHost :> api) where
482− type Client t m (RemoteHost :> api) = Client t m api
469+instance HasClient t m api tag => HasClient t m (RemoteHost :> api) tag where
470+ type Client t m (RemoteHost :> api) tag = Client t m api tag
483471
484− clientWithRoute Proxy q req baseurl =
485− clientWithRoute (Proxy :: Proxy api) q req baseurl
472+ clientWithRoute Proxy q t req baseurl =
473+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
486474
487475
488476
489−instance HasClient t m api => HasClient t m (IsSecure :> api) where
490− type Client t m (IsSecure :> api) = Client t m api
477+instance HasClient t m api tag => HasClient t m (IsSecure :> api) tag where
478+ type Client t m (IsSecure :> api) tag = Client t m api tag
491479
492− clientWithRoute Proxy q req baseurl =
493− clientWithRoute (Proxy :: Proxy api) q req baseurl
480+ clientWithRoute Proxy q t req baseurl =
481+ clientWithRoute (Proxy :: Proxy api) q t req baseurl
494482
495483
496−instance (HasClient t m api, Reflex t)
497− => HasClient t m (BasicAuth realm usr :> api) where
484+instance (HasClient t m api tag, Reflex t)
485+ => HasClient t m (BasicAuth realm usr :> api) tag where
498486
499− type Client t m (BasicAuth realm usr :> api) = Dynamic t (Maybe BasicAuthData)
500− -> Client t m api
487+ type Client t m (BasicAuth realm usr :> api) tag = Dynamic t (Maybe BasicAuthData)
488+ -> Client t m api tag
501489
502− clientWithRoute Proxy q req baseurl authdata =
503− clientWithRoute (Proxy :: Proxy api) q req' baseurl
490+ clientWithRoute Proxy q t req baseurl authdata =
491+ clientWithRoute (Proxy :: Proxy api) q t req' baseurl
504492 where
505493 req' = req { authData = Just authdata }
506494