Skip to content

Commit 6fc3646

Browse files
soulomoonsoulomoon
committed
some more fix up
1 parent fdbb7aa commit 6fc3646

File tree

5 files changed

+38
-19
lines changed

5 files changed

+38
-19
lines changed

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

Lines changed: 2 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -246,15 +246,13 @@ typecheckParentsAction recorder nfp = do
246246
-- | Note that some keys have been modified and restart the session
247247
-- Only valid if the virtual file system was initialised by LSP, as that
248248
-- independently tracks which files are modified.
249-
setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () -> IO ()
250-
setSomethingModified vfs state keys reason actionBetweenSession = do
249+
setSomethingModified :: VFSModified -> IdeState -> String -> IO () -> IO ()
250+
setSomethingModified vfs state reason actionBetweenSession = do
251251
-- Update database to remove any files that might have been renamed/deleted
252252
void $ restartShakeSession (shakeExtras state) vfs reason [] $ do
253253
actionBetweenSession
254254
atomically $ do
255255
writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
256-
modifyTVar' (dirtyKeys $ shakeExtras state) $ \x ->
257-
foldl' (flip insertKeySet) x keys
258256

259257
registerFileWatches :: [String] -> LSP.LspT Config IO Bool
260258
registerFileWatches globs = do

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

Lines changed: 10 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ module Development.IDE.Core.Shake(
5757
FileVersion(..),
5858
updatePositionMapping,
5959
updatePositionMappingHelper,
60-
deleteValue, recordDirtyKeys,
60+
deleteValue, recordDirtyKeys, recordDirtyKeySet,
6161
WithProgressFunc, WithIndefiniteProgressFunc,
6262
ProgressEvent(..),
6363
DelayedAction, mkDelayedAction,
@@ -579,6 +579,15 @@ recordDirtyKeys ShakeExtras{dirtyKeys} key file = do
579579
return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do
580580
addEvent (fromString $ unlines $ "dirty " <> show key : map fromNormalizedFilePath file)
581581

582+
recordDirtyKeySet
583+
:: ShakeExtras
584+
-> [Key]
585+
-> STM (IO ())
586+
recordDirtyKeySet ShakeExtras{dirtyKeys} keys = do
587+
modifyTVar' dirtyKeys $ \x -> foldl' (flip insertKeySet) x keys
588+
return $ withEventTrace "recordDirtyKeys" $ \addEvent -> do
589+
addEvent (fromString $ unlines $ "dirty " : map show keys)
590+
582591
-- | We return Nothing if the rule has not run and Just Failed if it has failed to produce a value.
583592
getValues ::
584593
forall k v.

‎ghcide/src/Development/IDE/LSP/Notifications.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -95,7 +95,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat
9595
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
9696
whenUriFile _uri $ \file -> do
9797
let msg = "Closed text document: " <> getUri _uri
98-
setSomethingModified (VFSModified vfs) ide [] (Text.unpack msg) $ do
98+
setSomethingModified (VFSModified vfs) ide (Text.unpack msg) $ do
9999
deleteFileOfInterest ide file
100100
scheduleGarbageCollection ide
101101
logWith recorder Debug $ LogClosedTextDocument _uri
@@ -116,7 +116,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat
116116
unless (null fileEvents') $ do
117117
let msg = show fileEvents'
118118
logWith recorder Debug $ LogWatchedFileEvents (Text.pack msg)
119-
setSomethingModified (VFSModified vfs) ide [] msg $ do
119+
setSomethingModified (VFSModified vfs) ide msg $ do
120120
modifyFileExists ide fileEvents'
121121
resetFileStore ide fileEvents'
122122

‎ghcide/src/Development/IDE/Main.hs

Lines changed: 9 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -18,8 +18,8 @@ import Control.Concurrent.STM.Stats (dumpSTMStats)
1818
import Control.Exception.Safe (SomeException,
1919
catchAny,
2020
displayException)
21-
import Control.Monad.Extra (concatMapM, unless,
22-
when)
21+
import Control.Monad.Extra (concatMapM, join,
22+
unless, when)
2323
import Control.Monad.IO.Class (liftIO)
2424
import qualified Data.Aeson as J
2525
import Data.Coerce (coerce)
@@ -56,6 +56,7 @@ import Development.IDE.Core.Service (initialise,
5656
import qualified Development.IDE.Core.Service as Service
5757
import Development.IDE.Core.Shake (IdeState (shakeExtras),
5858
IndexQueue,
59+
recordDirtyKeys,
5960
shakeSessionInit,
6061
uses)
6162
import qualified Development.IDE.Core.Shake as Shake
@@ -89,7 +90,8 @@ import Development.IDE.Types.Options (IdeGhcSession,
8990
optModifyDynFlags,
9091
optTesting)
9192
import Development.IDE.Types.Shake (WithHieDb, toKey)
92-
import GHC.Conc (getNumProcessors)
93+
import GHC.Conc (atomically,
94+
getNumProcessors)
9395
import GHC.IO.Encoding (setLocaleEncoding)
9496
import GHC.IO.Handle (hDuplicate)
9597
import HIE.Bios.Cradle (findCradle)
@@ -362,9 +364,10 @@ defaultMain recorder Arguments{..} = withHeapStats (cmapWithPrio LogHeapStats re
362364
Nothing -> pure ()
363365
Just ide -> liftIO $ do
364366
let msg = T.pack $ show cfg
365-
logWith recorder Debug $ LogConfigurationChange msg
366-
modifyClientSettings ide (const $ Just cfgObj)
367-
setSomethingModified Shake.VFSUnmodified ide [toKey Rules.GetClientSettings emptyFilePath] "config change" $ return ()
367+
setSomethingModified Shake.VFSUnmodified ide "config change" $ do
368+
logWith recorder Debug $ LogConfigurationChange msg
369+
modifyClientSettings ide (const $ Just cfgObj)
370+
join $ atomically $ recordDirtyKeys (shakeExtras ide) Rules.GetClientSettings [emptyFilePath]
368371

369372
runLanguageServer (cmapWithPrio LogLanguageServer recorder) options inH outH argsDefaultHlsConfig argsParseConfig onConfigChange setup
370373
dumpSTMStats

‎plugins/hls-eval-plugin/src/Ide/Plugin/Eval/CodeLens.hs

Lines changed: 15 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,8 +23,8 @@ import Control.Exception (bracket_, try)
2323
import qualified Control.Exception as E
2424
import Control.Lens (_1, _3, ix, (%~),
2525
(<&>), (^.))
26-
import Control.Monad (guard, void,
27-
when)
26+
import Control.Monad (guard, join,
27+
void, when)
2828
import Control.Monad.IO.Class (MonadIO (liftIO))
2929
import Control.Monad.Trans.Except (ExceptT (..),
3030
runExceptT)
@@ -47,7 +47,8 @@ import Development.IDE.Core.RuleTypes (LinkableResult (l
4747
NeedsCompilation (NeedsCompilation),
4848
TypeCheck (..),
4949
tmrTypechecked)
50-
import Development.IDE.Core.Shake (useNoFile_,
50+
import Development.IDE.Core.Shake (shakeExtras,
51+
useNoFile_,
5152
useWithStale_,
5253
use_, uses_)
5354
import Development.IDE.GHC.Compat hiding (typeKind,
@@ -84,15 +85,18 @@ import Development.IDE.Core.RuleTypes (GetLinkable (GetL
8485
GetModuleGraph (GetModuleGraph),
8586
GhcSessionDeps (GhcSessionDeps),
8687
ModSummaryResult (msrModSummary))
87-
import Development.IDE.Core.Shake (VFSModified (VFSUnmodified))
88+
import Development.IDE.Core.Shake (VFSModified (VFSUnmodified),
89+
recordDirtyKeys)
8890
import qualified Development.IDE.GHC.Compat.Core as Compat (InteractiveImport (IIModule))
8991
import qualified Development.IDE.GHC.Compat.Core as SrcLoc (HasSrcSpan (getLoc),
9092
unLoc)
9193
import Development.IDE.Types.HscEnvEq (HscEnvEq (hscEnv))
9294
import qualified GHC.LanguageExtensions.Type as LangExt (Extension (..))
9395

96+
import Control.Concurrent.STM.Stats (atomically)
9497
import Development.IDE.Core.FileStore (setSomethingModified)
9598
import Development.IDE.Core.PluginUtils
99+
import Development.IDE.Graph (ShakeOptions (shakeExtra))
96100
import Development.IDE.Types.Shake (toKey)
97101
import GHC.Types.SrcLoc (UnhelpfulSpanReason (UnhelpfulInteractive))
98102
import Ide.Logger (Priority (..),
@@ -211,8 +215,13 @@ runEvalCmd recorder plId st mtoken EvalParams{..} =
211215

212216
-- enable codegen for the module which we need to evaluate.
213217
final_hscEnv <- liftIO $ bracket_
214-
(setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ queueForEvaluation st nfp)
215-
(setSomethingModified VFSUnmodified st [toKey IsEvaluating nfp] "Eval" $ unqueueForEvaluation st nfp)
218+
(setSomethingModified VFSUnmodified st "Eval" $ do
219+
join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp]
220+
queueForEvaluation st nfp
221+
)
222+
(setSomethingModified VFSUnmodified st "Eval" $ do
223+
join $ atomically $ recordDirtyKeys (shakeExtras st) IsEvaluating [nfp]
224+
unqueueForEvaluation st nfp)
216225
(initialiseSessionForEval (needsQuickCheck tests) st nfp)
217226

218227
evalCfg <- liftIO $ runAction "eval: config" st $ getEvalConfig plId

0 commit comments

Comments
 (0)