git.iko.soy/typeable/servant-reflex
on master help sign in
Make the traversable f params dynamically sized
c9de020Greg Hale
exec/Example.hs+14−2
compare with master
unifiedsplit
@@ -42,7 +42,7 @@ runMulti :: forall t m. (SupportsServantReflex t m,
42runMulti = do
42runMulti = do
43 url <- baseUrlWidget
43 url <- baseUrlWidget
44 el "br" blank
44 el "br" blank
45− let (_ :<|> _ :<|> _ :<|> dbl :<|> _ :<|> _ ) =
45+ let (_ :<|> _ :<|> sayHi :<|> dbl :<|> _ :<|> _ ) =
46 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url
46 clientA api (Proxy :: Proxy m) (Proxy :: Proxy []) (Proxy :: Proxy Int) url
47 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def
47 num :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def
48 num2 :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def
48 num2 :: Dynamic t (Either Text Double) <- fmap (note "No read" . readMaybe . T.unpack) . value <$> textInput def
@@ -50,10 +50,22 @@ runMulti = do
50 -- numLabeled :: Event t (First Int, Double) <- zipListWithEvent (,) (First . Just <$> [0..]) num
50 -- numLabeled :: Event t (First Int, Double) <- zipListWithEvent (,) (First . Just <$> [0..]) num
51 b <- button "Run dbl multi"
51 b <- button "Run dbl multi"
52 reqCount <- count b
52 reqCount <- count b
53− r <- dbl [num,num2] (tag (current reqCount) b)
53+ r <- dbl ((\x y -> [x,y]) <$> num <*> num2) (tag (current reqCount) b)
54 dynText =<< holdDyn "Waiting" (T.pack . show . fmapMaybe reqSuccess .snd <$> r)
54 dynText =<< holdDyn "Waiting" (T.pack . show . fmapMaybe reqSuccess .snd <$> r)
55 lastInd <- holdDyn Nothing (Just . fst <$> r)
55 lastInd <- holdDyn Nothing (Just . fst <$> r)
56 display lastInd
56 display lastInd
57+
58+ divClass "demo-group" $ do
59+ nms <- fmap (fmap T.words . value) $ divClass "" $ do
60+ text "Names"
61+ textInput def
62+ grts <- fmap (fmap T.words . value) $ divClass "" $ do
63+ text "Greetings"
64+ textInput def
65+ gust <- fmap (value) $ divClass "gusto-input" $ checkbox False def
66+ b <- button "Go"
67+ r' <- sayHi (fmap QParamSome <$> nms) (fmap (:[]) $ grts) (constDyn [True, False]) (1 <$ b)
68+ dynText =<< holdDyn "Waiting" (T.pack . show . fmap (fmapMaybe reqSuccess) <$> r')
57 return ()
69 return ()
58
70
59run :: forall t m. (SupportsServantReflex t m,
71run :: forall t m. (SupportsServantReflex t m,
src/Servant/Common/Req.hs+9−7
@@ -15,6 +15,7 @@ module Servant.Common.Req where
15import Control.Concurrent
15import Control.Concurrent
16import Control.Applicative (liftA2, liftA3)
16import Control.Applicative (liftA2, liftA3)
17import Control.Arrow (second)
17import Control.Arrow (second)
18+import Control.Monad (join)
18import Control.Monad.IO.Class (MonadIO, liftIO)
19import Control.Monad.IO.Class (MonadIO, liftIO)
19import qualified Data.ByteString.Lazy.Char8 as BL
20import qualified Data.ByteString.Lazy.Char8 as BL
20import qualified Data.Map as Map
21import qualified Data.Map as Map
@@ -107,10 +108,10 @@ addHeader name val req = req { headers = (name, (fmap . fmap) (TE.decodeUtf8 . t
107reqToReflexRequest
108reqToReflexRequest
108 :: forall t. Reflex t
109 :: forall t. Reflex t
109 => Text
110 => Text
110− -> Req t
111 -> Dynamic t BaseUrl
111 -> Dynamic t BaseUrl
112+ -> Req t
112 -> (Dynamic t (Either Text (XhrRequest XhrPayload)))
113 -> (Dynamic t (Either Text (XhrRequest XhrPayload)))
113−reqToReflexRequest reqMeth req reqHost =
114+reqToReflexRequest reqMeth reqHost req =
114 let t :: Dynamic t [Either Text Text]
115 let t :: Dynamic t [Either Text Text]
115 t = sequence $ reverse $ reqPathParts req
116 t = sequence $ reverse $ reqPathParts req
116
117
@@ -213,12 +214,13 @@ displayHttpRequest httpmethod = "HTTP " <> httpmethod <> " request"
213-- | This function actually performs the request.
214-- | This function actually performs the request.
214performRequests :: forall t m f tag.(SupportsServantReflex t m, Traversable f)
215performRequests :: forall t m f tag.(SupportsServantReflex t m, Traversable f)
215 => Text
216 => Text
216− -> f (Req t)
217+ -> Dynamic t (f (Req t))
217 -> Dynamic t BaseUrl
218 -> Dynamic t BaseUrl
218 -> Event t tag
219 -> Event t tag
219 -> m (Event t (tag, f (Either Text XhrResponse)))
220 -> m (Event t (tag, f (Either Text XhrResponse)))
220performRequests reqMeth rs reqHost trigger = do
221performRequests reqMeth rs reqHost trigger = do
221− let xhrReqs = sequence $ (\r -> reqToReflexRequest reqMeth r reqHost) <$> rs :: Dynamic t (f (Either Text (XhrRequest XhrPayload)))
222+ -- let xhrReqs = sequence $ (\r -> reqToReflexRequest reqMeth r reqHost) <$> rs :: Dynamic t (f (Either Text (XhrRequest XhrPayload)))
223+ let xhrReqs = join $ (\(fxhr :: f (Req t)) -> sequence $ reqToReflexRequest reqMeth reqHost <$> fxhr) <$> rs
222 let reqs = attachPromptlyDynWith (\fxhr t -> Compose (t, fxhr)) xhrReqs trigger
224 let reqs = attachPromptlyDynWith (\fxhr t -> Compose (t, fxhr)) xhrReqs trigger
223 resps <- performSomeRequestsAsync reqs
225 resps <- performSomeRequestsAsync reqs
224 return $ getCompose <$> resps
226 return $ getCompose <$> resps
@@ -267,7 +269,7 @@ performRequest :: forall t m tag .(SupportsServantReflex t m)
267 -> m (Event t (tag, XhrResponse), Event t (tag, Text))
269 -> m (Event t (tag, XhrResponse), Event t (tag, Text))
268performRequest reqMeth req reqHost trigger = do
270performRequest reqMeth req reqHost trigger = do
269
271
270− let xhrReq = reqToReflexRequest reqMeth req reqHost
272+ let xhrReq = reqToReflexRequest reqMeth reqHost req
271 let reqs = attachPromptlyDynWith (flip (,)) xhrReq trigger
273 let reqs = attachPromptlyDynWith (flip (,)) xhrReq trigger
272 okReqs = fmapMaybe (\(t,e) -> either (const Nothing) (Just . (t,)) e) reqs
274 okReqs = fmapMaybe (\(t,e) -> either (const Nothing) (Just . (t,)) e) reqs
273 badReqs = fmapMaybe (\(t,e) -> either (Just . (t,)) (const Nothing) e) reqs
275 badReqs = fmapMaybe (\(t,e) -> either (Just . (t,)) (const Nothing) e) reqs
@@ -298,7 +300,7 @@ performRequestNoBody reqMeth req reqHost trigger = do
298
300
299performRequestsNoBody :: forall t m f tag. (SupportsServantReflex t m, Traversable f)
301performRequestsNoBody :: forall t m f tag. (SupportsServantReflex t m, Traversable f)
300 => Text
302 => Text
301− -> f (Req t)
303+ -> Dynamic t (f (Req t))
302 -> Dynamic t BaseUrl
304 -> Dynamic t BaseUrl
303 -> Event t tag -> m (Event t (tag, f (ReqResult NoContent)))
305 -> Event t tag -> m (Event t (tag, f (ReqResult NoContent)))
304performRequestsNoBody reqMeth reqs reqHost trigger = do
306performRequestsNoBody reqMeth reqs reqHost trigger = do
@@ -334,7 +336,7 @@ performRequestsCT
334 MimeUnrender ct a, Traversable f)
336 MimeUnrender ct a, Traversable f)
335 => Proxy ct
337 => Proxy ct
336 -> Text
338 -> Text
337− -> f (Req t)
339+ -> Dynamic t (f (Req t))
338 -> Dynamic t BaseUrl
340 -> Dynamic t BaseUrl
339 -> Event t tag
341 -> Event t tag
340 -> m (Event t (tag, f (ReqResult a)))
342 -> m (Event t (tag, f (ReqResult a)))
src/Servant/Reflex/Multi.hs+72−34
@@ -44,7 +44,7 @@ import Servant.API ((:<|>)(..),(:>), BasicAuth,
44import Reflex.Dom (Dynamic, Event, Reflex,
44import Reflex.Dom (Dynamic, Event, Reflex,
45 XhrRequest(..),
45 XhrRequest(..),
46 XhrResponseHeaders(..),
46 XhrResponseHeaders(..),
47− XhrResponse(..), ffor, fmapMaybe,
47+ XhrResponse(..), constDyn, ffor, fmapMaybe,
48 leftmost, performRequestAsync, attachPromptlyDynWith,
48 leftmost, performRequestAsync, attachPromptlyDynWith,
49 tagPromptlyDyn )
49 tagPromptlyDyn )
50------------------------------------------------------------------------------
50------------------------------------------------------------------------------
@@ -65,22 +65,38 @@ import Servant.Common.Req (Req, ReqResult(..), QParam(..),
65 qParams)
65 qParams)
66import Servant.Reflex (BuildHeaderKeysTo(..), toHeaders)
66import Servant.Reflex (BuildHeaderKeysTo(..), toHeaders)
67
67
68−clientA :: (HasClientMulti t m layout f tag, Applicative f)
69− => Proxy layout -> Proxy m -> Proxy f -> Proxy tag -> Dynamic t BaseUrl -> ClientMulti t m layout f tag
70−clientA p q f tag baseurl = clientWithRouteMulti p q f tag (pure defReq) baseurl
71
68
69+------------------------------------------------------------------------------
70+clientA :: (HasClientMulti t m layout f tag, Applicative f, Reflex t)
71+ => Proxy layout -> Proxy m -> Proxy f -> Proxy tag
72+ -> Dynamic t BaseUrl -> ClientMulti t m layout f tag
73+clientA p q f tag baseurl =
74+ clientWithRouteMulti p q f tag (constDyn (pure defReq)) baseurl
75+
76+
77+------------------------------------------------------------------------------
72class HasClientMulti t m layout f (tag :: *) where
78class HasClientMulti t m layout f (tag :: *) where
73 type ClientMulti t m layout f tag :: *
79 type ClientMulti t m layout f tag :: *
74− clientWithRouteMulti :: Proxy layout -> Proxy m -> Proxy f -> Proxy tag -> f (Req t) -> Dynamic t BaseUrl -> ClientMulti t m layout f tag
80+ clientWithRouteMulti :: Proxy layout -> Proxy m -> Proxy f -> Proxy tag
81+ -> Dynamic t (f (Req t)) -> Dynamic t BaseUrl
82+ -> ClientMulti t m layout f tag
75
83
84+
85+------------------------------------------------------------------------------
76−instance (HasClientMulti t m a f tag, HasClientMulti t m b f tag) => HasClientMulti t m (a :<|> b) f tag where
86+instance (HasClientMulti t m a f tag, HasClientMulti t m b f tag) =>
87+ HasClientMulti t m (a :<|> b) f tag where
77− type ClientMulti t m (a :<|> b) f tag = ClientMulti t m a f tag :<|> ClientMulti t m b f tag
88+ type ClientMulti t m (a :<|> b) f tag = ClientMulti t m a f tag :<|>
89+ ClientMulti t m b f tag
78 clientWithRouteMulti Proxy q f tag reqs baseurl =
90 clientWithRouteMulti Proxy q f tag reqs baseurl =
79 clientWithRouteMulti (Proxy :: Proxy a) q f tag reqs baseurl :<|>
91 clientWithRouteMulti (Proxy :: Proxy a) q f tag reqs baseurl :<|>
80 clientWithRouteMulti (Proxy :: Proxy b) q f tag reqs baseurl
92 clientWithRouteMulti (Proxy :: Proxy b) q f tag reqs baseurl
81
93
82
94
95+------------------------------------------------------------------------------
83−instance (SupportsServantReflex t m, ToHttpApiData a, HasClientMulti t m sublayout f tag, Applicative f)
96+instance (SupportsServantReflex t m,
97+ ToHttpApiData a,
98+ HasClientMulti t m sublayout f tag,
99+ Applicative f)
84 => HasClientMulti t m (Capture capture a :> sublayout) f tag where
100 => HasClientMulti t m (Capture capture a :> sublayout) f tag where
85
101
86 type ClientMulti t m (Capture capture a :> sublayout) f tag =
102 type ClientMulti t m (Capture capture a :> sublayout) f tag =
@@ -88,9 +104,11 @@ instance (SupportsServantReflex t m, ToHttpApiData a, HasClientMulti t m sublayo
88
104
89 clientWithRouteMulti l q f tag reqs baseurl vals = clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
105 clientWithRouteMulti l q f tag reqs baseurl vals = clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
90 where
106 where
91− reqs' = prependToPathParts <$> ps <*> reqs
107+ reqs' = (prependToPathParts <$> ps <*>) <$> reqs
92 ps = (fmap . fmap . fmap) toUrlPiece vals
108 ps = (fmap . fmap . fmap) toUrlPiece vals
93
109
110+
111+------------------------------------------------------------------------------
94-- VERB (Returning content) --
112-- VERB (Returning content) --
95instance {-# OVERLAPPABLE #-}
113instance {-# OVERLAPPABLE #-}
96 -- Note [Non-Empty Content Types]
114 -- Note [Non-Empty Content Types]
@@ -107,8 +125,10 @@ instance {-# OVERLAPPABLE #-}
107 clientWithRouteMulti _ _ f tag reqs baseurl =
125 clientWithRouteMulti _ _ f tag reqs baseurl =
108 performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl
126 performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl
109 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
127 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
110− reqs' = (\r -> r { reqMethod = method }) <$> reqs
128+ reqs' = fmap (\r -> r { reqMethod = method }) <$> reqs
129+
111
130
131+------------------------------------------------------------------------------
112-- -- VERB (No content) --
132-- -- VERB (No content) --
113instance {-# OVERLAPPING #-}
133instance {-# OVERLAPPING #-}
114 (ReflectMethod method, SupportsServantReflex t m, Traversable f) =>
134 (ReflectMethod method, SupportsServantReflex t m, Traversable f) =>
@@ -121,6 +141,8 @@ instance {-# OVERLAPPING #-}
121 performRequestsNoBody method req baseurl
141 performRequestsNoBody method req baseurl
122 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
142 where method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
123
143
144+
145+------------------------------------------------------------------------------
124instance {-# OVERLAPPABLE #-}
146instance {-# OVERLAPPABLE #-}
125 -- Note [Non-Empty Content Types]
147 -- Note [Non-Empty Content Types]
126 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
148 ( MimeUnrender ct a, BuildHeadersTo ls, BuildHeaderKeysTo ls,
@@ -134,30 +156,36 @@ instance {-# OVERLAPPABLE #-}
134 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
156 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
135 resp <- performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl triggers :: m (Event t (tag, f (ReqResult a)))
157 resp <- performRequestsCT (Proxy :: Proxy ct) method reqs' baseurl triggers :: m (Event t (tag, f (ReqResult a)))
136 return $ (fmap . fmap) toHeaders <$> resp
158 return $ (fmap . fmap) toHeaders <$> resp
159+ where
160+ reqs' = fmap (\r ->
137− where reqs' = ffor reqs $ \r -> r { respHeaders =
161+ r { respHeaders =
162+ OnlyHeaders (Set.fromList
138− OnlyHeaders (Set.fromList (buildHeaderKeysTo (Proxy :: Proxy ls)))
163+ (buildHeaderKeysTo (Proxy :: Proxy ls)))
139− }
164+ }) <$> reqs
140
165
141
166
167+------------------------------------------------------------------------------
142instance {-# OVERLAPPABLE #-}
168instance {-# OVERLAPPABLE #-}
143 ( BuildHeadersTo ls,
169 ( BuildHeadersTo ls,
144 BuildHeaderKeysTo ls,
170 BuildHeaderKeysTo ls,
145 ReflectMethod method,
171 ReflectMethod method,
146 SupportsServantReflex t m,
172 SupportsServantReflex t m,
147 Traversable f
173 Traversable f
148− ) => HasClientMulti t m (Verb method status cts (Headers ls NoContent)) f tag where
174+ ) => HasClientMulti t m (Verb method status
175+ cts (Headers ls NoContent)) f tag where
149 type ClientMulti t m (Verb method status cts (Headers ls NoContent)) f tag
176 type ClientMulti t m (Verb method status cts (Headers ls NoContent)) f tag
150 = Event t tag -> m (Event t (tag, f (ReqResult (Headers ls NoContent))))
177 = Event t tag -> m (Event t (tag, f (ReqResult (Headers ls NoContent))))
151 clientWithRouteMulti Proxy _ _ _ reqs baseurl triggers = do
178 clientWithRouteMulti Proxy _ _ _ reqs baseurl triggers = do
152 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
179 let method = E.decodeUtf8 $ reflectMethod (Proxy :: Proxy method)
153 resp <- performRequestsNoBody method reqs' baseurl triggers
180 resp <- performRequestsNoBody method reqs' baseurl triggers
154 return $ (fmap . fmap) toHeaders <$> resp
181 return $ (fmap . fmap) toHeaders <$> resp
155− where reqs' = ffor reqs $ \req ->
182+ where reqs' = fmap (\req ->
156 req {respHeaders = OnlyHeaders (Set.fromList
183 req {respHeaders = OnlyHeaders (Set.fromList
157 (buildHeaderKeysTo (Proxy :: Proxy ls)))
184 (buildHeaderKeysTo (Proxy :: Proxy ls)))
158− }
185+ }) <$> reqs
159
186
160
187
188+------------------------------------------------------------------------------
161instance (KnownSymbol sym,
189instance (KnownSymbol sym,
162 ToHttpApiData a,
190 ToHttpApiData a,
163 HasClientMulti t m sublayout f tag,
191 HasClientMulti t m sublayout f tag,
@@ -175,10 +203,11 @@ instance (KnownSymbol sym,
175 reqs'
203 reqs'
176 baseurl
204 baseurl
177 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
205 where hname = T.pack $ symbolVal (Proxy :: Proxy sym)
178− reqs' = (\eVal req -> Servant.Common.Req.addHeader hname eVal req)
206+ reqs' = ((\eVal req -> Servant.Common.Req.addHeader hname eVal req)
179− <$> eVals <*> reqs
207+ <$> eVals <*>) <$> reqs
180
208
181
209
210+------------------------------------------------------------------------------
182instance HasClientMulti t m sublayout f tag
211instance HasClientMulti t m sublayout f tag
183 => HasClientMulti t m (HttpVersion :> sublayout) f tag where
212 => HasClientMulti t m (HttpVersion :> sublayout) f tag where
184
213
@@ -189,11 +218,17 @@ instance HasClientMulti t m sublayout f tag
189 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag
218 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag
190
219
191
220
221+------------------------------------------------------------------------------
222+instance (KnownSymbol sym,
223+ ToHttpApiData a,
192−instance (KnownSymbol sym, ToHttpApiData a, HasClientMulti t m sublayout f tag, Reflex t, Traversable f, Applicative f)
224+ HasClientMulti t m sublayout f tag,
225+ Reflex t,
226+ Traversable f,
227+ Applicative f)
193 => HasClientMulti t m (QueryParam sym a :> sublayout) f tag where
228 => HasClientMulti t m (QueryParam sym a :> sublayout) f tag where
194
229
195 type ClientMulti t m (QueryParam sym a :> sublayout) f tag =
230 type ClientMulti t m (QueryParam sym a :> sublayout) f tag =
196− f (Dynamic t (QParam a)) -> ClientMulti t m sublayout f tag
231+ Dynamic t (f (QParam a)) -> ClientMulti t m sublayout f tag
197
232
198 -- if mparam = Nothing, we don't add it to the query string
233 -- if mparam = Nothing, we don't add it to the query string
199 -- TODO: Check the above comment
234 -- TODO: Check the above comment
@@ -204,7 +239,9 @@ instance (KnownSymbol sym, ToHttpApiData a, HasClientMulti t m sublayout f tag,
204 where pname = symbolVal (Proxy :: Proxy sym)
239 where pname = symbolVal (Proxy :: Proxy sym)
205 p prm = QueryPartParam $ fmap qParamToQueryPart prm
240 p prm = QueryPartParam $ fmap qParamToQueryPart prm
206 paramPair mp = (T.pack pname, p mp)
241 paramPair mp = (T.pack pname, p mp)
207− reqs' = (\param req -> req {qParams = paramPair param : qParams req})
242+ -- reqs' = (\params reqs -> (\req param -> req {qParams = paramPair param : qParams req}) <$> reqs <*> params)
243+ -- <$> mparams <*> reqs
244+ reqs' = liftA2 (\(pr :: QParam a) (r :: Req t) -> r { qParams = paramPair (constDyn pr) : qParams r })
208 <$> mparams <*> reqs
245 <$> mparams <*> reqs
209
246
210
247
@@ -217,16 +254,17 @@ instance (KnownSymbol sym,
217 => HasClientMulti t m (QueryParams sym a :> sublayout) f tag where
254 => HasClientMulti t m (QueryParams sym a :> sublayout) f tag where
218
255
219 type ClientMulti t m (QueryParams sym a :> sublayout) f tag =
256 type ClientMulti t m (QueryParams sym a :> sublayout) f tag =
220− f (Dynamic t [a]) -> ClientMulti t m sublayout f tag
257+ Dynamic t (f [a]) -> ClientMulti t m sublayout f tag
221
258
222 clientWithRouteMulti Proxy q f tag reqs baseurl paramlists =
259 clientWithRouteMulti Proxy q f tag reqs baseurl paramlists =
223 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
260 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
224
261
225− where req' l r = r { qParams = (T.pack pname, params' l) : qParams r }
262+ where req' l r = r { qParams = (T.pack pname, params' (constDyn l)) : qParams r }
226 pname = symbolVal (Proxy :: Proxy sym)
263 pname = symbolVal (Proxy :: Proxy sym)
227 params' l = QueryPartParams $ (fmap . fmap) (toQueryParam)
264 params' l = QueryPartParams $ (fmap . fmap) (toQueryParam)
228 l
265 l
266+ reqs' = liftA2 req' <$> paramlists <*> reqs
229− reqs' = req' <$> paramlists <*> reqs
267+ -- reqs' = req' <$> paramlists <*> reqs
230
268
231
269
232instance (KnownSymbol sym,
270instance (KnownSymbol sym,
@@ -237,15 +275,15 @@ instance (KnownSymbol sym,
237 => HasClientMulti t m (QueryFlag sym :> sublayout) f tag where
275 => HasClientMulti t m (QueryFlag sym :> sublayout) f tag where
238
276
239 type ClientMulti t m (QueryFlag sym :> sublayout) f tag =
277 type ClientMulti t m (QueryFlag sym :> sublayout) f tag =
240− f (Dynamic t Bool) -> ClientMulti t m sublayout f tag
278+ Dynamic t (f Bool) -> ClientMulti t m sublayout f tag
241
279
242 clientWithRouteMulti Proxy q f tag reqs baseurl flags =
280 clientWithRouteMulti Proxy q f tag reqs baseurl flags =
243 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
281 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
244
282
245− where req' f req = req { qParams = thisPair f : qParams req }
283+ where req' f req = req { qParams = thisPair (constDyn f) : qParams req }
246 thisPair f = (T.pack pName, QueryPartFlag f) :: (Text, QueryPart t)
284 thisPair f = (T.pack pName, QueryPartFlag f) :: (Text, QueryPart t)
247 pName = symbolVal (Proxy :: Proxy sym)
285 pName = symbolVal (Proxy :: Proxy sym)
248− reqs' = req' <$> flags <*> reqs
286+ reqs' = liftA2 req' <$> flags <*> reqs
249
287
250
288
251instance (SupportsServantReflex t m,
289instance (SupportsServantReflex t m,
@@ -272,17 +310,17 @@ instance (MimeRender ct a,
272 => HasClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag where
310 => HasClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag where
273
311
274 type ClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag =
312 type ClientMulti t m (ReqBody (ct ': cts) a :> sublayout) f tag =
275− f (Dynamic t (Either Text a)) -> ClientMulti t m sublayout f tag
313+ Dynamic t (f (Either Text a)) -> ClientMulti t m sublayout f tag
276
314
277 clientWithRouteMulti Proxy q f tag reqs baseurl bodies =
315 clientWithRouteMulti Proxy q f tag reqs baseurl bodies =
278 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
316 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag reqs' baseurl
279− where req' b r = r { reqBody = bodyBytesCT b }
317+ where req' b r = r { reqBody = bodyBytesCT (constDyn b) }
280 ctProxy = Proxy :: Proxy ct
318 ctProxy = Proxy :: Proxy ct
281 ctString = T.pack $ show $ contentType ctProxy
319 ctString = T.pack $ show $ contentType ctProxy
282 bodyBytesCT b = Just $ (fmap . fmap)
320 bodyBytesCT b = Just $ (fmap . fmap)
283 (\b' -> (mimeRender ctProxy b', ctString))
321 (\b' -> (mimeRender ctProxy b', ctString))
284 b
322 b
285− reqs' = req' <$> bodies <*> reqs
323+ reqs' = liftA2 req' <$> bodies <*> reqs
286
324
287
325
288instance (KnownSymbol path,
326instance (KnownSymbol path,
@@ -293,7 +331,7 @@ instance (KnownSymbol path,
293
331
294 clientWithRouteMulti Proxy q f tag reqs baseurl =
332 clientWithRouteMulti Proxy q f tag reqs baseurl =
295 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag
333 clientWithRouteMulti (Proxy :: Proxy sublayout) q f tag
296− (prependToPathParts (pure (Right $ T.pack p)) <$> reqs)
334+ (fmap (prependToPathParts (pure (Right $ T.pack p))) <$> reqs)
297 baseurl
335 baseurl
298
336
299 where p = symbolVal (Proxy :: Proxy path)
337 where p = symbolVal (Proxy :: Proxy path)
@@ -323,11 +361,11 @@ instance HasClientMulti t m api f tag => HasClientMulti t m (IsSecure :> api) f
323instance (HasClientMulti t m api f tag, Reflex t, Traversable f, Applicative f)
361instance (HasClientMulti t m api f tag, Reflex t, Traversable f, Applicative f)
324 => HasClientMulti t m (BasicAuth realm usr :> api) f tag where
362 => HasClientMulti t m (BasicAuth realm usr :> api) f tag where
325
363
326− type ClientMulti t m (BasicAuth realm usr :> api) f tag = f (Dynamic t (Maybe BasicAuthData))
364+ type ClientMulti t m (BasicAuth realm usr :> api) f tag = Dynamic t (f (Maybe BasicAuthData))
327 -> ClientMulti t m api f tag
365 -> ClientMulti t m api f tag
328
366
329 clientWithRouteMulti Proxy q f tag reqs baseurl authdatas =
367 clientWithRouteMulti Proxy q f tag reqs baseurl authdatas =
330 clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs' baseurl
368 clientWithRouteMulti (Proxy :: Proxy api) q f tag reqs' baseurl
331 where
369 where
332− req' a r = r { authData = Just a }
370+ req' a r = r { authData = Just (constDyn a) }
333− reqs' = req' <$> authdatas <*> reqs
371+ reqs' = liftA2 req' <$> authdatas <*> reqs