Skip to content

Reload .cabal files when they are modified #4630

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
31 changes: 29 additions & 2 deletions ghcide/src/Development/IDE/Core/FileStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -78,7 +78,6 @@ import System.FilePath
import System.IO.Error
import System.IO.Unsafe


data Log
= LogCouldNotIdentifyReverseDeps !NormalizedFilePath
| LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath])
Expand Down Expand Up @@ -147,6 +146,29 @@ getModificationTimeImpl missingFileDiags file = do
then return (Nothing, ([], Nothing))
else return (Nothing, ([diag], Nothing))


getPhysicalModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
getPhysicalModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetPhysicalModificationTime file ->
getPhysicalModificationTimeImpl file

getPhysicalModificationTimeImpl
:: NormalizedFilePath
-> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
getPhysicalModificationTimeImpl file = do
let file' = fromNormalizedFilePath file
let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))

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
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.
Expand All @@ -170,7 +192,11 @@ resetFileStore ideState changes = mask $ \_ -> do
case c of
LSP.FileChangeType_Changed
-- already checked elsewhere | not $ HM.member nfp fois
-> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp
->
atomically $ do
ks <- deleteValue (shakeExtras ideState) GetModificationTime nfp
vs <- deleteValue (shakeExtras ideState) GetPhysicalModificationTime nfp
pure $ ks ++ vs
_ -> pure []


Expand Down Expand Up @@ -233,6 +259,7 @@ getVersionedTextDoc doc = do
fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
fileStoreRules recorder isWatched = do
getModificationTimeRule recorder
getPhysicalModificationTimeRule recorder
getFileContentsRule recorder
addWatchedFileRule recorder isWatched

Expand Down
8 changes: 8 additions & 0 deletions ghcide/src/Development/IDE/Core/RuleTypes.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
Expand Down Expand Up @@ -316,6 +317,13 @@ instance Hashable GetModificationTime where

instance NFData GetModificationTime

data GetPhysicalModificationTime = GetPhysicalModificationTime
deriving (Generic, Show, Eq)
deriving anyclass (Hashable, NFData)

-- | Get the modification time of a file on disk, ignoring any version in the VFS.
type instance RuleResult GetPhysicalModificationTime = FileVersion

pattern GetModificationTime :: GetModificationTime
pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}

Expand Down
9 changes: 8 additions & 1 deletion ghcide/src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -181,6 +181,7 @@
| LogLoadingHieFileFail !FilePath !SomeException
| LogLoadingHieFileSuccess !FilePath
| LogTypecheckedFOI !NormalizedFilePath
| LogDependencies !NormalizedFilePath [FilePath]
deriving Show

instance Pretty Log where
Expand All @@ -205,6 +206,11 @@
<+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"
<+> "triggered this warning."
]
LogDependencies nfp deps ->
vcat
[ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)
, nest 2 $ pretty deps
]

templateHaskellInstructions :: T.Text
templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"
Expand Down Expand Up @@ -715,7 +721,8 @@
let nfp = toNormalizedFilePath' fp
itExists <- getFileExists nfp
when itExists $ void $ do
use_ GetModificationTime nfp
use_ GetPhysicalModificationTime nfp
logWith recorder Logger.Info $ LogDependencies file deps
mapM_ addDependency deps

let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))
Expand Down Expand Up @@ -802,7 +809,7 @@
{ source_version = ver
, old_value = m_old
, get_file_version = use GetModificationTime_{missingFileDiagnostics = False}
, get_linkable_hashes = \fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs

Check warning on line 812 in ghcide/src/Development/IDE/Core/Rules.hs

View workflow job for this annotation

GitHub Actions / Hlint check run

Suggestion in getModIfaceFromDiskRule in module Development.IDE.Core.Rules: Use fmap ▫︎ Found: "\\ fs -> map (snd . fromJust . hirCoreFp) <$> uses_ GetModIface fs" ▫︎ Perhaps: "fmap (map (snd . fromJust . hirCoreFp)) . uses_ GetModIface"
, get_module_graph = useWithSeparateFingerprintRule_ GetModuleGraphTransDepsFingerprints GetModuleGraph f
, regenerate = regenerateHiFile session f ms
}
Expand Down
10 changes: 9 additions & 1 deletion plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE TypeFamilies #-}

module Ide.Plugin.Cabal (descriptor, haskellInteractionDescriptor, Log (..)) where
Expand Down Expand Up @@ -154,7 +155,7 @@ descriptor recorder plId =
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
whenUriFile _uri $ \file -> do
log' Debug $ LogDocSaved _uri
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
restartCabalShakeSessionPhysical (shakeExtras ide) vfs file "(saved)" $
addFileOfInterest recorder ide file OnDisk
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
Expand Down Expand Up @@ -188,6 +189,13 @@ restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = d
keys <- actionBetweenSession
return (toKey GetModificationTime file:keys)


restartCabalShakeSessionPhysical :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
restartCabalShakeSessionPhysical shakeExtras vfs file actionMsg actionBetweenSession = do
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
keys <- actionBetweenSession
return (toKey GetModificationTime file:toKey GetPhysicalModificationTime file:keys)

-- ----------------------------------------------------------------
-- Plugin Rules
-- ----------------------------------------------------------------
Expand Down
Loading