on develop help sign in
Merge pull request #282 from reflex-frp/aa-withRequesterT
d71d268Ryan Trinkle
src/Reflex/Requester/Base.hs+15−1
@@ -21,6 +21,7 @@
21module Reflex.Requester.Base
21module Reflex.Requester.Base
22 ( RequesterT (..)
22 ( RequesterT (..)
23 , runRequesterT
23 , runRequesterT
24+ , withRequesterT
24 , runWithReplaceRequesterTWith
25 , runWithReplaceRequesterTWith
25 , traverseIntMapWithKeyWithAdjustRequesterTWith
26 , traverseIntMapWithKeyWithAdjustRequesterTWith
26 , traverseDMapWithKeyWithAdjustRequesterTWith
27 , traverseDMapWithKeyWithAdjustRequesterTWith
@@ -265,7 +266,6 @@ instance (S.Semigroup a, Monad m) => S.Semigroup (RequesterT t request response
265-- requests are made, and responses should be provided in the input 'Event'.
266-- requests are made, and responses should be provided in the input 'Event'.
266-- The 'Tag' keys will be used to return the responses to the same place the
267-- The 'Tag' keys will be used to return the responses to the same place the
267-- requests were issued.
268-- requests were issued.
268−
269runRequesterT :: (Reflex t, Monad m)
269runRequesterT :: (Reflex t, Monad m)
270 => RequesterT t request response m a
270 => RequesterT t request response m a
271 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
271 -> Event t (RequesterData response) --TODO: This DMap will be in reverse order, so we need to make sure the caller traverses it in reverse
@@ -275,6 +275,20 @@ runRequesterT (RequesterT a) responses = do
275 coerceEvent responses
275 coerceEvent responses
276 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
276 return (result, fmapCheap (RequesterData . TagMap) $ mergeInt $ IntMap.fromDistinctAscList $ _requesterState_requests s)
277
277
278+-- | Map a function over the request and response of a 'RequesterT'
279+withRequesterT
280+ :: (Reflex t, MonadFix m)
281+ => (forall x. req x -> req' x) -- ^ The function to map over the request
282+ -> (forall x. rsp' x -> rsp x) -- ^ The function to map over the response
283+ -> RequesterT t req rsp m a -- ^ The internal 'RequesterT' whose input and output will be transformed
284+ -> RequesterT t req' rsp' m a -- ^ The resulting 'RequesterT'
285+withRequesterT freq frsp child = do
286+ rec let rsp = fmap (runIdentity . traverseRequesterData (Identity . frsp)) rsp'
287+ (a, req) <- lift $ runRequesterT child rsp
288+ rsp' <- fmap (flip selectInt 0 . fanInt . fmapCheap unMultiEntry) $ requesting' $
289+ fmapCheap (multiEntry . IntMap.singleton 0) $ fmap (runIdentity . traverseRequesterData (Identity . freq)) req
290+ return a
291+
278instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
292instance (Reflex t, Monad m) => Requester t (RequesterT t request response m) where
279 type Request (RequesterT t request response m) = request
293 type Request (RequesterT t request response m) = request
280 type Response (RequesterT t request response m) = response
294 type Response (RequesterT t request response m) = response