@@ -231,7 +231,6 @@ matchResponsesWithRequests
231 :: forall t rawRequest rawResponse request response m.
231 :: forall t rawRequest rawResponse request response m.
232 ( MonadFix m
232 ( MonadFix m
233 , MonadHold t m
233 , MonadHold t m
235 , PrimMonad m
234 , PrimMonad m
236 , Reflex t
235 , Reflex t
@@ -265,8 +264,8 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen -> mdo
265 -> Event t ( PatchMap Int (Decoder rawResponse response)
264 -> Event t ( PatchMap Int (Decoder rawResponse response)
266 , Map Int rawRequest )
265 , Map Int rawRequest )
267 -- A map of requests expecting responses, and the tagged raw requests
266 -- A map of requests expecting responses, and the tagged raw requests
268− processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData tagGen requestEnvelopes) -> do
267+ processOutgoing eventOutgoingRequest = flip pushAlways eventOutgoingRequest $ \(RequestData _ requestEnvelopes) -> do
269− let results = ffor (requestEnvelopesToList $ NonEmptyDeferred.toList requestEnvelopes) $ \(k :=> v) ->
268+ let results = ffor (requestEnvelopesToList requestEnvelopes) $ \(k :=> v) ->
270 let (rawRequest, responseDecoder) = f v
269 let (rawRequest, responseDecoder) = f v
271 in (tagId k, rawRequest, Decoder k responseDecoder)
270 in (tagId k, rawRequest, Decoder k responseDecoder)
272 let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
271 let patchWaitingFor = PatchMap $ Map.fromList $ (\(n, _, dec) -> (n, Just dec)) <$> results
@@ -279,8 +278,9 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen -> mdo
279 -- of expected responses.
278 -- of expected responses.
280 processIncoming
279 processIncoming
281 :: Incremental t (PatchMap Int (Decoder rawResponse response))
280 :: Incremental t (PatchMap Int (Decoder rawResponse response))
282− -> TagGen (PrimState m) s
283 -- A map of outstanding expected responses
281 -- A map of outstanding expected responses
282+ -> TagGen (PrimState m) s
284 -> Event t (Int, rawResponse)
284 -> Event t (Int, rawResponse)
285 -- A incoming response paired with its identifying key
285 -- A incoming response paired with its identifying key
286 -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
286 -> Event t (ResponseData (PrimState m) response, PatchMap Int v)
@@ -291,11 +291,20 @@ matchResponsesWithRequests f send recv = withTagGen $ \tagGen -> mdo
291 Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
291 Nothing -> return Nothing -- TODO How should lookup failures be handled here? They shouldn't ever happen..
292 Just (Decoder tag responseDecoder) ->
292 Just (Decoder tag responseDecoder) ->
293 return $ Just
293 return $ Just
294− ( ResponseData tagGen $ TagMap.singletonTagMap (unsafeTagFromId n) (responseDecoder rawRsp)
294+ ( singletonResponseData tagGen (unsafeTagFromId n) (responseDecoder rawRsp)
295 , PatchMap $ Map.singleton n Nothing
295 , PatchMap $ Map.singleton n Nothing
298−requestEnvelopesToList :: forall s request. [RequestEnvelope s request] -> [DSum (Tag s) request]
298+requestEnvelopesToList :: forall s request. NonEmptyDeferred (RequestEnvelope s request) -> [DSum (Tag s) request]
299−requestEnvelopesToList reqEnvs = f <$> reqEnvs
299+requestEnvelopesToList requestEnvelopes = catMaybes $ f <$> NonEmptyDeferred.toList requestEnvelopes
300− where f :: (RequestEnvelope s request) -> DSum (Tag s) request
300+ where f :: (RequestEnvelope s request) -> Maybe (DSum (Tag s) request)
301− f (RequestEnvelope (Just tag) v) = tag :=> v
301+ f (RequestEnvelope (Just tag) v) = Just (tag :=> v)
302+ f (RequestEnvelope Nothing _) = Nothing
304+singletonRequestData :: TagGen ps s -> Maybe (Tag s a) -> request a -> RequestData ps request
305+singletonRequestData tagGen maybeTag request =
306+ RequestData tagGen $ NonEmptyDeferred.singleton $ RequestEnvelope maybeTag request
308+singletonResponseData :: TagGen ps s -> Tag ps s -> response a -> ResponseData ps response
309+singletonResponseData tagGen tag response =
310+ ResponseData tagGen $ TagMap.singletonTagMap tag response