Track closed files in the VFS (#611)

Add data structure which represents a closed file in the VFS.
This structure only stores the language kind of the closed file as of
now.

The VFS now stores VFS entries which can be either open or closed files.

Author: VeryMilkyJoe

lsp-test/src/Language/LSP/Test.hs

@@ -371,7 +371,7 @@ envOverrideConfig cfg = do
 documentContents :: TextDocumentIdentifier -> Session T.Text
 documentContents doc = do
   vfs <- vfs <$> get
-  let Just file = vfs ^. vfsMap . at (toNormalizedUri (doc ^. L.uri))
+  let Just file = vfs ^? vfsMap . ix (toNormalizedUri (doc ^. L.uri)) . _Open
   return (virtualFileText file)
 
 {- | Parses an ApplyEditRequest, checks that it is for the passed document
@@ -801,7 +801,7 @@ resolveAndExecuteCodeAction ca = executeCodeAction ca
 getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier
 getVersionedDoc (TextDocumentIdentifier uri) = do
   vfs <- vfs <$> get
-  let ver = vfs ^? vfsMap . ix (toNormalizedUri uri) . to virtualFileVersion
+  let ver = vfs ^? vfsMap . ix (toNormalizedUri uri) . _Open . to virtualFileVersion
   -- TODO: is this correct? Could return an OptionalVersionedTextDocumentIdentifier,
   -- but that complicated callers...
   return (VersionedTextDocumentIdentifier uri (fromMaybe 0 ver))

lsp-test/src/Language/LSP/Test/Session.hs

@@ -446,7 +446,7 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
     modify $ \s ->
       let oldVFS = vfs s
           update (VirtualFile _ file_ver t _kind) = VirtualFile v (file_ver +1) t _kind
-          newVFS = oldVFS & vfsMap . ix (toNormalizedUri uri) %~ update
+          newVFS = oldVFS & vfsMap . ix (toNormalizedUri uri) . _Open %~ update
       in s { vfs = newVFS }
 
   where
@@ -486,7 +486,7 @@ updateState (FromServerMess SMethod_WorkspaceApplyEdit r) = do
         -- where n is the current version
         textDocumentVersions uri = do
           vfs <- vfs <$> get
-          let curVer = fromMaybe 0 $ vfs ^? vfsMap . ix (toNormalizedUri uri) . lsp_version
+          let curVer = fromMaybe 0 $ vfs ^? vfsMap . ix (toNormalizedUri uri) . _Open . lsp_version
           pure $ map (VersionedTextDocumentIdentifier uri) [curVer + 1..]
 
         textDocumentEdits uri edits = do

lsp/src/Language/LSP/Server/Core.hs

@@ -21,7 +21,7 @@ import Colog.Core (
  )
 import Control.Concurrent.Extra as C
 import Control.Concurrent.STM
-import Control.Lens (at, (^.), (^?), _Just)
+import Control.Lens (ix, (^.), (^?), _Just)
 import Control.Monad
 import Control.Monad.Catch (
   MonadCatch,
@@ -433,7 +433,7 @@ sendRequest m params resHandler = do
 getVirtualFile :: MonadLsp config m => NormalizedUri -> m (Maybe VirtualFile)
 getVirtualFile uri = do
   dat <- vfsData <$> getsState resVFS
-  pure $ dat ^. vfsMap . at uri
+  pure $ dat ^? vfsMap . ix uri . _Open
 {-# INLINE getVirtualFile #-}
 
 getVirtualFiles :: MonadLsp config m => m VFS

lsp/src/Language/LSP/VFS.hs

@@ -18,12 +18,19 @@ module Language.LSP.VFS (
   VFS (..),
   vfsMap,
   VirtualFile (..),
+  ClosedVirtualFile (..),
+  VirtualFileEntry (..),
   lsp_version,
   file_version,
   file_text,
+  language_id,
+  _Open,
+  _Closed,
   virtualFileText,
   virtualFileVersion,
   virtualFileLanguageKind,
+  closedVirtualFileLanguageKind,
+  virtualFileEntryLanguageKind,
   VfsLog (..),
 
   -- * Managing the VFS
@@ -102,13 +109,27 @@ data VirtualFile = VirtualFile
   }
   deriving (Show)
 
+{- | Represents a closed file in the VFS
+We are keeping track of this in order to be able to get information
+on virtual files after they were closed.
+-}
+data ClosedVirtualFile = ClosedVirtualFile
+  { _language_id :: !(Maybe J.LanguageKind)
+  -- ^ see 'VirtualFile._language_id'
+  }
+  deriving (Show)
+
+data VirtualFileEntry = Open VirtualFile | Closed ClosedVirtualFile
+  deriving (Show)
+
 data VFS = VFS
-  { _vfsMap :: !(Map.Map J.NormalizedUri VirtualFile)
+  { _vfsMap :: !(Map.Map J.NormalizedUri VirtualFileEntry)
   }
   deriving (Show)
 
 data VfsLog
   = SplitInsideCodePoint Utf16.Position Rope
+  | ApplyChangeToClosedFile J.NormalizedUri
   | URINotFound J.NormalizedUri
   | Opening J.NormalizedUri
   | Closing J.NormalizedUri
@@ -120,6 +141,7 @@ data VfsLog
 instance Pretty VfsLog where
   pretty (SplitInsideCodePoint pos r) =
     "VFS: asked to make change inside code point. Position" <+> viaShow pos <+> "in" <+> viaShow r
+  pretty (ApplyChangeToClosedFile uri) = "VFS: trying to apply a change to a closed file" <+> pretty uri
   pretty (URINotFound uri) = "VFS: don't know about URI" <+> pretty uri
   pretty (Opening uri) = "VFS: opening" <+> pretty uri
   pretty (Closing uri) = "VFS: closing" <+> pretty uri
@@ -129,7 +151,9 @@ instance Pretty VfsLog where
   pretty (DeleteNonExistent uri) = "VFS: asked to delete non-existent file" <+> pretty uri
 
 makeFieldsNoPrefix ''VirtualFile
+makeFieldsNoPrefix ''ClosedVirtualFile
 makeFieldsNoPrefix ''VFS
+makePrisms ''VirtualFileEntry
 
 ---
 
@@ -140,7 +164,20 @@ virtualFileVersion :: VirtualFile -> Int32
 virtualFileVersion vf = _lsp_version vf
 
 virtualFileLanguageKind :: VirtualFile -> Maybe J.LanguageKind
-virtualFileLanguageKind vf = _language_id vf
+virtualFileLanguageKind vf = vf ^. language_id
+
+closedVirtualFileLanguageKind :: ClosedVirtualFile -> Maybe J.LanguageKind
+closedVirtualFileLanguageKind vf = vf ^. language_id
+
+virtualFileEntryLanguageKind :: VirtualFileEntry -> Maybe J.LanguageKind
+virtualFileEntryLanguageKind (Open vf) = virtualFileLanguageKind vf
+virtualFileEntryLanguageKind (Closed vf) = closedVirtualFileLanguageKind vf
+
+toClosedVirtualFile :: VirtualFile -> ClosedVirtualFile
+toClosedVirtualFile vf =
+  ClosedVirtualFile
+    { _language_id = virtualFileLanguageKind vf
+    }
 
 ---
 
@@ -155,7 +192,7 @@ openVFS logger msg = do
   let J.TextDocumentItem (J.toNormalizedUri -> uri) languageId version text = msg ^. J.params . J.textDocument
       vfile = VirtualFile version 0 (Rope.fromText text) (Just languageId)
   logger <& Opening uri `WithSeverity` Debug
-  vfsMap . at uri .= Just vfile
+  vfsMap . at uri .= (Just $ Open vfile)
 
 -- ---------------------------------------------------------------------
 
@@ -168,9 +205,10 @@ changeFromClientVFS logger msg = do
     J.VersionedTextDocumentIdentifier (J.toNormalizedUri -> uri) version = vid
   vfs <- get
   case vfs ^. vfsMap . at uri of
-    Just (VirtualFile _ file_ver contents kind) -> do
+    Just (Open (VirtualFile _ file_ver contents kind)) -> do
       contents' <- applyChanges logger contents changes
-      vfsMap . at uri .= Just (VirtualFile version (file_ver + 1) contents' kind)
+      vfsMap . at uri .= Just (Open (VirtualFile version (file_ver + 1) contents' kind))
+    Just (Closed (ClosedVirtualFile _)) -> logger <& ApplyChangeToClosedFile uri `WithSeverity` Warning
     Nothing -> logger <& URINotFound uri `WithSeverity` Warning
 
 -- ---------------------------------------------------------------------
@@ -181,7 +219,7 @@ applyCreateFile (J.CreateFile _ann _kind (J.toNormalizedUri -> uri) options) =
     %= Map.insertWith
       (\new old -> if shouldOverwrite then new else old)
       uri
-      (VirtualFile 0 0 mempty Nothing)
+      (Open (VirtualFile 0 0 mempty Nothing))
  where
   shouldOverwrite :: Bool
   shouldOverwrite = case options of
@@ -308,7 +346,8 @@ persistFileVFS :: (MonadIO m) => LogAction m (WithSeverity VfsLog) -> FilePath -
 persistFileVFS logger dir vfs uri =
   case vfs ^. vfsMap . at uri of
     Nothing -> Nothing
-    Just vf ->
+    (Just (Closed _)) -> Nothing
+    (Just (Open vf)) ->
       let tfn = virtualFileName dir uri vf
           action = do
             exists <- liftIO $ doesFileExist tfn
@@ -329,7 +368,12 @@ closeVFS :: (MonadState VFS m) => LogAction m (WithSeverity VfsLog) -> J.TMessag
 closeVFS logger msg = do
   let J.DidCloseTextDocumentParams (J.TextDocumentIdentifier (J.toNormalizedUri -> uri)) = msg ^. J.params
   logger <& Closing uri `WithSeverity` Debug
-  vfsMap . at uri .= Nothing
+  vfsMap . ix uri
+    %= ( \mf ->
+          case mf of
+            Open f -> Closed $ toClosedVirtualFile f
+            Closed f -> Closed f
+       )
 
 -- ---------------------------------------------------------------------