X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=07b33e888c5c3eb44f931ce138e87c2569acdcea;hb=6f69337aa146eedf0bca00d7a1d7bb507ef95c56;hp=b8dbe2ac04797c21ddf2d6b7a4beba3036d67c86;hpb=3fedb8ff9e5720da944cf4d2cd4ad5afff0d10af;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index b8dbe2a..07b33e8 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -70,6 +70,7 @@ 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. -- @@ -220,8 +221,9 @@ runSessionWithHandles serverIn serverOut serverProc serverHandler config caps ro mainThreadId <- myThreadId let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps - initState = SessionState (IdInt 0) mempty mempty 0 False Nothing - runSession' = runSession context initState + initState vfs = SessionState (IdInt 0) vfs + mempty 0 False Nothing + runSession' ses = initVFS $ \vfs -> runSession context (initState vfs) ses errorHandler = throwTo mainThreadId :: SessionException -> IO() serverListenerLauncher = @@ -280,8 +282,8 @@ updateState (ReqApplyWorkspaceEdit r) = do forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) -> modify $ \s -> let oldVFS = vfs s - update (VirtualFile oldV t mf) = VirtualFile (fromMaybe oldV v) t mf - newVFS = Map.adjust update (toNormalizedUri uri) oldVFS + update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t + newVFS = updateVFS (Map.adjust update (toNormalizedUri uri)) oldVFS in s { vfs = newVFS } where checkIfNeedsOpened uri = do @@ -289,7 +291,7 @@ updateState (ReqApplyWorkspaceEdit r) = do ctx <- ask -- if its not open, open it - unless (toNormalizedUri uri `Map.member` 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 @@ -297,7 +299,7 @@ updateState (ReqApplyWorkspaceEdit r) = do liftIO $ B.hPut (serverIn ctx) $ addHeader (encode msg) modifyM $ \s -> do - newVFS <- liftIO $ openVFS (vfs s) msg + let (newVFS,_) = openVFS (vfs s) msg return $ s { vfs = newVFS } getParams (TextDocumentEdit docId (List edits)) =