Skip to content

Commit 905e2ef

Browse files
wz1000wz1000
authored
Track file versions accurately. (#2735)
1 parent 3084651 commit 905e2ef

File tree

14 files changed

+196
-205
lines changed

14 files changed

+196
-205
lines changed

‎ghcide/.hlint.yaml

+2
Original file line numberDiff line numberDiff line change
@@ -89,6 +89,7 @@
8989
within:
9090
- Development.IDE.Compat
9191
- Development.IDE.Core.FileStore
92+
- Development.IDE.Core.FileUtils
9293
- Development.IDE.Core.Compile
9394
- Development.IDE.Core.Rules
9495
- Development.IDE.Core.Tracing
@@ -104,6 +105,7 @@
104105
- Development.IDE.GHC.Compat.Units
105106
- Development.IDE.GHC.Compat.Util
106107
- Development.IDE.GHC.CPP
108+
- Development.IDE.GHC.Dump
107109
- Development.IDE.GHC.ExactPrint
108110
- Development.IDE.GHC.Orphans
109111
- Development.IDE.GHC.Util

‎ghcide/ghcide.cabal

+2
Original file line numberDiff line numberDiff line change
@@ -50,6 +50,7 @@ library
5050
dlist,
5151
exceptions,
5252
extra >= 1.7.4,
53+
enummapset,
5354
filepath,
5455
fingertree,
5556
focus,
@@ -147,6 +148,7 @@ library
147148
Development.IDE.Main.HeapStats
148149
Development.IDE.Core.Debouncer
149150
Development.IDE.Core.FileStore
151+
Development.IDE.Core.FileUtils
150152
Development.IDE.Core.IdeConfiguration
151153
Development.IDE.Core.OfInterest
152154
Development.IDE.Core.PositionMapping

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

+25-26
Original file line numberDiff line numberDiff line change
@@ -173,8 +173,8 @@ allExtensions opts = [extIncBoot | ext <- optExtensions opts, extIncBoot <- [ext
173173
-- | Installs the 'getFileExists' rules.
174174
-- Provides a fast implementation if client supports dynamic watched files.
175175
-- Creates a global state as a side effect in that case.
176-
fileExistsRules :: Recorder (WithPriority Log) -> Maybe (LanguageContextEnv Config) -> VFSHandle -> Rules ()
177-
fileExistsRules recorder lspEnv vfs = do
176+
fileExistsRules :: Recorder (WithPriority Log) -> Maybe (LanguageContextEnv Config) -> Rules ()
177+
fileExistsRules recorder lspEnv = do
178178
supportsWatchedFiles <- case lspEnv of
179179
Nothing -> pure False
180180
Just lspEnv' -> liftIO $ runLspT lspEnv' isWatchSupported
@@ -195,19 +195,19 @@ fileExistsRules recorder lspEnv vfs = do
195195
else const $ pure False
196196

197197
if supportsWatchedFiles
198-
then fileExistsRulesFast recorder isWatched vfs
199-
else fileExistsRulesSlow recorder vfs
198+
then fileExistsRulesFast recorder isWatched
199+
else fileExistsRulesSlow recorder
200200

201-
fileStoreRules (cmapWithPrio LogFileStore recorder) vfs isWatched
201+
fileStoreRules (cmapWithPrio LogFileStore recorder) isWatched
202202

203203
-- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked.
204-
fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> VFSHandle -> Rules ()
205-
fileExistsRulesFast recorder isWatched vfs =
204+
fileExistsRulesFast :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
205+
fileExistsRulesFast recorder isWatched =
206206
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> do
207207
isWF <- isWatched file
208208
if isWF
209-
then fileExistsFast vfs file
210-
else fileExistsSlow vfs file
209+
then fileExistsFast file
210+
else fileExistsSlow file
211211

212212
{- Note [Invalidating file existence results]
213213
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
225225
we use 'alwaysRerun'.
226226
-}
227227

228-
fileExistsFast :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
229-
fileExistsFast vfs file = do
228+
fileExistsFast :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
229+
fileExistsFast file = do
230230
-- Could in principle use 'alwaysRerun' here, but it's too slwo, See Note [Invalidating file existence results]
231231
mp <- getFileExistsMapUntracked
232232

@@ -235,28 +235,27 @@ fileExistsFast vfs file = do
235235
Just exist -> pure exist
236236
-- We don't know about it: use the slow route.
237237
-- Note that we do *not* call 'fileExistsSlow', as that would trigger 'alwaysRerun'.
238-
Nothing -> liftIO $ getFileExistsVFS vfs file
238+
Nothing -> getFileExistsVFS file
239239
pure (summarizeExists exist, Just exist)
240240

241241
summarizeExists :: Bool -> Maybe BS.ByteString
242242
summarizeExists x = Just $ if x then BS.singleton 1 else BS.empty
243243

244-
fileExistsRulesSlow :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
245-
fileExistsRulesSlow recorder vfs =
246-
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow vfs file
244+
fileExistsRulesSlow :: Recorder (WithPriority Log) -> Rules ()
245+
fileExistsRulesSlow recorder =
246+
defineEarlyCutoff (cmapWithPrio LogShake recorder) $ RuleNoDiagnostics $ \GetFileExists file -> fileExistsSlow file
247247

248-
fileExistsSlow :: VFSHandle -> NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
249-
fileExistsSlow vfs file = do
248+
fileExistsSlow :: NormalizedFilePath -> Action (Maybe BS.ByteString, Maybe Bool)
249+
fileExistsSlow file = do
250250
-- See Note [Invalidating file existence results]
251251
alwaysRerun
252-
exist <- liftIO $ getFileExistsVFS vfs file
252+
exist <- getFileExistsVFS file
253253
pure (summarizeExists exist, Just exist)
254254

255-
getFileExistsVFS :: VFSHandle -> NormalizedFilePath -> IO Bool
256-
getFileExistsVFS vfs file = do
257-
-- we deliberately and intentionally wrap the file as an FilePath WITHOUT mkAbsolute
258-
-- so that if the file doesn't exist, is on a shared drive that is unmounted etc we get a properly
259-
-- cached 'No' rather than an exception in the wrong place
260-
handle (\(_ :: IOException) -> return False) $
261-
(isJust <$> getVirtualFile vfs (filePathToUri' file)) ||^
262-
Dir.doesFileExist (fromNormalizedFilePath file)
255+
getFileExistsVFS :: NormalizedFilePath -> Action Bool
256+
getFileExistsVFS file = do
257+
vf <- getVirtualFile file
258+
if isJust vf
259+
then pure True
260+
else liftIO $ handle (\(_ :: IOException) -> return False) $
261+
Dir.doesFileExist (fromNormalizedFilePath file)

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

+22-81
Original file line numberDiff line numberDiff line change
@@ -5,15 +5,11 @@
55

66
module Development.IDE.Core.FileStore(
77
getFileContents,
8-
getVirtualFile,
98
setFileModified,
109
setSomethingModified,
1110
fileStoreRules,
1211
modificationTime,
1312
typecheckParents,
14-
VFSHandle,
15-
makeVFSHandle,
16-
makeLSPVFSHandle,
1713
resetFileStore,
1814
resetInterfaceStore,
1915
getModificationTimeImpl,
@@ -28,20 +24,18 @@ module Development.IDE.Core.FileStore(
2824
import Control.Concurrent.STM.Stats (STM, atomically,
2925
modifyTVar')
3026
import Control.Concurrent.STM.TQueue (writeTQueue)
31-
import Control.Concurrent.Strict
3227
import Control.Exception
3328
import Control.Monad.Extra
3429
import Control.Monad.IO.Class
3530
import qualified Data.ByteString as BS
3631
import Data.Either.Extra
37-
import qualified Data.Map.Strict as Map
38-
import Data.Maybe
3932
import qualified Data.Rope.UTF16 as Rope
4033
import qualified Data.Text as T
4134
import Data.Time
4235
import Data.Time.Clock.POSIX
4336
import Development.IDE.Core.RuleTypes
4437
import Development.IDE.Core.Shake hiding (Log)
38+
import Development.IDE.Core.FileUtils
4539
import Development.IDE.GHC.Orphans ()
4640
import Development.IDE.Graph
4741
import Development.IDE.Import.DependencyInformation
@@ -56,8 +50,6 @@ import System.IO.Error
5650
#ifdef mingw32_HOST_OS
5751
import qualified System.Directory as Dir
5852
#else
59-
import System.Posix.Files (getFileStatus,
60-
modificationTimeHiRes)
6153
#endif
6254

6355
import qualified Development.IDE.Types.Logger as L
@@ -76,8 +68,6 @@ import Development.IDE.Types.Logger (Pretty (pretty),
7668
cmapWithPrio,
7769
logWith, viaShow,
7870
(<+>))
79-
import Language.LSP.Server hiding
80-
(getVirtualFile)
8171
import qualified Language.LSP.Server as LSP
8272
import Language.LSP.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions),
8373
FileChangeType (FcChanged),
@@ -106,27 +96,6 @@ instance Pretty Log where
10696
<+> pretty (fmap (fmap show) reverseDepPaths)
10797
LogShake log -> pretty log
10898

109-
makeVFSHandle :: IO VFSHandle
110-
makeVFSHandle = do
111-
vfsVar <- newVar (1, Map.empty)
112-
pure VFSHandle
113-
{ getVirtualFile = \uri -> do
114-
(_nextVersion, vfs) <- readVar vfsVar
115-
pure $ Map.lookup uri vfs
116-
, setVirtualFileContents = Just $ \uri content ->
117-
void $ modifyVar' vfsVar $ \(nextVersion, vfs) -> (nextVersion + 1, ) $
118-
case content of
119-
Nothing -> Map.delete uri vfs
120-
-- The second version number is only used in persistFileVFS which we do not use so we set it to 0.
121-
Just content -> Map.insert uri (VirtualFile nextVersion 0 (Rope.fromText content)) vfs
122-
}
123-
124-
makeLSPVFSHandle :: LanguageContextEnv c -> VFSHandle
125-
makeLSPVFSHandle lspEnv = VFSHandle
126-
{ getVirtualFile = runLspT lspEnv . LSP.getVirtualFile
127-
, setVirtualFileContents = Nothing
128-
}
129-
13099
addWatchedFileRule :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
131100
addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogShake recorder) $ \AddWatchedFile f -> do
132101
isAlreadyWatched <- isWatched f
@@ -140,20 +109,19 @@ addWatchedFileRule recorder isWatched = defineNoDiagnostics (cmapWithPrio LogSha
140109
Nothing -> pure $ Just False
141110

142111

143-
getModificationTimeRule :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
144-
getModificationTimeRule recorder vfs = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
145-
getModificationTimeImpl vfs missingFileDiags file
112+
getModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
113+
getModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \(GetModificationTime_ missingFileDiags) file ->
114+
getModificationTimeImpl missingFileDiags file
146115

147-
getModificationTimeImpl :: VFSHandle
148-
-> Bool
149-
-> NormalizedFilePath
150-
-> Action
151-
(Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
152-
getModificationTimeImpl vfs missingFileDiags file = do
116+
getModificationTimeImpl
117+
:: Bool
118+
-> NormalizedFilePath
119+
-> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
120+
getModificationTimeImpl missingFileDiags file = do
153121
let file' = fromNormalizedFilePath file
154122
let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))
155-
mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file
156-
case mbVirtual of
123+
mbVf <- getVirtualFile file
124+
case mbVf of
157125
Just (virtualFileVersion -> ver) -> do
158126
alwaysRerun
159127
pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver))
@@ -206,43 +174,23 @@ resetFileStore ideState changes = mask $ \_ -> do
206174
_ -> pure ()
207175

208176

209-
-- Dir.getModificationTime is surprisingly slow since it performs
210-
-- a ton of conversions. Since we do not actually care about
211-
-- the format of the time, we can get away with something cheaper.
212-
-- For now, we only try to do this on Unix systems where it seems to get the
213-
-- time spent checking file modifications (which happens on every change)
214-
-- from > 0.5s to ~0.15s.
215-
-- We might also want to try speeding this up on Windows at some point.
216-
-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
217-
-- support them, as done for GetFileExists
218-
getModTime :: FilePath -> IO POSIXTime
219-
getModTime f =
220-
#ifdef mingw32_HOST_OS
221-
utcTimeToPOSIXSeconds <$> Dir.getModificationTime f
222-
#else
223-
modificationTimeHiRes <$> getFileStatus f
224-
#endif
225-
226177
modificationTime :: FileVersion -> Maybe UTCTime
227178
modificationTime VFSVersion{} = Nothing
228179
modificationTime (ModificationTime posix) = Just $ posixSecondsToUTCTime posix
229180

230-
getFileContentsRule :: Recorder (WithPriority Log) -> VFSHandle -> Rules ()
231-
getFileContentsRule recorder vfs = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl vfs file
181+
getFileContentsRule :: Recorder (WithPriority Log) -> Rules ()
182+
getFileContentsRule recorder = define (cmapWithPrio LogShake recorder) $ \GetFileContents file -> getFileContentsImpl file
232183

233184
getFileContentsImpl
234-
:: VFSHandle
235-
-> NormalizedFilePath
185+
:: NormalizedFilePath
236186
-> Action ([FileDiagnostic], Maybe (FileVersion, Maybe T.Text))
237-
getFileContentsImpl vfs file = do
187+
getFileContentsImpl file = do
238188
-- need to depend on modification time to introduce a dependency with Cutoff
239189
time <- use_ GetModificationTime file
240-
res <- liftIO $ ideTryIOException file $ do
241-
mbVirtual <- getVirtualFile vfs $ filePathToUri' file
190+
res <- do
191+
mbVirtual <- getVirtualFile file
242192
pure $ Rope.toText . _text <$> mbVirtual
243-
case res of
244-
Left err -> return ([err], Nothing)
245-
Right contents -> return ([], Just (time, contents))
193+
pure ([], Just (time, res))
246194

247195
ideTryIOException :: NormalizedFilePath -> IO a -> IO (Either FileDiagnostic a)
248196
ideTryIOException fp act =
@@ -266,11 +214,10 @@ getFileContents f = do
266214
pure $ posixSecondsToUTCTime posix
267215
return (modTime, txt)
268216

269-
fileStoreRules :: Recorder (WithPriority Log) -> VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules ()
270-
fileStoreRules recorder vfs isWatched = do
271-
addIdeGlobal vfs
272-
getModificationTimeRule recorder vfs
273-
getFileContentsRule recorder vfs
217+
fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
218+
fileStoreRules recorder isWatched = do
219+
getModificationTimeRule recorder
220+
getFileContentsRule recorder
274221
addWatchedFileRule recorder isWatched
275222

276223
-- | Note that some buffer for a specific file has been modified but not
@@ -287,9 +234,6 @@ setFileModified recorder state saved nfp = do
287234
AlwaysCheck -> True
288235
CheckOnSave -> saved
289236
_ -> False
290-
VFSHandle{..} <- getIdeGlobalState state
291-
when (isJust setVirtualFileContents) $
292-
fail "setFileModified can't be called on this type of VFSHandle"
293237
join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
294238
restartShakeSession (shakeExtras state) (fromNormalizedFilePath nfp ++ " (modified)") []
295239
when checkParents $
@@ -314,9 +258,6 @@ typecheckParentsAction recorder nfp = do
314258
-- independently tracks which files are modified.
315259
setSomethingModified :: IdeState -> [Key] -> String -> IO ()
316260
setSomethingModified state keys reason = do
317-
VFSHandle{..} <- getIdeGlobalState state
318-
when (isJust setVirtualFileContents) $
319-
fail "setSomethingModified can't be called on this type of VFSHandle"
320261
-- Update database to remove any files that might have been renamed/deleted
321262
atomically $ do
322263
writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)

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

+31
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,31 @@
1+
{-# LANGUAGE CPP #-}
2+
3+
module Development.IDE.Core.FileUtils(
4+
getModTime,
5+
) where
6+
7+
8+
import Data.Time.Clock.POSIX
9+
#ifdef mingw32_HOST_OS
10+
import qualified System.Directory as Dir
11+
#else
12+
import System.Posix.Files (getFileStatus,
13+
modificationTimeHiRes)
14+
#endif
15+
16+
-- Dir.getModificationTime is surprisingly slow since it performs
17+
-- a ton of conversions. Since we do not actually care about
18+
-- the format of the time, we can get away with something cheaper.
19+
-- For now, we only try to do this on Unix systems where it seems to get the
20+
-- time spent checking file modifications (which happens on every change)
21+
-- from > 0.5s to ~0.15s.
22+
-- We might also want to try speeding this up on Windows at some point.
23+
-- TODO leverage DidChangeWatchedFile lsp notifications on clients that
24+
-- support them, as done for GetFileExists
25+
getModTime :: FilePath -> IO POSIXTime
26+
getModTime f =
27+
#ifdef mingw32_HOST_OS
28+
utcTimeToPOSIXSeconds <$> Dir.getModificationTime f
29+
#else
30+
modificationTimeHiRes <$> getFileStatus f
31+
#endif

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

+5-3
Original file line numberDiff line numberDiff line change
@@ -290,10 +290,12 @@ pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
290290
-- | Get the modification time of a file.
291291
type instance RuleResult GetModificationTime = FileVersion
292292

293+
-- | Either the mtime from disk or an LSP version
294+
-- LSP versions always compare as greater than on disk versions
293295
data FileVersion
294-
= VFSVersion !Int32
295-
| ModificationTime !POSIXTime
296-
deriving (Show, Generic)
296+
= ModificationTime !POSIXTime -- order of constructors is relevant
297+
| VFSVersion !Int32
298+
deriving (Show, Generic, Eq, Ord)
297299

298300
instance NFData FileVersion
299301

0 commit comments

Comments
 (0)