Track file versions accurately.

This patch does two things:

1. It allows us to track the versions of `Values` which don't come from the VFS, as long as those
   particular `Values` depended on the `GetModificationTime` rule
   This is necessary for the recompilation avoidance scheme implemented in #2316

2. It removes the VFSHandle type and instead relies on snapshots of the VFS state taken on every rebuild
   of the shake session to ensure that we see a consistent VFS state throughout each individual build.

With regards to 2, this is necessary because the lsp library mutates its VFS file store as changes come
in. This can lead to scenarios where the HLS build session can see inconsistent views of the VFS.
One such scenario is.

1. HLS build starts, with VFS state A
2. LSP Change request comes in and lsp updates its internal VFS state to B
3. HLS build continues, now consulting VFS state B
4. lsp calls the HLS file change handler, interrupting the build and restarting it.
   However, the build might have completed, or cached results computed using an
   inconsistent VFS state.

Author: wz1000

ghcide/ghcide.cabal

@@ -50,6 +50,7 @@ library
         dlist,
         exceptions,
         extra >= 1.7.4,
+        enummapset,
         filepath,
         fingertree,
         focus,
@@ -147,6 +148,7 @@ library
         Development.IDE.Main.HeapStats
         Development.IDE.Core.Debouncer
         Development.IDE.Core.FileStore
+        Development.IDE.Core.FileUtils
         Development.IDE.Core.IdeConfiguration
         Development.IDE.Core.OfInterest
         Development.IDE.Core.PositionMapping

ghcide/src/Development/IDE/Core/FileExists.hs

@@ -173,8 +173,8 @@ allExtensions opts = [extIncBoot | ext <- optExtensions opts, extIncBoot <- [ext
 -- | Installs the 'getFileExists' rules.
 --   Provides a fast implementation if client supports dynamic watched files.
 --   Creates a global state as a side effect in that case.
-fileExistsRules :: Recorder (WithPriority Log) -> Maybe (LanguageContextEnv Config) -> VFSHandle -> Rules ()
-fileExistsRules recorder lspEnv vfs = do
+fileExistsRules :: Recorder (WithPriority Log) -> Maybe (LanguageContextEnv Config) -> Rules ()
+fileExistsRules recorder lspEnv = do
   supportsWatchedFiles <- case lspEnv of
     Nothing      -> pure False
     Just lspEnv' -> liftIO $  runLspT lspEnv' isWatchSupported
@@ -195,19 +195,19 @@ fileExistsRules recorder lspEnv vfs = do
         else const $ pure False
 
   if supportsWatchedFiles
-    then fileExistsRulesFast recorder isWatched vfs
-    else fileExistsRulesSlow recorder vfs
+    then fileExistsRulesFast recorder isWatched
+    else fileExistsRulesSlow recorder
 
-  fileStoreRules (cmapWithPrio LogFileStore recorder) vfs isWatched
+  fileStoreRules (cmapWithPrio LogFileStore recorder) isWatched
 
 -- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked.
-fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> VFSHandle -> Rules ()
-fileExistsRulesFast recorder isWatched vfs =
+fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
+fileExistsRulesFast recorder isWatched =
     defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> do
         isWF <- isWatched file
         if isWF
-            then fileExistsFast vfs file
-            else fileExistsSlow vfs file
+            then fileExistsFast file
+            else fileExistsSlow file
 
 {- Note [Invalidating file existence results]
 We have two mechanisms for getting file existence information:
@@ -225,8 +225,8 @@ For the VFS lookup, however, we won't get prompted to flush the result, so inste
 we use 'alwaysRerun'.
 -}
 
-fileExistsFast :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
-fileExistsFast vfs file = do
+fileExistsFast :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
+fileExistsFast file = do
     -- Could in principle use 'alwaysRerun' here, but it's too slwo, See Note [Invalidating file existence results]
     mp <- getFileExistsMapUntracked
 
@@ -235,28 +235,27 @@ fileExistsFast vfs file = do
       Just exist -> pure exist
       -- We don't know about it: use the slow route.
       -- Note that we do *not* call 'fileExistsSlow', as that would trigger 'alwaysRerun'.
-      Nothing    -> liftIO $ getFileExistsVFS vfs file
+      Nothing    -> getFileExistsVFS file
     pure (summarizeExists exist, Just exist)
 
 summarizeExists :: Bool -> Maybe BS.ByteString
 summarizeExists x = Just $ if x then BS.singleton 1 else BS.empty
 
-fileExistsRulesSlow :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
-fileExistsRulesSlow recorder vfs =
-  defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow vfs file
+fileExistsRulesSlow :: Recorder (WithPriority Log) -> Rules ()
+fileExistsRulesSlow recorder =
+  defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow file
 
-fileExistsSlow :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
-fileExistsSlow vfs file = do
+fileExistsSlow :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
+fileExistsSlow file = do
     -- See Note [Invalidating file existence results]
     alwaysRerun
-    exist <- liftIO $ getFileExistsVFS vfs file
+    exist <- getFileExistsVFS file
     pure (summarizeExists exist, Just exist)
 
-getFileExistsVFS :: VFSHandle -> NormalizedFilePath -> IO Bool
-getFileExistsVFS vfs file = do
-    -- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute
-    -- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly
-    -- cached 'No' rather than an exception in the wrong place
-    handle (\(_ :: IOException) -> return False) $
-        (isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
-        Dir.doesFileExist (fromNormalizedFilePath file)
+getFileExistsVFS :: NormalizedFilePath -> Action Bool
+getFileExistsVFS file = do
+  vf <- getVirtualFile file
+  if isJust vf
+  then pure True
+  else liftIO $ handle (\(_ :: IOException) -> return False) $
+         Dir.doesFileExist (fromNormalizedFilePath file)

ghcide/src/Development/IDE/Core/FileStore.hs

@@ -5,15 +5,11 @@
 
 module Development.IDE.Core.FileStore(
     getFileContents,
-    getVirtualFile,
     setFileModified,
     setSomethingModified,
     fileStoreRules,
     modificationTime,
     typecheckParents,
-    VFSHandle,
-    makeVFSHandle,
-    makeLSPVFSHandle,
     resetFileStore,
     resetInterfaceStore,
     getModificationTimeImpl,
@@ -28,20 +24,18 @@ module Development.IDE.Core.FileStore(
 import           Control.Concurrent.STM.Stats                 (STM, atomically,
                                                                modifyTVar')
 import           Control.Concurrent.STM.TQueue                (writeTQueue)
-import           Control.Concurrent.Strict
 import           Control.Exception
 import           Control.Monad.Extra
 import           Control.Monad.IO.Class
 import qualified Data.ByteString                              as BS
 import           Data.Either.Extra
-import qualified Data.Map.Strict                              as Map
-import           Data.Maybe
 import qualified Data.Rope.UTF16                              as Rope
 import qualified Data.Text                                    as T
 import           Data.Time
 import           Data.Time.Clock.POSIX
 import           Development.IDE.Core.RuleTypes
 import           Development.IDE.Core.Shake                   hiding (Log)
+import           Development.IDE.Core.FileUtils
 import           Development.IDE.GHC.Orphans                  ()
 import           Development.IDE.Graph
 import           Development.IDE.Import.DependencyInformation
@@ -56,8 +50,6 @@ import           System.IO.Error
 #ifdef mingw32_HOST_OS
 import qualified System.Directory                             as Dir
 #else
-import           System.Posix.Files                           (getFileStatus,
-                                                               modificationTimeHiRes)
 #endif
 
 import qualified Development.IDE.Types.Logger                 as L
@@ -76,8 +68,6 @@ import           Development.IDE.Types.Logger                 (Pretty (pretty),
                                                                cmapWithPrio,
                                                                logWith, viaShow,
                                                                (<+>))
-import           Language.LSP.Server                          hiding
-                                                              (getVirtualFile)
 import qualified Language.LSP.Server                          as LSP
 import           Language.LSP.Types                           (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions),
                                                                FileChangeType (FcChanged),
@@ -106,27 +96,6 @@ instance Pretty Log where
       <+> pretty (fmap (fmap show) reverseDepPaths)
     LogShake log -> pretty log
 
-makeVFSHandle :: IO VFSHandle
-makeVFSHandle = do
-    vfsVar <- newVar (1, Map.empty)
-    pure VFSHandle
-        { getVirtualFile = \uri -> do
-              (_nextVersion, vfs) <- readVar vfsVar
-              pure $ Map.lookup uri vfs
-        , setVirtualFileContents = Just $ \uri content ->
-              void $ modifyVar' vfsVar $ \(nextVersion, vfs) -> (nextVersion + 1, ) $
-                  case content of
-                    Nothing -> Map.delete uri vfs
-                    -- The second version number is only used in persistFileVFS which we do not use so we set it to 0.
-                    Just content -> Map.insert uri (VirtualFile nextVersion 0 (Rope.fromText content)) vfs
-        }
-
-makeLSPVFSHandle :: LanguageContextEnv c -> VFSHandle
-makeLSPVFSHandle lspEnv = VFSHandle
-    { getVirtualFile = runLspT lspEnv . LSP.getVirtualFile
-    , setVirtualFileContents = Nothing
-   }
-
 addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
 addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile f -> do
   isAlreadyWatched <- isWatched f
@@ -140,20 +109,19 @@ addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogSha
             Nothing -> pure $ Just False
 
 
-getModificationTimeRule :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
-getModificationTimeRule recorder vfs = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
-    getModificationTimeImpl vfs missingFileDiags file
+getModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
+getModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
+    getModificationTimeImpl missingFileDiags file
 
-getModificationTimeImpl :: VFSHandle
-    -> Bool
-    -> NormalizedFilePath
-    -> Action
-        (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
-getModificationTimeImpl vfs missingFileDiags file = do
+getModificationTimeImpl
+  :: Bool
+  -> NormalizedFilePath
+  -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
+getModificationTimeImpl missingFileDiags file = do
     let file' = fromNormalizedFilePath file
     let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))
-    mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
-    case mbVirtual of
+    mbVf <- getVirtualFile file
+    case mbVf of
         Just (virtualFileVersion -> ver) -> do
             alwaysRerun
             pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver))
@@ -206,43 +174,23 @@ resetFileStore ideState changes = mask $ \_ -> do
             _ -> pure ()
 
 
--- Dir.getModificationTime is surprisingly slow since it performs
--- a ton of conversions. Since we do not actually care about
--- the format of the time, we can get away with something cheaper.
--- For now, we only try to do this on Unix systems where it seems to get the
--- time spent checking file modifications (which happens on every change)
--- from > 0.5s to ~0.15s.
--- We might also want to try speeding this up on Windows at some point.
--- TODO leverage DidChangeWatchedFile lsp notifications on clients that
--- support them, as done for GetFileExists
-getModTime :: FilePath -> IO POSIXTime
-getModTime f =
-#ifdef mingw32_HOST_OS
-    utcTimeToPOSIXSeconds <$> Dir.getModificationTime f
-#else
-    modificationTimeHiRes <$> getFileStatus f
-#endif
-
 modificationTime :: FileVersion -> Maybe UTCTime
 modificationTime VFSVersion{}             = Nothing
 modificationTime (ModificationTime posix) = Just $ posixSecondsToUTCTime posix
 
-getFileContentsRule :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
-getFileContentsRule recorder vfs = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl vfs file
+getFileContentsRule :: Recorder (WithPriority Log) -> Rules ()
+getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl file
 
 getFileContentsImpl
-    :: VFSHandle
-    -> NormalizedFilePath
+    :: NormalizedFilePath
     -> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
-getFileContentsImpl vfs file = do
+getFileContentsImpl file = do
     -- need to depend on modification time to introduce a dependency with Cutoff
     time <- use_ GetModificationTime file
-    res <- liftIO $ ideTryIOException file $ do
-        mbVirtual <- getVirtualFile vfs $ filePathToUri' file
+    res <- do
+        mbVirtual <- getVirtualFile file
         pure $ Rope.toText . _text <$> mbVirtual
-    case res of
-        Left err       -> return ([err], Nothing)
-        Right contents -> return ([], Just (time, contents))
+    pure ([], Just (time, res))
 
 ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
 ideTryIOException fp act =
@@ -266,11 +214,10 @@ getFileContents f = do
             pure $ posixSecondsToUTCTime posix
     return (modTime, txt)
 
-fileStoreRules :: Recorder (WithPriority Log) -> VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
-fileStoreRules recorder vfs isWatched = do
-    addIdeGlobal vfs
-    getModificationTimeRule recorder vfs
-    getFileContentsRule recorder vfs
+fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
+fileStoreRules recorder isWatched = do
+    getModificationTimeRule recorder
+    getFileContentsRule recorder
     addWatchedFileRule recorder isWatched
 
 -- | Note that some buffer for a specific file has been modified but not
@@ -287,9 +234,6 @@ setFileModified recorder state saved nfp = do
           AlwaysCheck -> True
           CheckOnSave -> saved
           _           -> False
-    VFSHandle{..} <- getIdeGlobalState state
-    when (isJust setVirtualFileContents) $
-        fail "setFileModified can't be called on this type of VFSHandle"
     join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
     restartShakeSession (shakeExtras state) (fromNormalizedFilePath nfp ++ " (modified)") []
     when checkParents $
@@ -314,9 +258,6 @@ typecheckParentsAction recorder nfp = do
 --   independently tracks which files are modified.
 setSomethingModified :: IdeState -> [Key] -> String -> IO ()
 setSomethingModified state keys reason = do
-    VFSHandle{..} <- getIdeGlobalState state
-    when (isJust setVirtualFileContents) $
-        fail "setSomethingModified can't be called on this type of VFSHandle"
     -- Update database to remove any files that might have been renamed/deleted
     atomically $ do
         writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)

ghcide/src/Development/IDE/Core/FileUtils.hs

@@ -0,0 +1,31 @@
+{-# LANGUAGE CPP          #-}
+
+module Development.IDE.Core.FileUtils(
+    getModTime,
+    ) where
+
+
+import           Data.Time.Clock.POSIX
+#ifdef mingw32_HOST_OS
+import qualified System.Directory                             as Dir
+#else
+import           System.Posix.Files                           (getFileStatus,
+                                                               modificationTimeHiRes)
+#endif
+
+-- Dir.getModificationTime is surprisingly slow since it performs
+-- a ton of conversions. Since we do not actually care about
+-- the format of the time, we can get away with something cheaper.
+-- For now, we only try to do this on Unix systems where it seems to get the
+-- time spent checking file modifications (which happens on every change)
+-- from > 0.5s to ~0.15s.
+-- We might also want to try speeding this up on Windows at some point.
+-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
+-- support them, as done for GetFileExists
+getModTime :: FilePath -> IO POSIXTime
+getModTime f =
+#ifdef mingw32_HOST_OS
+    utcTimeToPOSIXSeconds <$> Dir.getModificationTime f
+#else
+    modificationTimeHiRes <$> getFileStatus f
+#endif

ghcide/src/Development/IDE/Core/RuleTypes.hs

@@ -290,10 +290,12 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
 -- | Get the modification time of a file.
 type instance RuleResult GetModificationTime = FileVersion
 
+-- | Either athe mtime from disk or an LSP version
+-- LSP versions always compare as greater than on disk versions
 data FileVersion
-    = VFSVersion !Int32
-    | ModificationTime !POSIXTime
-    deriving (Show, Generic)
+    = ModificationTime !POSIXTime
+    | VFSVersion !Int32
+    deriving (Show, Generic, Eq, Ord)
 
 instance NFData FileVersion
 

ghcide/src/Development/IDE/Core/Rules.hs

@@ -85,6 +85,7 @@ import qualified Data.HashMap.Strict                          as HM
 import qualified Data.HashSet                                 as HashSet
 import           Data.Hashable
 import           Data.IORef
+import           Control.Concurrent.STM.TVar
 import           Data.IntMap.Strict                           (IntMap)
 import qualified Data.IntMap.Strict                           as IntMap
 import           Data.List
@@ -99,8 +100,7 @@ import           Data.Tuple.Extra
 import           Development.IDE.Core.Compile
 import           Development.IDE.Core.FileExists hiding (LogShake, Log)
 import           Development.IDE.Core.FileStore               (getFileContents,
-                                                               modificationTime,
-                                                               resetInterfaceStore)
+                                                               resetInterfaceStore, modificationTime)
 import           Development.IDE.Core.IdeConfiguration
 import           Development.IDE.Core.OfInterest hiding (LogShake, Log)
 import           Development.IDE.Core.PositionMapping
@@ -555,12 +555,11 @@ getHieAstsRule recorder =
 persistentHieFileRule :: Recorder (WithPriority Log) -> Rules ()
 persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybeT $ do
   res <- readHieFileForSrcFromDisk recorder file
-  vfs <- asks vfs
-  (currentSource,ver) <- liftIO $ do
-    mvf <- getVirtualFile vfs $ filePathToUri' file
-    case mvf of
-      Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
-      Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf)
+  vfsRef <- asks vfs
+  vfsData <- liftIO $ vfsMap <$> readTVarIO vfsRef
+  (currentSource, ver) <- liftIO $ case M.lookup (filePathToUri' file) vfsData of
+    Nothing -> (,Nothing) . T.decodeUtf8 <$> BS.readFile (fromNormalizedFilePath file)
+    Just vf -> pure (Rope.toText $ _text vf, Just $ _lsp_version vf)
   let refmap = Compat.generateReferencesMap . Compat.getAsts . Compat.hie_asts $ res
       del = deltaFromDiff (T.decodeUtf8 $ Compat.hie_hs_src res) currentSource
   pure (HAR (Compat.hie_module res) (Compat.hie_asts res) refmap mempty (HieFromDisk res),del,ver)