on master help sign in
add ms. about to remove them
commit24b5f87ad4094e79440c05c4a4c5eab2ad86c96d authorGreg Hale <imalsogreg@gmail.com> dateThu 18 Feb 2016, 15:15 (11 years ago) parent588c62e
2 files changed+88−79
src/Servant/Common/Req.hs+2−1 src/Servant/Reflex.hs+86−78
src/Servant/Common/Req.hs+2−1
@@ -144,7 +144,8 @@ performRequestCT :: (MonadWidget t m, FromHttpApiData a)
144144 => String -> Req t -> Dynamic t BaseUrl
145145 -> Event t () -> m (Event t (Maybe a, XhrResponse))
146146performRequestCT reqMethod req reqHost trigger = do
147− fmap () -- TODO
147+ resp <- performRequest reqMethod req reqHost trigger
148+ return $ ffor resp $ \xhr -> undefined
148149
149150
150151 -- partialRequest <- liftIO $ reqToRequest req reqHost
src/Servant/Reflex.hs+86−78
@@ -55,7 +55,7 @@ import Reflex.Dom.Xhr
5555-- -> m (Event t (Either XhrError (Book,Book)))
5656-- > (getAllBooks :<|> postNewBook) = client myApi host
5757-- > where host = constDyn $ BaseUrl Http "localhost" 8080
58−client :: (HasClient t m layout) => Proxy layout -> Dynamic t BaseUrl -> Client t m layout
58+client :: (HasClient t m layout, MonadWidget t m) => Proxy layout -> Dynamic t BaseUrl -> Client t m layout
5959client p baseurl = clientWithRoute p defReq baseurl
6060
6161-- | This class lets us define how each API combinator
@@ -109,52 +109,55 @@ instance {-# OVERLAPPABLE #-}
109109 performRequestCT (Proxy :: Proxy ct) method req baseurl
110110 where method = reflectMethod (Proxy :: Proxy method)
111111
112−-- VERB (No content) --
113−instance {-# OVERLAPPABLE #-}
114− (ReflectMethod method, MonadWidget t m) =>
115− HasClient t m (Verb method status cts NoContent) where
116− type Client t m (Verb method status cts NoContent) =
117− Event t () -> m (Event t XhrResponse)
118− -- TODO: how to access input types here?
119− -- ExceptT ServantError IO NoContent
120− clientWithRoute Proxy req baseurl =
121− performRequestNoBody method req baseurl
122− where method = reflectMethod (Proxy :: Proxy method)
112+-- TODO Overlapping error??
113+-- -- VERB (No content) --
114+-- instance {-# OVERLAPPABLE #-}
115+-- (ReflectMethod method, MonadWidget t m) =>
116+-- HasClient t m (Verb method status cts NoContent) where
117+-- type Client t m (Verb method status cts NoContent) =
118+-- Event t () -> m (Event t XhrResponse)
119+-- -- TODO: how to access input types here?
120+-- -- ExceptT ServantError IO NoContent
121+-- clientWithRoute Proxy req baseurl =
122+-- performRequestNoBody method req baseurl
123+-- where method = reflectMethod (Proxy :: Proxy method)
123124
124125-- HEADERS Verb (Content) --
125126-- Headers combinator not treated in fully general case,
126127-- in order to deny instances for (Headers ls (Capture "id" Int)),
127128-- a combinator that wouldn't make sense
128−instance {-# OVERLAPPABLE #-}
129− -- Note [Non-Empty Content Types]
130− ( MimeUnrender ct a, BuildHeadersTo ls,
131− ReflectMethod method, cts' ~ (ct ': cts),
132− MonadWidget t m
133− ) => HasClient t m (Verb method status cts' (Headers ls a)) where
134− type Client t m (Verb method status cts' (Headers ls a))
135− = Event t () -> m (Event t (Maybe a, XhrResponse))
136− -- ExceptT ServantError IO (Headers ls a)
137− clientWithRoute Proxy req baseurl = do
138− let method = reflectMethod (Proxy :: Proxy method)
139− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl
140− return $ Headers { getResponse = resp
141− , getHeadersHList = buildHeadersTo hdrs
142− }
143−
144−-- HEADERS Verb (No content) --
145−instance {-# OVERLAPPABLE #-}
146− ( BuildHeadersTo ls, ReflectMethod method,
147− MonadWidget t m
148− ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
149− type Client t m (Verb method status cts (Headers ls NoContent))
150− = Event t () -> m (Event t XhrResponse)
151− -- ExceptT ServantError IO (Headers ls NoContent)
152− clientWithRoute Proxy req baseurl = do
153− let method = reflectMethod (Proxy :: Proxy method)
154− hdrs <- performRequestNoBody method req baseurl
155− return $ Headers { getResponse = NoContent
156− , getHeadersHList = buildHeadersTo hdrs
157− }
129+-- TODO Overlapping??
130+-- instance {-# OVERLAPPABLE #-}
131+-- -- Note [Non-Empty Content Types]
132+-- ( MimeUnrender ct a, BuildHeadersTo ls,
133+-- ReflectMethod method, cts' ~ (ct ': cts),
134+-- MonadWidget t m
135+-- ) => HasClient t m (Verb method status cts' (Headers ls a)) where
136+-- type Client t m (Verb method status cts' (Headers ls a))
137+-- = Event t () -> m (Event t (Maybe a, XhrResponse))
138+-- -- ExceptT ServantError IO (Headers ls a)
139+-- clientWithRoute Proxy req baseurl = do
140+-- let method = reflectMethod (Proxy :: Proxy method)
141+-- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl
142+-- return $ Headers { getResponse = resp
143+-- , getHeadersHList = buildHeadersTo hdrs
144+-- }
145+
146+-- TODO Overlapping??
147+-- -- HEADERS Verb (No content) --
148+-- instance {-# OVERLAPPABLE #-}
149+-- ( BuildHeadersTo ls, ReflectMethod method,
150+-- MonadWidget t m
151+-- ) => HasClient t m (Verb method status cts (Headers ls NoContent)) where
152+-- type Client t m (Verb method status cts (Headers ls NoContent))
153+-- = Event t () -> m (Event t XhrResponse)
154+-- -- ExceptT ServantError IO (Headers ls NoContent)
155+-- clientWithRoute Proxy req baseurl = do
156+-- let method = reflectMethod (Proxy :: Proxy method)
157+-- hdrs <- performRequestNoBody method req baseurl
158+-- return $ Headers { getResponse = NoContent
159+-- , getHeadersHList = buildHeadersTo hdrs
160+-- }
158161
159162
160163-- HEADER
@@ -275,17 +278,18 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout)
275278 type Client t m (QueryParams sym a :> sublayout) =
276279 [a] -> Client t m sublayout
277280
278− clientWithRoute Proxy req baseurl paramlist =
279− clientWithRoute (Proxy :: Proxy sublayout)
280− (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
281− req
282− paramlist'
283− )
284− baseurl
281+ clientWithRoute Proxy req baseurl paramlist = undefined
282+ -- clientWithRoute (Proxy :: Proxy sublayout)
283+ -- (foldl' prependPathParts req paramlist')
284+ -- (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just))
285+ -- req
286+ -- paramlist'
287+ -- )
288+ -- baseurl
285289
286− where pname = cs pname'
287− pname' = symbolVal (Proxy :: Proxy sym)
288− paramlist' = map (Just . toQueryParam) paramlist
290+ -- where pname = cs pname'
291+ -- pname' = symbolVal (Proxy :: Proxy sym)
292+ -- paramlist' = map (Just . toQueryParam) paramlist
289293
290294-- | If you use a 'QueryFlag' in one of your endpoints in your API,
291295-- the corresponding querying function will automatically take
@@ -309,21 +313,23 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClient t m sublayout)
309313-- > -- then you can just use "getBooks" to query that endpoint.
310314-- > -- 'getBooksBy False' for all books
311315-- > -- 'getBooksBy True' to only get _already published_ books
312−instance (KnownSymbol sym, HasClient t m sublayout)
313− => HasClient t m (QueryFlag sym :> sublayout) where
314316
315− type Client t m (QueryFlag sym :> sublayout) =
316− Bool -> Client t m sublayout
317+-- TODO Bring back
318+-- instance (KnownSymbol sym, HasClient t m sublayout)
319+-- => HasClient t m (QueryFlag sym :> sublayout) where
317320
318− clientWithRoute Proxy req baseurl flag =
319− clientWithRoute (Proxy :: Proxy sublayout)
320− (if flag
321− then appendToQueryString paramname Nothing req
322− else req
323− )
324− baseurl
321+-- type Client t m (QueryFlag sym :> sublayout) =
322+-- Bool -> Client t m sublayout
325323
326− where paramname = cs $ symbolVal (Proxy :: Proxy sym)
324+-- clientWithRoute Proxy req baseurl flag =
325+-- clientWithRoute (Proxy :: Proxy sublayout)
326+-- (if flag
327+-- then appendToQueryString paramname Nothing req
328+-- else req
329+-- )
330+-- baseurl
331+
332+-- where paramname = cs $ symbolVal (Proxy :: Proxy sym)
327333
328334
329335-- | Pick a 'Method' and specify where the server you want to query is. You get
@@ -355,20 +361,22 @@ instance (KnownSymbol sym, HasClient t m sublayout)
355361-- > addBook = client myApi host
356362-- > where host = BaseUrl Http "localhost" 8080
357363-- > -- then you can just use "addBook" to query that endpoint
358−instance (MimeRender ct a, HasClient t m sublayout)
359− => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
360364
361− type Client t m (ReqBody (ct ': cts) a :> sublayout) =
362− a -> Client sublayout
365+-- TODO: Bring back
366+-- instance (MimeRender ct a, HasClient t m sublayout)
367+-- => HasClient t m (ReqBody (ct ': cts) a :> sublayout) where
363368
364− clientWithRoute Proxy req baseurl 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
369+-- type Client t m (ReqBody (ct ': cts) a :> sublayout) =
370+-- a -> Client sublayout
371+
372+-- clientWithRoute Proxy req baseurl body =
373+-- clientWithRoute (Proxy :: Proxy sublayout)
374+-- (let ctProxy = Proxy :: Proxy ct
375+-- in setRQBody (mimeRender ctProxy body)
376+-- (contentType ctProxy)
377+-- req
378+-- )
379+-- baseurl
372380
373381-- | Make the querying function append @path@ to the request path.
374382instance (KnownSymbol path, HasClient t m sublayout) => HasClient t m (path :> sublayout) where
@@ -376,13 +384,13 @@ instance (KnownSymbol path, HasClient t m sublayout) => HasClient t m (path :> s
376384
377385 clientWithRoute Proxy req baseurl =
378386 clientWithRoute (Proxy :: Proxy sublayout)
379− (prependToPath (constant p) req)
387+ (prependToPathParts (constant p) req)
380388 baseurl
381389
382390 where p = symbolVal (Proxy :: Proxy path)
383391
384392instance HasClient t m api => HasClient t m (Vault :> api) where
385− type Client t m (Vault :> api) = Client api
393+ type Client t m (Vault :> api) = Client t m api
386394
387395 clientWithRoute Proxy req baseurl =
388396 clientWithRoute (Proxy :: Proxy api) req baseurl