diff --git a/ghcide/src/Development/IDE/Core/Compile.hs b/ghcide/src/Development/IDE/Core/Compile.hs index d016849953..55c0cc6c65 100644 --- a/ghcide/src/Development/IDE/Core/Compile.hs +++ b/ghcide/src/Development/IDE/Core/Compile.hs @@ -115,15 +115,12 @@ import Control.Concurrent.STM hiding (orElse) import Data.Aeson (toJSON) import Data.Binary import Data.Binary.Put -import Data.Bits (shiftR) import qualified Data.ByteString.Lazy as LBS import Data.Coerce import Data.Functor import qualified Data.HashMap.Strict as HashMap import Data.Tuple.Extra (dupe) import Data.Unique -import Data.Word -import Foreign.Marshal.Array (withArrayLen) import GHC.Fingerprint import qualified Language.LSP.Server as LSP import qualified Language.LSP.Types as LSP diff --git a/ghcide/src/Development/IDE/Core/FileExists.hs b/ghcide/src/Development/IDE/Core/FileExists.hs index 19ebf74904..13e094d9be 100644 --- a/ghcide/src/Development/IDE/Core/FileExists.hs +++ b/ghcide/src/Development/IDE/Core/FileExists.hs @@ -103,7 +103,7 @@ modifyFileExists state changes = do modifyVar_ var $ evaluate . HashMap.union changesMap -- See Note [Invalidating file existence results] -- flush previous values - mapM_ (deleteValue state GetFileExists) (HashMap.keys changesMap) + mapM_ (deleteValue (shakeExtras state) GetFileExists) (HashMap.keys changesMap) fromChange :: FileChangeType -> Maybe Bool fromChange FcCreated = Just True diff --git a/ghcide/src/Development/IDE/Core/FileStore.hs b/ghcide/src/Development/IDE/Core/FileStore.hs index a05210bdf2..8637dc489d 100644 --- a/ghcide/src/Development/IDE/Core/FileStore.hs +++ b/ghcide/src/Development/IDE/Core/FileStore.hs @@ -15,7 +15,9 @@ module Development.IDE.Core.FileStore( makeVFSHandle, makeLSPVFSHandle, isFileOfInterestRule - ,resetFileStore) where + ,resetFileStore + ,resetInterfaceStore + ) where import Control.Concurrent.Extra import Control.Concurrent.STM (atomically) @@ -67,6 +69,7 @@ import Language.LSP.Types (FileChangeType (F FileEvent (FileEvent), uriToFilePath, toNormalizedFilePath) import Language.LSP.VFS +import System.FilePath makeVFSHandle :: IO VFSHandle makeVFSHandle = do @@ -111,7 +114,7 @@ getModificationTimeRule vfs isWatched = pure (Just $ BS.pack $ show ver, ([], Just $ VFSVersion ver)) Nothing -> do isWF <- isWatched file - unless isWF alwaysRerun + unless (isWF || isInterface file) alwaysRerun liftIO $ fmap wrap (getModTime file') `catch` \(e :: IOException) -> do let err | isDoesNotExistError e = "File does not exist: " ++ file' @@ -121,6 +124,18 @@ getModificationTimeRule vfs isWatched = 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. +-- So we implement watching ourselves, and bypass the need for alwaysRerun. +isInterface :: NormalizedFilePath -> Bool +isInterface f = takeExtension (fromNormalizedFilePath f) `elem` [".hi", ".hi-boot"] + +-- | Reset the GetModificationTime state of interface files +resetInterfaceStore :: ShakeExtras -> NormalizedFilePath -> IO () +resetInterfaceStore state f = do + deleteValue state (GetModificationTime_ True) f + deleteValue state (GetModificationTime_ False) f + -- | Reset the GetModificationTime state of watched files resetFileStore :: IdeState -> [FileEvent] -> IO () resetFileStore ideState changes = mask $ \_ -> @@ -134,8 +149,8 @@ resetFileStore ideState changes = mask $ \_ -> 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) + deleteValue (shakeExtras ideState) (GetModificationTime_ True) (toNormalizedFilePath' f) + deleteValue (shakeExtras ideState) (GetModificationTime_ False) (toNormalizedFilePath' f) _ -> pure () -- Dir.getModificationTime is surprisingly slow since it performs diff --git a/ghcide/src/Development/IDE/Core/Rules.hs b/ghcide/src/Development/IDE/Core/Rules.hs index adeb4b473b..933a3ed9b2 100644 --- a/ghcide/src/Development/IDE/Core/Rules.hs +++ b/ghcide/src/Development/IDE/Core/Rules.hs @@ -86,7 +86,7 @@ import Data.Tuple.Extra import Development.IDE.Core.Compile import Development.IDE.Core.FileExists import Development.IDE.Core.FileStore (getFileContents, - modificationTime) + modificationTime, resetInterfaceStore) import Development.IDE.Core.OfInterest import Development.IDE.Core.PositionMapping import Development.IDE.Core.RuleTypes @@ -922,7 +922,7 @@ getModIfaceRule = defineEarlyCutoff $ \GetModIface f -> do hiDiags <- case hiFile of Just hiFile | OnDisk <- status - , not (tmrDeferedError tmr) -> liftIO $ writeHiFile hsc hiFile + , not (tmrDeferedError tmr) -> writeHiFileAction hsc hiFile _ -> pure [] return (fp, (diags++hiDiags, hiFile)) NotFOI -> do @@ -991,7 +991,7 @@ regenerateHiFile sess f ms compNeeded = do -- We don't write the `.hi` file if there are defered errors, since we won't get -- accurate diagnostics next time if we do hiDiags <- if not $ tmrDeferedError tmr - then liftIO $ writeHiFile hsc hiFile + then writeHiFileAction hsc hiFile else pure [] pure (hiDiags <> gDiags <> concat wDiags) @@ -1090,6 +1090,14 @@ needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do newtype CompiledLinkables = CompiledLinkables { getCompiledLinkables :: Var (ModuleEnv UTCTime) } instance IsIdeGlobal CompiledLinkables +writeHiFileAction :: HscEnv -> HiFileResult -> Action [FileDiagnostic] +writeHiFileAction hsc hiFile = do + extras <- getShakeExtras + let targetPath = ml_hi_file $ ms_location $ hirModSummary hiFile + liftIO $ do + resetInterfaceStore extras $ toNormalizedFilePath' targetPath + writeHiFile hsc hiFile + -- | A rule that wires per-file rules together mainRule :: Rules () mainRule = do diff --git a/ghcide/src/Development/IDE/Core/Shake.hs b/ghcide/src/Development/IDE/Core/Shake.hs index a9c190ed1e..208293310d 100644 --- a/ghcide/src/Development/IDE/Core/Shake.hs +++ b/ghcide/src/Development/IDE/Core/Shake.hs @@ -420,11 +420,11 @@ setValues state key file val diags = modifyVar_ state $ \vals -> do -- | Delete the value stored for a given ide build key deleteValue :: (Typeable k, Hashable k, Eq k, Show k) - => IdeState + => ShakeExtras -> k -> NormalizedFilePath -> IO () -deleteValue IdeState{shakeExtras = ShakeExtras{state}} key file = modifyVar_ state $ \vals -> +deleteValue ShakeExtras{state} key file = modifyVar_ state $ \vals -> evaluate $ HMap.delete (file, Key key) vals -- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value. diff --git a/ghcide/src/Development/IDE/LSP/LanguageServer.hs b/ghcide/src/Development/IDE/LSP/LanguageServer.hs index a40715bcc1..df9c12264b 100644 --- a/ghcide/src/Development/IDE/LSP/LanguageServer.hs +++ b/ghcide/src/Development/IDE/LSP/LanguageServer.hs @@ -200,7 +200,11 @@ cancelHandler cancelRequest = LSP.notificationHandler SCancelRequest $ \Notifica liftIO $ cancelRequest (SomeLspId _id) exitHandler :: IO () -> LSP.Handlers (ServerM c) -exitHandler exit = LSP.notificationHandler SExit (const $ liftIO exit) +exitHandler exit = LSP.notificationHandler SExit $ const $ do + (_, ide) <- ask + -- flush out the Shake session to record a Shake profile if applicable + liftIO $ restartShakeSession (shakeExtras ide) [] + liftIO exit modifyOptions :: LSP.Options -> LSP.Options modifyOptions x = x{ LSP.textDocumentSync = Just $ tweakTDS origTDS