X-Git-Url: http://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=e4f6a648366050f257f8ebdc21f0915d78e2ffe5;hb=a9dfbffbaa28063f1d9f5ff9a27f4ea617807701;hp=1abad54d673728031afabbbd332fcebc396631f8;hpb=a8e8371de3168f0faae2f33eae0d97f466c4786f;p=lsp-test.git

diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs
index 1abad54..e4f6a64 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.
 --
@@ -78,8 +79,6 @@ import System.Timeout
 -- 'Language.Haskell.LSP.Test.sendRequest' and
 -- 'Language.Haskell.LSP.Test.sendNotification'.
 
--- newtype Session a = Session (ParserStateReader FromServerMessage SessionState SessionContext IO a)
-
 newtype Session a = Session (ConduitParser FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) a)
   deriving (Functor, Applicative, Monad, MonadIO, Alternative)
 
@@ -222,8 +221,10 @@ 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 tmp_dir = SessionState (IdInt 0) (VFS mempty tmp_dir)
+                                       mempty 0 False Nothing
+      runSession' ses = withSystemTempDirectory "lsp-test" $ \tmp_dir ->
+                      runSession context (initState tmp_dir) ses
 
       errorHandler = throwTo mainThreadId :: SessionException -> IO()
       serverListenerLauncher =
@@ -282,8 +283,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
@@ -291,7 +292,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
@@ -299,7 +300,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)) =