Print last received message in timeout exceptions

[lsp-test.git] / src / Language / Haskell / LSP / Test / Session.hs

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index e4f6a648366050f257f8ebdc21f0915d78e2ffe5..07b588666772f10a2369f92a37a5a96cb89aca67 100644 (file)
--- a/src/Language/Haskell/LSP/Test/Session.hs
+++ b/src/Language/Haskell/LSP/Test/Session.hs
@@ -70,7 +70,6 @@ import System.Directory
 import System.IO
 import System.Process (ProcessHandle())
 import System.Timeout
-import System.IO.Temp
 
 -- | A session representing one instance of launching and connecting to a server.
 --
@@ -190,7 +189,7 @@ runSession context state (Session session) = runReaderT (runStateT conduit state
       curId <- curTimeoutId <$> get
       case msg of
         ServerMessage sMsg -> yield sMsg
-        TimeoutMessage tId -> when (curId == tId) $ throw Timeout
+        TimeoutMessage tId -> when (curId == tId) $ lastReceivedMessage <$> get >>= throw . Timeout
 
 -- | An internal version of 'runSession' that allows for a custom handler to listen to the server.
 -- It also does not automatically send initialize and exit messages.
@@ -221,10 +220,9 @@ runSessionWithHandles serverIn serverOut serverProc serverHandler config caps ro
   mainThreadId <- myThreadId
 
   let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
-      initState tmp_dir = SessionState (IdInt 0) (VFS mempty tmp_dir)
+      initState vfs = SessionState (IdInt 0) vfs
                                        mempty 0 False Nothing
-      runSession' ses = withSystemTempDirectory "lsp-test" $ \tmp_dir ->
-                      runSession context (initState tmp_dir) ses
+      runSession' ses = initVFS $ \vfs -> runSession context (initState vfs) ses
 
       errorHandler = throwTo mainThreadId :: SessionException -> IO()
       serverListenerLauncher =
@@ -292,7 +290,7 @@ updateState (ReqApplyWorkspaceEdit r) = do
           ctx <- ask
 
           -- if its not open, open it
-          unless (toNormalizedUri uri `Map.member` (vfsMap oldVFS)) $ do
+          unless (toNormalizedUri uri `Map.member` vfsMap oldVFS) $ do
             let fp = fromJust $ uriToFilePath uri
             contents <- liftIO $ T.readFile fp
             let item = TextDocumentItem (filePathToUri fp) "" 0 contents