From f0b84285f19a4a8e05caca2c588d3d593e8763ce Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 2 Mar 2021 20:56:25 +0000 Subject: [PATCH 1/6] Extend file watch suscriptions to monitor changes --- ghcide/src/Development/IDE/Core/FileExists.hs | 16 +++++++++++++--- ghcide/src/Development/IDE/LSP/Notifications.hs | 2 +- 2 files changed, 14 insertions(+), 4 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 5e4a98a77e..f2c2495c5b 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -88,17 +88,27 @@ getFileExistsMapUntracked = do liftIO $ readVar v -- | Modify the global store of file exists. -modifyFileExists :: IdeState -> [(NormalizedFilePath, Bool)] -> IO () +modifyFileExists :: IdeState -> [FileEvent] -> IO () modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state - changesMap <- evaluate $ HashMap.fromList changes + changesMap <- evaluate $ HashMap.fromList $ + [ (toNormalizedFilePath' f, newState) + | FileEvent uri change <- changes + , Just f <- [uriToFilePath uri] + , Just newState <- [fromChange change] + ] -- Masked to ensure that the previous values are flushed together with the map update mask $ \_ -> do -- update the map modifyVar_ var $ evaluate . HashMap.union changesMap -- See Note [Invalidating file existence results] -- flush previous values - mapM_ (deleteValue state GetFileExists . fst) changes + mapM_ (deleteValue state GetFileExists) (HashMap.keys changesMap) + +fromChange :: FileChangeType -> Maybe Bool +fromChange FcCreated = Just True +fromChange FcDeleted = Just True +fromChange FcChanged = Nothing ------------------------------------------------------------------------------------- diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 658253b4a7..46d0ae5264 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -133,7 +133,7 @@ setHandlersNotifications = mconcat regOptions = DidChangeWatchedFilesRegistrationOptions { _watchers = List watchers } -- See Note [File existence cache and LSP file watchers] for why this exists, and the choice of watch kind - watchKind = WatchKind { _watchCreate = True, _watchChange = False, _watchDelete = True} + watchKind = WatchKind { _watchCreate = True, _watchChange = True, _watchDelete = True} -- See Note [Which files should we watch?] for an explanation of why the pattern is the way that it is -- The patterns will be something like "**/.hs", i.e. "any number of directory segments, -- followed by a file with an extension 'hs'. From 1a34b02c122f25c37164214192dfcdd23a92a2f3 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 2 Mar 2021 21:08:45 +0000 Subject: [PATCH 2/6] file watch notifications for GetModificationTime --- ghcide/src/Development/IDE/Core/FileExists.hs | 28 +++++++---- ghcide/src/Development/IDE/Core/FileStore.hs | 50 +++++++++++++------ ghcide/src/Development/IDE/Core/Service.hs | 2 - .../src/Development/IDE/LSP/Notifications.hs | 19 +++---- 4 files changed, 59 insertions(+), 40 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index f2c2495c5b..19ebf74904 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -155,7 +155,10 @@ This is fine so long as we're watching the files we check most often, i.e. sourc -- | The list of file globs that we ask the client to watch. watchedGlobs :: IdeOptions -> [String] -watchedGlobs opts = [ "**/*." ++ extIncBoot | ext <- optExtensions opts, extIncBoot <- [ext, ext ++ "-boot"]] +watchedGlobs opts = [ "**/*." ++ ext | ext <- allExtensions opts] + +allExtensions :: IdeOptions -> [String] +allExtensions opts = [extIncBoot | ext <- optExtensions opts, extIncBoot <- [ext, ext ++ "-boot"]] -- | Installs the 'getFileExists' rules. -- Provides a fast implementation if client supports dynamic watched files. @@ -180,19 +183,26 @@ fileExistsRules lspEnv vfs = do extras <- getShakeExtrasRules opts <- liftIO $ getIdeOptionsIO extras let globs = watchedGlobs opts + patterns = fmap Glob.compile globs + fpMatches fp = any (`Glob.match`fp) patterns + isWatched = if supportsWatchedFiles + then \f -> do + isWF <- isWorkspaceFile f + return $ isWF && fpMatches (fromNormalizedFilePath f) + else const $ pure False if supportsWatchedFiles - then fileExistsRulesFast globs vfs + then fileExistsRulesFast isWatched vfs else fileExistsRulesSlow vfs + fileStoreRules vfs isWatched + -- Requires an lsp client that provides WatchedFiles notifications, but assumes that this has already been checked. -fileExistsRulesFast :: [String] -> VFSHandle -> Rules () -fileExistsRulesFast globs vfs = - let patterns = fmap Glob.compile globs - fpMatches fp = any (\p -> Glob.match p fp) patterns - in defineEarlyCutoff $ \GetFileExists file -> do - isWf <- isWorkspaceFile file - if isWf && fpMatches (fromNormalizedFilePath file) +fileExistsRulesFast :: (NormalizedFilePath -> Action Bool) -> VFSHandle -> Rules () +fileExistsRulesFast isWatched vfs = + defineEarlyCutoff $ \GetFileExists file -> do + isWF <- isWatched file + if isWF then fileExistsFast vfs file else fileExistsSlow vfs file diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index d605a761fa..7ff7325cd1 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -15,7 +15,7 @@ module Development.IDE.Core.FileStore( makeVFSHandle, makeLSPVFSHandle, isFileOfInterestRule - ) where + ,modifyFileStore) where import Control.Concurrent.Extra import Control.Concurrent.STM (atomically) @@ -63,6 +63,9 @@ import qualified Development.IDE.Types.Logger as L import Language.LSP.Server hiding (getVirtualFile) import qualified Language.LSP.Server as LSP +import Language.LSP.Types (FileChangeType (FcChanged), + FileEvent (FileEvent), + uriToFilePath) import Language.LSP.VFS makeVFSHandle :: IO VFSHandle @@ -93,24 +96,39 @@ isFileOfInterestRule = defineEarlyCutoff $ \IsFileOfInterest f -> do let res = maybe NotFOI IsFOI $ f `HM.lookup` filesOfInterest return (Just $ BS.pack $ show $ hash res, ([], Just res)) -getModificationTimeRule :: VFSHandle -> Rules () -getModificationTimeRule vfs = +getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules () +getModificationTimeRule vfs isWatched = defineEarlyCutoff $ \(GetModificationTime_ missingFileDiags) file -> do let file' = fromNormalizedFilePath file let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s)) - alwaysRerun mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file case mbVirtual of - Just (virtualFileVersion -> ver) -> + Just (virtualFileVersion -> ver) -> do + alwaysRerun pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver)) - Nothing -> liftIO $ fmap wrap (getModTime file') - `catch` \(e :: IOException) -> do - let err | isDoesNotExistError e = "File does not exist: " ++ file' - | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e - diag = ideErrorText file (T.pack err) - if isDoesNotExistError e && not missingFileDiags - then return (Nothing, ([], Nothing)) - else return (Nothing, ([diag], Nothing)) + Nothing -> do + isWF <- isWatched file + unless isWF alwaysRerun + liftIO $ fmap wrap (getModTime file') + `catch` \(e :: IOException) -> do + let err | isDoesNotExistError e = "File does not exist: " ++ file' + | otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e + diag = ideErrorText file (T.pack err) + if isDoesNotExistError e && not missingFileDiags + then return (Nothing, ([], Nothing)) + else return (Nothing, ([diag], Nothing)) + +-- | Reset the GetModificationTime state of watched files +modifyFileStore :: IdeState -> [FileEvent] -> IO () +modifyFileStore state changes = mask $ \_ -> + forM_ changes $ \(FileEvent uri c) -> + case c of + FcChanged + | Just f <- uriToFilePath uri + -> do + deleteValue state (GetModificationTime_ True) (toNormalizedFilePath' f) + deleteValue state (GetModificationTime_ False) (toNormalizedFilePath' f) + _ -> pure () -- Dir.getModificationTime is surprisingly slow since it performs -- a ton of conversions. Since we do not actually care about @@ -188,10 +206,10 @@ getFileContents f = do pure $ internalTimeToUTCTime large small return (modTime, txt) -fileStoreRules :: VFSHandle -> Rules () -fileStoreRules vfs = do +fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules () +fileStoreRules vfs isWatched = do addIdeGlobal vfs - getModificationTimeRule vfs + getModificationTimeRule vfs isWatched getFileContentsRule vfs isFileOfInterestRule diff --git a/ghcide/src/Development/IDE/Core/Service.hs b/ghcide/src/Development/IDE/Core/Service.hs index ae30b0c587..87c6148446 100644 --- a/ghcide/src/Development/IDE/Core/Service.hs +++ b/ghcide/src/Development/IDE/Core/Service.hs @@ -20,7 +20,6 @@ module Development.IDE.Core.Service( import Development.IDE.Core.Debouncer import Development.IDE.Core.FileExists (fileExistsRules) -import Development.IDE.Core.FileStore (fileStoreRules) import Development.IDE.Core.OfInterest import Development.IDE.Types.Logger as Logger import Development.IDE.Types.Options (IdeOptions (..)) @@ -62,7 +61,6 @@ initialise defaultConfig mainRule lspEnv logger debouncer options vfs hiedb hied (optShakeOptions options) $ do addIdeGlobal $ GlobalIdeOptions options - fileStoreRules vfs ofInterestRules fileExistsRules lspEnv vfs mainRule diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index 46d0ae5264..b6a7779fd6 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -24,16 +24,15 @@ import Development.IDE.Types.Logger import Development.IDE.Types.Options import Control.Monad.Extra -import Data.Foldable as F import qualified Data.HashMap.Strict as M import qualified Data.HashSet as S -import Data.Maybe import qualified Data.Text as Text import Control.Monad.IO.Class import Development.IDE.Core.FileExists (modifyFileExists, watchedGlobs) -import Development.IDE.Core.FileStore (setFileModified, +import Development.IDE.Core.FileStore (modifyFileStore, + setFileModified, setSomethingModified, typecheckParents) import Development.IDE.Core.OfInterest @@ -80,19 +79,13 @@ setHandlersNotifications = mconcat logDebug (ideLogger ide) $ "Closed text document: " <> getUri _uri , notificationHandler LSP.SWorkspaceDidChangeWatchedFiles $ - \ide (DidChangeWatchedFilesParams fileEvents) -> liftIO $ do + \ide (DidChangeWatchedFilesParams (List fileEvents)) -> liftIO $ do -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and -- what we do with them - let events = - mapMaybe - (\(FileEvent uri ev) -> - (, ev /= FcDeleted) . toNormalizedFilePath' - <$> LSP.uriToFilePath uri - ) - ( F.toList fileEvents ) - let msg = Text.pack $ show events + let msg = Text.pack $ show fileEvents logDebug (ideLogger ide) $ "Files created or deleted: " <> msg - modifyFileExists ide events + modifyFileExists ide fileEvents + modifyFileStore ide fileEvents setSomethingModified ide , notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ From c0487a90ef224a0254b64f588b92dcd27212fd8e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 3 Mar 2021 08:48:03 +0000 Subject: [PATCH 3/6] enable shake profiling in tests via SHAKE_PROFILING env var --- ghcide/test/exe/Main.hs | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index ab5a2a4387..852bcd992d 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -1559,14 +1559,14 @@ suggestImportTests = testGroup "suggest import actions" , test True [] "f = (&) [] id" [] "import Data.Function ((&))" , test True [] "f = (.|.)" [] "import Data.Bits (Bits((.|.)))" , test True [] "f = (.|.)" [] "import Data.Bits ((.|.))" - , test True + , test True ["qualified Data.Text as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" ] "f = T.putStrLn" [] "import qualified Data.Text.IO as T" - , test True + , test True [ "qualified Data.Text as T" , "qualified Data.Function as T" , "qualified Data.Functor as T" @@ -5149,8 +5149,11 @@ runInDir' dir startExeIn startSessionIn extraOptions s = do -- since the package import test creates "Data/List.hs", which otherwise has no physical home createDirectoryIfMissing True $ projDir ++ "/Data" + shakeProfiling <- getEnv "SHAKE_PROFILING" let cmd = unwords $ - [ghcideExe, "--lsp", "--test", "--verbose", "-j2", "--cwd", startDir] ++ extraOptions + [ghcideExe, "--lsp", "--test", "--verbose", "-j2", "--cwd", startDir + ] ++ ["--shake-profiling=" <> dir | Just dir <- [shakeProfiling] + ] ++ extraOptions -- HIE calls getXgdDirectory which assumes that HOME is set. -- Only sets HOME if it wasn't already set. setEnv "HOME" "/homeless-shelter" False From 4b562607fafc6c726feee8a95ba2d963cc740ccd Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Wed, 3 Mar 2021 22:27:00 +0000 Subject: [PATCH 4/6] log FileChanged events --- ghcide/src/Development/IDE/LSP/Notifications.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index b6a7779fd6..e00e662f44 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -83,7 +83,7 @@ setHandlersNotifications = mconcat -- See Note [File existence cache and LSP file watchers] which explains why we get these notifications and -- what we do with them let msg = Text.pack $ show fileEvents - logDebug (ideLogger ide) $ "Files created or deleted: " <> msg + logDebug (ideLogger ide) $ "Watched file events: " <> msg modifyFileExists ide fileEvents modifyFileStore ide fileEvents setSomethingModified ide From 2b6338eb2c8c0ed0d67bf2a4fe4760c40a10de10 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Fri, 5 Mar 2021 21:23:27 +0000 Subject: [PATCH 5/6] rename and avoid resetting FOIs --- ghcide/src/Development/IDE/Core/FileStore.hs | 19 ++++++++++++------- ghcide/src/Development/IDE/Core/OfInterest.hs | 3 ++- .../src/Development/IDE/LSP/Notifications.hs | 4 ++-- 3 files changed, 16 insertions(+), 10 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 7ff7325cd1..3dc4fc1b59 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -15,7 +15,7 @@ module Development.IDE.Core.FileStore( makeVFSHandle, makeLSPVFSHandle, isFileOfInterestRule - ,modifyFileStore) where + ,resetFileStore) where import Control.Concurrent.Extra import Control.Concurrent.STM (atomically) @@ -31,7 +31,7 @@ import Data.Maybe import qualified Data.Rope.UTF16 as Rope import qualified Data.Text as T import Data.Time -import Development.IDE.Core.OfInterest (getFilesOfInterest) +import Development.IDE.Core.OfInterest (getFilesOfInterest, OfInterestVar(..)) import Development.IDE.Core.RuleTypes import Development.IDE.Core.Shake import Development.IDE.GHC.Orphans () @@ -65,7 +65,7 @@ import Language.LSP.Server hiding import qualified Language.LSP.Server as LSP import Language.LSP.Types (FileChangeType (FcChanged), FileEvent (FileEvent), - uriToFilePath) + uriToFilePath, toNormalizedFilePath) import Language.LSP.VFS makeVFSHandle :: IO VFSHandle @@ -119,15 +119,20 @@ getModificationTimeRule vfs isWatched = else return (Nothing, ([diag], Nothing)) -- | Reset the GetModificationTime state of watched files -modifyFileStore :: IdeState -> [FileEvent] -> IO () -modifyFileStore state changes = mask $ \_ -> +resetFileStore :: IdeState -> [FileEvent] -> IO () +resetFileStore ideState changes = mask $ \_ -> forM_ changes $ \(FileEvent uri c) -> case c of FcChanged | Just f <- uriToFilePath uri -> do - deleteValue state (GetModificationTime_ True) (toNormalizedFilePath' f) - deleteValue state (GetModificationTime_ False) (toNormalizedFilePath' f) + -- we record FOIs document versions in all the stored values + -- so NEVER reset FOIs to avoid losing their versions + OfInterestVar foisVar <- getIdeGlobalExtras (shakeExtras ideState) + fois <- readVar foisVar + unless (HM.member (toNormalizedFilePath f) fois) $ do + deleteValue ideState (GetModificationTime_ True) (toNormalizedFilePath' f) + deleteValue ideState (GetModificationTime_ False) (toNormalizedFilePath' f) _ -> pure () -- Dir.getModificationTime is surprisingly slow since it performs diff --git a/ghcide/src/Development/IDE/Core/OfInterest.hs b/ghcide/src/Development/IDE/Core/OfInterest.hs index b39b5b2204..84c3774e86 100644 --- a/ghcide/src/Development/IDE/Core/OfInterest.hs +++ b/ghcide/src/Development/IDE/Core/OfInterest.hs @@ -9,7 +9,8 @@ module Development.IDE.Core.OfInterest( ofInterestRules, getFilesOfInterest, setFilesOfInterest, modifyFilesOfInterest, - kick, FileOfInterestStatus(..) + kick, FileOfInterestStatus(..), + OfInterestVar(..) ) where import Control.Concurrent.Extra diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index e00e662f44..ccdcbacab6 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -31,7 +31,7 @@ import qualified Data.Text as Text import Control.Monad.IO.Class import Development.IDE.Core.FileExists (modifyFileExists, watchedGlobs) -import Development.IDE.Core.FileStore (modifyFileStore, +import Development.IDE.Core.FileStore (resetFileStore, setFileModified, setSomethingModified, typecheckParents) @@ -85,7 +85,7 @@ setHandlersNotifications = mconcat let msg = Text.pack $ show fileEvents logDebug (ideLogger ide) $ "Watched file events: " <> msg modifyFileExists ide fileEvents - modifyFileStore ide fileEvents + resetFileStore ide fileEvents setSomethingModified ide , notificationHandler LSP.SWorkspaceDidChangeWorkspaceFolders $ From 78f2ca9bb781c0f2f4dd09e78661cf910337f51e Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sat, 6 Mar 2021 08:28:45 +0000 Subject: [PATCH 6/6] Make IsFileOfInterest dependency explicit --- ghcide/src/Development/IDE/Core/FileStore.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 3dc4fc1b59..a05210bdf2 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -102,6 +102,9 @@ getModificationTimeRule vfs isWatched = let file' = fromNormalizedFilePath file let wrap time@(l,s) = (Just $ BS.pack $ show time, ([], Just $ ModificationTime l s)) mbVirtual <- liftIO $ getVirtualFile vfs $ filePathToUri' file + -- we use 'getVirtualFile' to discriminate FOIs so make that + -- dependency explicit by using the IsFileOfInterest rule + _ <- use_ IsFileOfInterest file case mbVirtual of Just (virtualFileVersion -> ver) -> do alwaysRerun