From 9a782b7877da571ba589f7e0fd49ac8a413b7e03 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Sun, 30 May 2021 09:39:02 +0100 Subject: [PATCH 1/4] Use file watches for all workspace files --- ghcide/src/Development/IDE/Core/FileExists.hs | 27 ++-- ghcide/src/Development/IDE/Core/FileStore.hs | 131 +++++++++++++----- ghcide/src/Development/IDE/Core/RuleTypes.hs | 8 ++ .../src/Development/IDE/LSP/Notifications.hs | 48 ++----- ghcide/test/exe/Main.hs | 24 ++-- 5 files changed, 141 insertions(+), 97 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index fcb3c71389..39691c526c 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -17,6 +17,7 @@ import Control.Monad.IO.Class import qualified Data.ByteString as BS import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap +import Data.List (partition) import Data.Maybe import Development.IDE.Core.FileStore import Development.IDE.Core.IdeConfiguration @@ -25,9 +26,9 @@ import Development.IDE.Core.Shake import Development.IDE.Graph import Development.IDE.Types.Location import Development.IDE.Types.Options +import Ide.Plugin.Config (Config) import Language.LSP.Server hiding (getVirtualFile) import Language.LSP.Types -import Language.LSP.Types.Capabilities import qualified System.Directory as Dir import qualified System.FilePath.Glob as Glob @@ -91,22 +92,23 @@ modifyFileExists :: IdeState -> [FileEvent] -> IO () modifyFileExists state changes = do FileExistsMapVar var <- getIdeGlobalState state changesMap <- evaluate $ HashMap.fromList $ - [ (toNormalizedFilePath' f, newState) + [ (toNormalizedFilePath' f, change) | 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 - void $ modifyVar' var $ HashMap.union changesMap + void $ modifyVar' var $ HashMap.union (HashMap.mapMaybe fromChange changesMap) -- See Note [Invalidating file existence results] -- flush previous values - mapM_ (deleteValue (shakeExtras state) GetFileExists) (HashMap.keys changesMap) + let (_fileModifChanges, fileExistChanges) = + partition ((== FcChanged) . snd) (HashMap.toList changesMap) + mapM_ (deleteValue (shakeExtras state) GetFileExists . fst) fileExistChanges fromChange :: FileChangeType -> Maybe Bool fromChange FcCreated = Just True -fromChange FcDeleted = Just True +fromChange FcDeleted = Just False fromChange FcChanged = Nothing ------------------------------------------------------------------------------------- @@ -153,18 +155,11 @@ 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 :: Maybe (LanguageContextEnv c) -> VFSHandle -> Rules () +fileExistsRules :: Maybe (LanguageContextEnv Config) -> VFSHandle -> Rules () fileExistsRules lspEnv vfs = do supportsWatchedFiles <- case lspEnv of - Just lspEnv' -> liftIO $ runLspT lspEnv' $ do - ClientCapabilities {_workspace} <- getClientCapabilities - case () of - _ | Just WorkspaceClientCapabilities{_didChangeWatchedFiles} <- _workspace - , Just DidChangeWatchedFilesClientCapabilities{_dynamicRegistration} <- _didChangeWatchedFiles - , Just True <- _dynamicRegistration - -> pure True - _ -> pure False - Nothing -> pure False + Nothing -> pure False + Just lspEnv' -> liftIO $ runLspT lspEnv' isWatchSupported -- Create the global always, although it should only be used if we have fast rules. -- But there's a chance someone will send unexpected notifications anyway, -- e.g. https://github.com/haskell/ghcide/issues/599 diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 793fc011e7..420043cf5d 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -20,7 +20,9 @@ module Development.IDE.Core.FileStore( getModificationTimeImpl, addIdeGlobal, getFileContentsImpl, - getModTime + getModTime, + isWatchSupported, + registerFileWatches ) where import Control.Concurrent.STM (atomically) @@ -49,7 +51,8 @@ import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location import Development.IDE.Types.Options import HieDb.Create (deleteMissingRealFiles) -import Ide.Plugin.Config (CheckParents (..)) +import Ide.Plugin.Config (CheckParents (..), + Config) import System.IO.Error #ifdef mingw32_HOST_OS @@ -63,13 +66,20 @@ import qualified Development.IDE.Types.Logger as L import qualified Data.Binary as B import qualified Data.ByteString.Lazy as LBS +import qualified Data.Text as Text import Language.LSP.Server hiding (getVirtualFile) import qualified Language.LSP.Server as LSP -import Language.LSP.Types (FileChangeType (FcChanged), +import Language.LSP.Types (DidChangeWatchedFilesRegistrationOptions (DidChangeWatchedFilesRegistrationOptions), + FileChangeType (FcChanged), FileEvent (FileEvent), + FileSystemWatcher (..), + WatchKind (..), + _watchers, toNormalizedFilePath, uriToFilePath) +import qualified Language.LSP.Types as LSP +import qualified Language.LSP.Types.Capabilities as LSP import Language.LSP.VFS import System.FilePath @@ -94,6 +104,15 @@ makeLSPVFSHandle lspEnv = VFSHandle , setVirtualFileContents = Nothing } +addWatchedFileRule :: (NormalizedFilePath -> Action Bool) -> Rules () +addWatchedFileRule isWatched = defineNoDiagnostics $ \AddWatchedFile f -> do + isAlreadyWatched <- isWatched f + if isAlreadyWatched then pure (Just True) else do + ShakeExtras{lspEnv} <- getShakeExtras + case lspEnv of + Just env -> fmap Just $ liftIO $ LSP.runLspT env $ + registerFileWatches [fromNormalizedFilePath f] + Nothing -> pure Nothing isFileOfInterestRule :: Rules () isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do @@ -109,45 +128,44 @@ isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest summarize (IsFOI (Modified True)) = BS.singleton 3 -getModificationTimeRule :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules () -getModificationTimeRule vfs isWatched = defineEarlyCutoff $ Rule $ \(GetModificationTime_ missingFileDiags) file -> - getModificationTimeImpl vfs isWatched missingFileDiags file +getModificationTimeRule :: VFSHandle -> Rules () +getModificationTimeRule vfs = defineEarlyCutoff $ Rule $ \(GetModificationTime_ missingFileDiags) file -> + getModificationTimeImpl vfs missingFileDiags file getModificationTimeImpl :: VFSHandle - -> (NormalizedFilePath -> Action Bool) -> Bool -> NormalizedFilePath -> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion)) -getModificationTimeImpl vfs isWatched 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 - Just (virtualFileVersion -> ver) -> do - alwaysRerun - pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver)) - Nothing -> do - isWF <- isWatched file - if isWF - then -- the file is watched so we can rely on FileWatched notifications, - -- but also need a dependency on IsFileOfInterest to reinstall - -- alwaysRerun when the file becomes VFS - void (use_ IsFileOfInterest file) - else if isInterface file - then -- interface files are tracked specially using the closed world assumption - pure () - else -- in all other cases we will need to freshly check the file system - alwaysRerun +getModificationTimeImpl vfs 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 + Just (virtualFileVersion -> ver) -> do + alwaysRerun + pure (Just $ LBS.toStrict $ B.encode ver, ([], Just $ VFSVersion ver)) + Nothing -> do + isWF <- use_ AddWatchedFile file + if isWF + then -- the file is watched so we can rely on FileWatched notifications, + -- but also need a dependency on IsFileOfInterest to reinstall + -- alwaysRerun when the file becomes VFS + void (use_ IsFileOfInterest file) + else if isInterface file + then -- interface files are tracked specially using the closed world assumption + pure () + else -- in all other cases we will need to freshly check the file system + 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)) + 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)) -- | Interface files cannot be watched, since they live outside the workspace. -- But interface files are private, in that only HLS writes them. @@ -239,9 +257,10 @@ getFileContents f = do fileStoreRules :: VFSHandle -> (NormalizedFilePath -> Action Bool) -> Rules () fileStoreRules vfs isWatched = do addIdeGlobal vfs - getModificationTimeRule vfs isWatched + getModificationTimeRule vfs getFileContentsRule vfs isFileOfInterestRule + addWatchedFileRule isWatched -- | Note that some buffer for a specific file has been modified but not -- with what changes. @@ -290,3 +309,43 @@ setSomethingModified state = do -- Update database to remove any files that might have been renamed/deleted atomically $ writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) deleteMissingRealFiles void $ shakeRestart state [] + +registerFileWatches :: [String] -> LSP.LspT Config IO Bool +registerFileWatches globs = do + watchSupported <- isWatchSupported + if watchSupported + then do + let + regParams = LSP.RegistrationParams (List [LSP.SomeRegistration registration]) + -- The registration ID is arbitrary and is only used in case we want to deregister (which we won't). + -- We could also use something like a random UUID, as some other servers do, but this works for + -- our purposes. + registration = LSP.Registration "globalFileWatches" + LSP.SWorkspaceDidChangeWatchedFiles + regOptions + 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 = 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'. + watcher glob = FileSystemWatcher { _globPattern = glob, _kind = Just watchKind } + -- We use multiple watchers instead of one using '{}' because lsp-test doesn't + -- support that: https://github.com/bubba/lsp-test/issues/77 + watchers = [ watcher (Text.pack glob) | glob <- globs ] + + void $ LSP.sendRequest LSP.SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response + return True + else return False + +isWatchSupported :: LSP.LspT Config IO Bool +isWatchSupported = do + clientCapabilities <- LSP.getClientCapabilities + pure $ case () of + _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities + , Just LSP.WorkspaceClientCapabilities{_didChangeWatchedFiles} <- _workspace + , Just LSP.DidChangeWatchedFilesClientCapabilities{_dynamicRegistration} <- _didChangeWatchedFiles + , Just True <- _dynamicRegistration + -> True + | otherwise -> False diff --git a/ghcide/src/Development/IDE/Core/RuleTypes.hs b/ghcide/src/Development/IDE/Core/RuleTypes.hs index be6e4e3a02..26e0cae3af 100644 --- a/ghcide/src/Development/IDE/Core/RuleTypes.hs +++ b/ghcide/src/Development/IDE/Core/RuleTypes.hs @@ -267,6 +267,8 @@ type instance RuleResult GetFileContents = (FileVersion, Maybe Text) type instance RuleResult GetFileExists = Bool +type instance RuleResult AddWatchedFile = Bool + -- The Shake key type for getModificationTime queries newtype GetModificationTime = GetModificationTime_ @@ -493,6 +495,12 @@ instance Binary GetClientSettings type instance RuleResult GetClientSettings = Hashed (Maybe Value) +data AddWatchedFile = AddWatchedFile deriving (Eq, Show, Typeable, Generic) +instance Hashable AddWatchedFile +instance NFData AddWatchedFile +instance Binary AddWatchedFile + + -- A local rule type to get caching. We want to use newCache, but it has -- thread killed exception issues, so we lift it to a full rule. -- https://github.com/digital-asset/daml/pull/2808#issuecomment-529639547 diff --git a/ghcide/src/Development/IDE/LSP/Notifications.hs b/ghcide/src/Development/IDE/LSP/Notifications.hs index c029a86751..14f9b346de 100644 --- a/ghcide/src/Development/IDE/LSP/Notifications.hs +++ b/ghcide/src/Development/IDE/LSP/Notifications.hs @@ -11,10 +11,8 @@ module Development.IDE.LSP.Notifications , descriptor ) where -import qualified Language.LSP.Server as LSP import Language.LSP.Types import qualified Language.LSP.Types as LSP -import qualified Language.LSP.Types.Capabilities as LSP import Development.IDE.Core.IdeConfiguration import Development.IDE.Core.Service @@ -31,7 +29,8 @@ import qualified Data.Text as Text import Control.Monad.IO.Class import Development.IDE.Core.FileExists (modifyFileExists, watchedGlobs) -import Development.IDE.Core.FileStore (resetFileStore, +import Development.IDE.Core.FileStore (registerFileWatches, + resetFileStore, setFileModified, setSomethingModified, typecheckParents) @@ -108,38 +107,15 @@ descriptor plId = (defaultPluginDescriptor plId) { pluginNotificationHandlers = liftIO $ shakeSessionInit ide --------- Set up file watchers ------------------------------------------------------------------------ - clientCapabilities <- LSP.getClientCapabilities - let watchSupported = case () of - _ | LSP.ClientCapabilities{_workspace} <- clientCapabilities - , Just LSP.WorkspaceClientCapabilities{_didChangeWatchedFiles} <- _workspace - , Just LSP.DidChangeWatchedFilesClientCapabilities{_dynamicRegistration} <- _didChangeWatchedFiles - , Just True <- _dynamicRegistration - -> True - | otherwise -> False - if watchSupported - then do - opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide - let - regParams = RegistrationParams (List [SomeRegistration registration]) - -- The registration ID is arbitrary and is only used in case we want to deregister (which we won't). - -- We could also use something like a random UUID, as some other servers do, but this works for - -- our purposes. - registration = Registration "globalFileWatches" - SWorkspaceDidChangeWatchedFiles - regOptions - 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 = 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'. - watcher glob = FileSystemWatcher { _globPattern = glob, _kind = Just watchKind } - -- We use multiple watchers instead of one using '{}' because lsp-test doesn't - -- support that: https://github.com/bubba/lsp-test/issues/77 - watchers = [ watcher (Text.pack glob) | glob <- watchedGlobs opts ] - - void $ LSP.sendRequest SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response - else liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling" + opts <- liftIO $ getIdeOptionsIO $ shakeExtras ide + -- 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'. + -- We use multiple watchers instead of one using '{}' because lsp-test doesn't + -- support that: https://github.com/bubba/lsp-test/issues/77 + let globs = watchedGlobs opts + success <- registerFileWatches globs + unless success $ + liftIO $ logDebug (ideLogger ide) "Warning: Client does not support watched files. Falling back to OS polling" ] } diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index e8f8a8bcee..55e0127c96 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -763,8 +763,8 @@ watchedFilesTests = testGroup "watched files" _doc <- createDoc "A.hs" "haskell" "{-#LANGUAGE NoImplicitPrelude #-}\nmodule A where\nimport WatchedFilesMissingModule" watchedFileRegs <- getWatchedFilesSubscriptionsUntil STextDocumentPublishDiagnostics - -- Expect 1 subscription: we only ever send one - liftIO $ length watchedFileRegs @?= 1 + -- Expect 2 subscriptions: one for all .hs files and one for the hie.yaml cradle + liftIO $ length watchedFileRegs @?= 2 , testSession' "non workspace file" $ \sessionDir -> do tmpDir <- liftIO getTemporaryDirectory @@ -772,8 +772,8 @@ watchedFilesTests = testGroup "watched files" _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule" watchedFileRegs <- getWatchedFilesSubscriptionsUntil STextDocumentPublishDiagnostics - -- Expect 1 subscription: we only ever send one - liftIO $ length watchedFileRegs @?= 1 + -- Expect 2 subscriptions: one for all .hs files and one for the hie.yaml cradle + liftIO $ length watchedFileRegs @?= 2 -- TODO add a test for didChangeWorkspaceFolder ] @@ -4733,7 +4733,8 @@ dependentFileTest = testGroup "addDependentFile" test dir = do -- If the file contains B then no type error -- otherwise type error - liftIO $ writeFile (dir "dep-file.txt") "A" + let depFilePath = dir "dep-file.txt" + liftIO $ writeFile depFilePath "A" let fooContent = T.unlines [ "{-# LANGUAGE TemplateHaskell #-}" , "module Foo where" @@ -4745,18 +4746,21 @@ dependentFileTest = testGroup "addDependentFile" , " if f == \"B\" then [| 1 |] else lift f)" ] let bazContent = T.unlines ["module Baz where", "import Foo ()"] - _ <-createDoc "Foo.hs" "haskell" fooContent + _ <- createDoc "Foo.hs" "haskell" fooContent doc <- createDoc "Baz.hs" "haskell" bazContent expectDiagnostics [("Foo.hs", [(DsError, (4, 6), "Couldn't match expected type")])] -- Now modify the dependent file - liftIO $ writeFile (dir "dep-file.txt") "B" + liftIO $ writeFile depFilePath "B" + sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $ + List [FileEvent (filePathToUri "dep-file.txt") FcChanged ] + + -- Modifying Baz will now trigger Foo to be rebuilt as well let change = TextDocumentContentChangeEvent { _range = Just (Range (Position 2 0) (Position 2 6)) , _rangeLength = Nothing , _text = "f = ()" } - -- Modifying Baz will now trigger Foo to be rebuilt as well changeDoc doc [change] expectDiagnostics [("Foo.hs", [])] @@ -5018,6 +5022,8 @@ sessionDepsArePickedUp = testSession' writeFileUTF8 (dir "hie.yaml") "cradle: {direct: {arguments: [-XOverloadedStrings]}}" + sendNotification SWorkspaceDidChangeWatchedFiles $ DidChangeWatchedFilesParams $ + List [FileEvent (filePathToUri $ dir "hie.yaml") FcChanged ] -- Send change event. let change = TextDocumentContentChangeEvent @@ -5049,7 +5055,7 @@ nonLspCommandLine = testGroup "ghcide command line" (ec, _, _) <- readCreateProcessWithExitCode cmd "" - ec @=? ExitSuccess + ec @?= ExitSuccess ] benchmarkTests :: TestTree From 700f2adf182f72801b917237ef6f305b6f60b5e8 Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 1 Jun 2021 11:27:14 +0100 Subject: [PATCH 2/4] Fix non LSP driver --- ghcide/src/Development/IDE/Core/FileStore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 420043cf5d..04e4756070 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -112,7 +112,7 @@ addWatchedFileRule isWatched = defineNoDiagnostics $ \AddWatchedFile f -> do case lspEnv of Just env -> fmap Just $ liftIO $ LSP.runLspT env $ registerFileWatches [fromNormalizedFilePath f] - Nothing -> pure Nothing + Nothing -> pure $ Just False isFileOfInterestRule :: Rules () isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do From 6417fd7984c8b690f8fac8e88837aac6cffeadcb Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 1 Jun 2021 17:36:31 +0100 Subject: [PATCH 3/4] handling of non workspace files --- ghcide/src/Development/IDE/Core/FileStore.hs | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index 04e4756070..774ce30629 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -67,6 +67,7 @@ import qualified Development.IDE.Types.Logger as L import qualified Data.Binary as B import qualified Data.ByteString.Lazy as LBS import qualified Data.Text as Text +import Development.IDE.Core.IdeConfiguration (isWorkspaceFile) import Language.LSP.Server hiding (getVirtualFile) import qualified Language.LSP.Server as LSP @@ -107,12 +108,14 @@ makeLSPVFSHandle lspEnv = VFSHandle addWatchedFileRule :: (NormalizedFilePath -> Action Bool) -> Rules () addWatchedFileRule isWatched = defineNoDiagnostics $ \AddWatchedFile f -> do isAlreadyWatched <- isWatched f - if isAlreadyWatched then pure (Just True) else do - ShakeExtras{lspEnv} <- getShakeExtras - case lspEnv of - Just env -> fmap Just $ liftIO $ LSP.runLspT env $ - registerFileWatches [fromNormalizedFilePath f] - Nothing -> pure $ Just False + isWp <- isWorkspaceFile f + if isAlreadyWatched then pure (Just True) else + if not isWp then pure (Just False) else do + ShakeExtras{lspEnv} <- getShakeExtras + case lspEnv of + Just env -> fmap Just $ liftIO $ LSP.runLspT env $ + registerFileWatches [fromNormalizedFilePath f] + Nothing -> pure $ Just False isFileOfInterestRule :: Rules () isFileOfInterestRule = defineEarlyCutoff $ RuleNoDiagnostics $ \IsFileOfInterest f -> do @@ -335,7 +338,7 @@ registerFileWatches globs = do -- support that: https://github.com/bubba/lsp-test/issues/77 watchers = [ watcher (Text.pack glob) | glob <- globs ] - void $ LSP.sendRequest LSP.SClientRegisterCapability regParams (const $ pure ()) -- TODO handle response + void $ LSP.sendRequest LSP.SClientRegisterCapability regParams (const $ pure ()) return True else return False From 1bc3aad14942455e0a831a7a8cf5d6f78d7df3df Mon Sep 17 00:00:00 2001 From: Pepe Iborra Date: Tue, 1 Jun 2021 21:22:25 +0100 Subject: [PATCH 4/4] fix yaml escaping in Windows test --- ghcide/test/exe/Main.hs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/ghcide/test/exe/Main.hs b/ghcide/test/exe/Main.hs index 55e0127c96..8ca24ef20e 100644 --- a/ghcide/test/exe/Main.hs +++ b/ghcide/test/exe/Main.hs @@ -768,7 +768,8 @@ watchedFilesTests = testGroup "watched files" , testSession' "non workspace file" $ \sessionDir -> do tmpDir <- liftIO getTemporaryDirectory - liftIO $ writeFile (sessionDir "hie.yaml") ("cradle: {direct: {arguments: [\"-i" <> tmpDir <> "\", \"A\", \"WatchedFilesMissingModule\"]}}") + let yaml = "cradle: {direct: {arguments: [\"-i" <> tail(init(show tmpDir)) <> "\", \"A\", \"WatchedFilesMissingModule\"]}}" + liftIO $ writeFile (sessionDir "hie.yaml") yaml _doc <- createDoc "A.hs" "haskell" "{-# LANGUAGE NoImplicitPrelude#-}\nmodule A where\nimport WatchedFilesMissingModule" watchedFileRegs <- getWatchedFilesSubscriptionsUntil STextDocumentPublishDiagnostics