fix test

Author: soulomoon

hls-test-utils/src/Test/Hls/Util.hs

@@ -77,6 +77,7 @@ import           Test.Tasty.ExpectedFailure      (expectFailBecause,
                                                   ignoreTestBecause)
 import           Test.Tasty.HUnit                (Assertion, assertFailure,
                                                   (@?=))
+import Language.LSP.Test (withTimeout)
 
 noLiteralCaps :: ClientCapabilities
 noLiteralCaps = def & L.textDocument ?~ textDocumentCaps
@@ -284,25 +285,13 @@ expectNoMoreDiagnostics timeout doc src = do
 -- If timeout is 0 it will wait until the session timeout
 waitForDiagnosticsFromSourceWithTimeout :: Seconds -> TextDocumentIdentifier -> String -> Test.Session [Diagnostic]
 waitForDiagnosticsFromSourceWithTimeout timeout document source = do
-    diags <- withTimeout timeout $ waitForDiagnosticsFrom document
+    -- todo possible better if there is withTimeout on Seconds in LSP.
+    diags <- withTimeout (ceiling timeout) $ waitForDiagnosticsFrom document
     return $ filter matches diags
   where
     matches :: Diagnostic -> Bool
     matches d = d ^. L.source == Just (T.pack source)
 
-withTimeout :: Seconds -> Session a -> Session a
-withTimeout duration f = do
-  chan <- asks messageChan
-  timeoutId <- getCurTimeoutId
-  modify $ \s -> s { overridingTimeout = True }
-  tid <- liftIO $ forkIO $ do
-    threadDelay (ceiling $ duration * 1000000)
-    writeChan chan (TimeoutMessage timeoutId)
-  res <- f
-  liftIO $ killThread tid
-  bumpTimeoutId timeoutId
-  modify $ \s -> s { overridingTimeout = False }
-  return res
 
 
 failIfSessionTimeout :: IO a -> IO a