X-Git-Url: http://git.lukelau.me/?p=lsp-test.git;a=blobdiff_plain;f=src%2FLanguage%2FLSP%2FTest%2FParsing.hs;fp=src%2FLanguage%2FLSP%2FTest%2FParsing.hs;h=58785d9bf5979a7227db8d7c91d674399deda8ba;hp=e55909f4c59fc9076c665d9b8f66811ae9981bb9;hb=9caa331490b8415b7d7f1269989865797ac030bd;hpb=7e42ae01484513e6f9838c9589549508c179a24a

diff --git a/src/Language/LSP/Test/Parsing.hs b/src/Language/LSP/Test/Parsing.hs
index e55909f..58785d9 100644
--- a/src/Language/LSP/Test/Parsing.hs
+++ b/src/Language/LSP/Test/Parsing.hs
@@ -83,16 +83,21 @@ satisfyMaybeM pred = do
   
   skipTimeout <- overridingTimeout <$> get
   timeoutId <- getCurTimeoutId
-  unless skipTimeout $ do
+  mtid <-
+    if skipTimeout
+    then pure Nothing
+    else Just <$> do
       chan <- asks messageChan
       timeout <- asks (messageTimeout . config)
-    void $ liftIO $ forkIO $ do
+      liftIO $ forkIO $ do
         threadDelay (timeout * 1000000)
         writeChan chan (TimeoutMessage timeoutId)
 
   x <- Session await
 
-  unless skipTimeout (bumpTimeoutId timeoutId)
+  forM_ mtid $ \tid -> do
+    bumpTimeoutId timeoutId
+    liftIO $ killThread tid
 
   modify $ \s -> s { lastReceivedMessage = Just x }