@@ -221,8 +221,8 @@ instance (Adjustable t m, MonadHold t m) => Adjustable t (RequesterT t request r
221221 traverseDMapWithKeyWithAdjustWithMove f dm0 dm' = RequesterT $ traverseDMapWithKeyWithAdjustWithMove (\k v -> unRequesterT $ f k v) dm0 dm'
222222
223223
224−data Decoder rawResponse response ps =
225− forall a. Decoder (TagGen ps a) (rawResponse -> response a)
224+data Decoder rawResponse response =
225+ forall s a. Decoder (Tag s a) (rawResponse -> response a)
226226
227227-- | Matches incoming responses with previously-sent requests
228228-- and uses the provided request "decoder" function to process
@@ -247,11 +247,11 @@ matchResponsesWithRequests
247247 )
248248 -- ^ A map of outgoing wire-format requests and an event of responses keyed
249249 -- by the 'RequesterData' key of the associated outgoing request
250−matchResponsesWithRequests f send recv = mdo
251− waitingFor :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m))) <- holdIncremental mempty $
250+matchResponsesWithRequests f send recv = withTagGen $ \tagGen -> mdo
251+ waitingFor <- holdIncremental mempty $
252252 leftmost [ fst <$> outgoing, snd <$> incoming ]
253253 let outgoing = processOutgoing send
254− incoming = processIncoming waitingFor recv
254+ incoming = processIncoming waitingFor tagGen recv
255255 return (snd <$> outgoing, fst <$> incoming)
256256 where
257257
@@ -259,58 +259,16 @@ matchResponsesWithRequests f send recv = mdo
259259 -- and returns the next available key, a map of response decoders
260260 -- for requests for which there are outstanding responses, and the
261261 -- raw requests to be sent out.
262−
263− {--
264−
265− src/Reflex/Requester/Base/Internal.hs:271:53-67: error:
266− • Couldn't match type ‘a’ with ‘s’
267− ‘a’ is a rigid type variable bound by
268− a pattern with constructor:
269− :=> :: forall k (tag :: k -> *) (f :: k -> *) (a :: k).
270− tag a -> f a -> DSum tag f,
271− in a lambda abstraction
272− at src/Reflex/Requester/Base/Internal.hs:269:98-104
273− ‘s’ is a rigid type variable bound by
274− a pattern with constructor:
275− RequestData :: forall ps (request :: * -> *) s.
276− TagGen ps s
277− -> NonEmptyDeferred (RequestEnvelope s request)
278− -> RequestData ps request,
279− in a lambda abstraction
280− at src/Reflex/Requester/Base/Internal.hs:268:85-119
281− Expected type: rawResponse -> response s
282− Actual type: rawResponse -> response a
283− • In the second argument of ‘Decoder’, namely ‘responseDecoder’
284− In the expression: Decoder tagGen responseDecoder
285− In the expression:
286− (tagId k, rawRequest, Decoder tagGen responseDecoder)
287− • Relevant bindings include
288− responseDecoder :: rawResponse -> response a
289− (bound at src/Reflex/Requester/Base/Internal.hs:270:30)
290− v :: request a
291− (bound at src/Reflex/Requester/Base/Internal.hs:269:104)
292− k :: Tag s a
293− (bound at src/Reflex/Requester/Base/Internal.hs:269:98)
294− requestEnvelopes :: NonEmptyDeferred (RequestEnvelope s request)
295− (bound at src/Reflex/Requester/Base/Internal.hs:268:104)
296− tagGen :: TagGen (PrimState m) s
297− (bound at src/Reflex/Requester/Base/Internal.hs:268:97)
298− |
299−271 | in (tagId k, rawRequest, Decoder tagGen
300−responseDecoder)
301− |
302−^^^^^^^^^^^^^^^
303− --}
304262 processOutgoing
305263 :: Event t (RequestData (PrimState m) request)
306264 -- The outgoing request
307− -> Event t ( PatchMap Int (Decoder rawResponse response (PrimState m))
265+ -> Event t ( PatchMap Int (Decoder rawResponse response)
308266 , Map Int rawRequest )
309267 -- A map of requests expecting responses, and the tagged raw requests
310268 processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData tagGen requestEnvelopes) -> do
311269 let results = ffor (requestEnvelopesToList $ NonEmptyDeferred.toList requestEnvelopes) $ \(k :=> v) ->
312270 let (rawRequest, responseDecoder) = f v
313− in (tagId k, rawRequest, Decoder tagGen responseDecoder)
271+ in (tagId k, rawRequest, Decoder k responseDecoder)
314272 let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
315273 let toSend = Map.fromList $ (\(n, rawRequest, _) -> (n, rawRequest)) <$> results
316274 return (patchWaitingFor, toSend)
@@ -320,58 +278,24 @@ responseDecoder)
320278 -- be used to clear the ID of the consumed response out of the queue
321279 -- of expected responses.
322280 processIncoming
323− :: Incremental t (PatchMap Int (Decoder rawResponse response (PrimState m)))
281+ :: Incremental t (PatchMap Int (Decoder rawResponse response))
282+ -> TagGen (PrimState m) s
324283 -- A map of outstanding expected responses
325284 -> Event t (Int, rawResponse)
326285 -- A incoming response paired with its identifying key
327286 -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
328287 -- The decoded response and a patch that clears the outstanding responses queue
329− processIncoming incWaitingFor inc = flip push inc $ \(n, rawRsp) -> do
288+ processIncoming incWaitingFor tagGen inc = flip push inc $ \(n, rawRsp) -> do
330289 waitingFor <- sample $ currentIncremental incWaitingFor
331290 case Map.lookup n waitingFor of
332291 Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
333− Just (Decoder tagGen responseDecoder) -> do
334− let rsp = responseDecoder rawRsp
292+ Just (Decoder tag responseDecoder) ->
335293 return $ Just
336− ( singletonRequesterData @m tagGen (unsafeTagFromId n) rsp
294+ ( ResponseData tagGen $ TagMap.singletonTagMap (unsafeTagFromId n) (responseDecoder rawRsp)
337295 , PatchMap $ Map.singleton n Nothing
338296 )
339297
340−singletonRequesterData :: TagGen (PrimState m) a -> Tag (PrimState m) a -> response a -> ResponseData (PrimState m) response
341−singletonRequesterData tagGen tag response =
342− ResponseData tagGen $ TagMap.singletonTagMap tag response
343−
344−{--
345− src/Reflex/Requester/Base/Internal.hs:304:40-78: error:
346− • Couldn't match type ‘s1’ with ‘s’
347− ‘s1’ is a rigid type variable bound by
348− a pattern with constructor:
349− RequestData :: forall ps (request :: * -> *) s.
350− TagGen ps s
351− -> NonEmptyDeferred (RequestEnvelope s request)
352− -> RequestData ps request,
353− in an equation for ‘requesterDataToList’
354− at src/Reflex/Requester/Base/Internal.hs:303:22-50
355− ‘s’ is a rigid type variable bound by
356− the type signature for:
357− requesterDataToList :: forall (m :: * -> *) (request :: * ->
358− *) s.
359− RequestData (PrimState m) request ->
360− [DSum (Tag s) request]
361− at src/Reflex/Requester/Base/Internal.hs:302:1-102
362− Expected type: [RequestEnvelope s request]
363− Actual type: [RequestEnvelope s1 request]
364− • In the second argument of ‘($)’, namely
365− ‘NonEmptyDeferred.toList requestEnvelope’
366− In the expression:
367− requestEnvelopesToList @s @request
368− $ NonEmptyDeferred.toList requestEnvelope
369−--}
370−requesterDataToList :: forall m request s. RequestData (PrimState m) request -> [DSum (Tag s) request]
371−requesterDataToList (RequestData _ requestEnvelope) =
372− requestEnvelopesToList @s @request $ NonEmptyDeferred.toList requestEnvelope
373−
374298requestEnvelopesToList :: forall s request. [RequestEnvelope s request] -> [DSum (Tag s) request]
375299requestEnvelopesToList reqEnvs = f <$> reqEnvs
376− where f :: (RequestEnvelope s request)-> DSum (Tag s) request
377− f (RequestEnvelope (Just tag) v) = tag :=> v
300+ where f :: (RequestEnvelope s request) -> DSum (Tag s) request
301+ f (RequestEnvelope (Just tag) v) = tag :=> v