diff options
| author | Joe Crayne <joe@jerkface.net> | 2020-01-24 20:16:31 -0500 |
|---|---|---|
| committer | Joe Crayne <joe@jerkface.net> | 2020-01-25 19:18:12 -0500 |
| commit | 6d89d327883f41ce7f3a8231620d98a9a5aec7e9 (patch) | |
| tree | 23da876b7b409c826926c168f2d6609c057df697 | |
| parent | 512c97888c09cdf00837f7c5cabd3655c286458d (diff) | |
Avoid looping in partitionTransportM.
| -rw-r--r-- | server/src/Network/QueryResponse.hs | 4 |
1 files 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))) | |||
| 149 | -> IO (TransportA err xaddr x y, TransportA err a b c) | 149 | -> IO (TransportA err xaddr x y, TransportA err a b c) |
| 150 | partitionTransportM parse encodex tr = do | 150 | partitionTransportM parse encodex tr = do |
| 151 | tchan <- atomically newTChan | 151 | tchan <- atomically newTChan |
| 152 | let ytr = tr { awaitMessage = \kont -> fix $ \again -> do | 152 | let ytr = tr { awaitMessage = \kont -> |
| 153 | awaitMessage tr $ \m -> case m of | 153 | awaitMessage tr $ \m -> case m of |
| 154 | Arrival adr msg -> parse (msg,adr) >>= \case | 154 | Arrival adr msg -> parse (msg,adr) >>= \case |
| 155 | Left x -> atomically (writeTChan tchan (Just x)) >> join (atomically again) | 155 | Left x -> atomically (writeTChan tchan (Just x)) >> kont Discarded |
| 156 | Right (y,yaddr) -> kont $ Arrival yaddr y | 156 | Right (y,yaddr) -> kont $ Arrival yaddr y |
| 157 | ParseError e -> kont $ ParseError e | 157 | ParseError e -> kont $ ParseError e |
| 158 | Discarded -> kont $ Discarded | 158 | Discarded -> kont $ Discarded |