From 6d89d327883f41ce7f3a8231620d98a9a5aec7e9 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Fri, 24 Jan 2020 20:16:31 -0500 Subject: Avoid looping in partitionTransportM. --- server/src/Network/QueryResponse.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/server/src/Network/QueryResponse.hs b/server/src/Network/QueryResponse.hs index 6af1f355..ea87abe4 100644 --- a/server/src/Network/QueryResponse.hs +++ b/server/src/Network/QueryResponse.hs @@ -149,10 +149,10 @@ partitionTransportM :: ((b,a) -> IO (Either (x,xaddr) (b,a))) -> IO (TransportA err xaddr x y, TransportA err a b c) partitionTransportM parse encodex tr = do tchan <- atomically newTChan - let ytr = tr { awaitMessage = \kont -> fix $ \again -> do + let ytr = tr { awaitMessage = \kont -> awaitMessage tr $ \m -> case m of Arrival adr msg -> parse (msg,adr) >>= \case - Left x -> atomically (writeTChan tchan (Just x)) >> join (atomically again) + Left x -> atomically (writeTChan tchan (Just x)) >> kont Discarded Right (y,yaddr) -> kont $ Arrival yaddr y ParseError e -> kont $ ParseError e Discarded -> kont $ Discarded -- cgit v1.2.3