Skip to content

Commit 5d09837

Browse files
soulomoonsoulomoon
committed
send actions to run between restart
1 parent 684a850 commit 5d09837

File tree

5 files changed

+48
-49
lines changed

5 files changed

+48
-49
lines changed

‎ghcide/session-loader/Development/IDE/Session.hs

Lines changed: 8 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -611,19 +611,15 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} dir = do
611611
[ "No cradle target found. Is this file listed in the targets of your cradle?"
612612
, "If you are using a .cabal file, please ensure that this module is listed in either the exposed-modules or other-modules section"
613613
]
614-
615-
void $ modifyVar' fileToFlags $
616-
Map.insert hieYaml this_flags_map
617-
void $ modifyVar' filesMap $
618-
flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets))
619-
620-
void $ extendKnownTargets all_targets
621-
622-
-- Invalidate all the existing GhcSession build nodes by restarting the Shake session
623-
invalidateShakeCache
624-
625614
-- The VFS doesn't change on cradle edits, re-use the old one.
626-
restartShakeSession VFSUnmodified "new component" [] []
615+
restartShakeSession VFSUnmodified "new component" [] $ do
616+
void $ modifyVar' fileToFlags $
617+
Map.insert hieYaml this_flags_map
618+
void $ modifyVar' filesMap $
619+
flip HM.union (HM.fromList (map ((,hieYaml) . fst) $ concatMap toFlagsMap all_targets))
620+
void $ extendKnownTargets all_targets
621+
-- Invalidate all the existing GhcSession build nodes by restarting the Shake session
622+
invalidateShakeCache
627623

628624
-- Typecheck all files in the project on startup
629625
checkProject <- getCheckProject

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

Lines changed: 13 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -216,15 +216,17 @@ setFileModified :: Recorder (WithPriority Log)
216216
-> Bool -- ^ Was the file saved?
217217
-> NormalizedFilePath
218218
-> IO ()
219-
setFileModified recorder vfs state saved nfp = do
219+
-> IO ()
220+
setFileModified recorder vfs state saved nfp actionBefore = do
220221
ideOptions <- getIdeOptionsIO $ shakeExtras state
221222
doCheckParents <- optCheckParents ideOptions
222223
let checkParents = case doCheckParents of
223224
AlwaysCheck -> True
224225
CheckOnSave -> saved
225226
_ -> False
226-
join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
227-
restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] []
227+
restartShakeSession (shakeExtras state) vfs (fromNormalizedFilePath nfp ++ " (modified)") [] $ do
228+
actionBefore
229+
join $ atomically $ recordDirtyKeys (shakeExtras state) GetModificationTime [nfp]
228230
when checkParents $
229231
typecheckParents recorder state nfp
230232

@@ -244,14 +246,15 @@ typecheckParentsAction recorder nfp = do
244246
-- | Note that some keys have been modified and restart the session
245247
-- Only valid if the virtual file system was initialised by LSP, as that
246248
-- independently tracks which files are modified.
247-
setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO ()
248-
setSomethingModified vfs state keys reason = do
249+
setSomethingModified :: VFSModified -> IdeState -> [Key] -> String -> IO () -> IO ()
250+
setSomethingModified vfs state keys reason actionBetweenSession = do
249251
-- Update database to remove any files that might have been renamed/deleted
250-
atomically $ do
251-
writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
252-
modifyTVar' (dirtyKeys $ shakeExtras state) $ \x ->
253-
foldl' (flip insertKeySet) x keys
254-
void $ restartShakeSession (shakeExtras state) vfs reason [] keys
252+
void $ restartShakeSession (shakeExtras state) vfs reason [] $ do
253+
actionBetweenSession
254+
atomically $ do
255+
writeTQueue (indexQueue $ hiedbWriter $ shakeExtras state) (\withHieDb -> withHieDb deleteMissingRealFiles)
256+
modifyTVar' (dirtyKeys $ shakeExtras state) $ \x ->
257+
foldl' (flip insertKeySet) x keys
255258

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

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

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -300,7 +300,7 @@ data ShakeExtras = ShakeExtras
300300
:: VFSModified
301301
-> String
302302
-> [DelayedAction ()]
303-
-> [Key]
303+
-> IO ()
304304
-> IO ()
305305
#if MIN_VERSION_ghc(9,3,0)
306306
,ideNc :: NameCache
@@ -760,14 +760,14 @@ delayedAction a = do
760760
-- | Restart the current 'ShakeSession' with the given system actions.
761761
-- Any actions running in the current session will be aborted,
762762
-- but actions added via 'shakeEnqueue' will be requeued.
763-
shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> [Key] -> IO ()
764-
shakeRestart recorder IdeState{..} vfs reason acts keys =
763+
shakeRestart :: Recorder (WithPriority Log) -> IdeState -> VFSModified -> String -> [DelayedAction ()] -> IO () -> IO ()
764+
shakeRestart recorder IdeState{..} vfs reason acts ioActionBetweenShakeSession =
765765
withMVar'
766766
shakeSession
767767
(\runner -> do
768768
(stopTime,()) <- duration $ logErrorAfter 10 $ cancelShakeSession runner
769769
res <- shakeDatabaseProfile shakeDb
770-
atomically $ modifyTVar' (dirtyKeys shakeExtras) $ \x -> foldl' (flip insertKeySet) x keys
770+
ioActionBetweenShakeSession
771771
backlog <- readTVarIO $ dirtyKeys shakeExtras
772772
queue <- atomicallyNamed "actionQueue - peek" $ peekInProgress $ actionQueue shakeExtras
773773

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

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -72,32 +72,32 @@ descriptor recorder plId = (defaultPluginDescriptor plId desc) { pluginNotificat
7272
whenUriFile _uri $ \file -> do
7373
-- We don't know if the file actually exists, or if the contents match those on disk
7474
-- For example, vscode restores previously unsaved contents on open
75-
addFileOfInterest ide file Modified{firstOpen=True}
76-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
77-
logWith recorder Debug $ LogOpenedTextDocument _uri
75+
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $
76+
addFileOfInterest ide file Modified{firstOpen=True}
77+
logWith recorder Debug $ LogOpenedTextDocument _uri
7878

7979
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
8080
\ide vfs _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do
8181
atomically $ updatePositionMapping ide identifier changes
8282
whenUriFile _uri $ \file -> do
83-
addFileOfInterest ide file Modified{firstOpen=False}
84-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
83+
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file $
84+
addFileOfInterest ide file Modified{firstOpen=False}
8585
logWith recorder Debug $ LogModifiedTextDocument _uri
8686

8787
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
8888
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
8989
whenUriFile _uri $ \file -> do
90-
addFileOfInterest ide file OnDisk
91-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file
90+
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file $
91+
addFileOfInterest ide file OnDisk
9292
logWith recorder Debug $ LogSavedTextDocument _uri
9393

9494
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
9595
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
9696
whenUriFile _uri $ \file -> do
97-
deleteFileOfInterest ide file
9897
let msg = "Closed text document: " <> getUri _uri
99-
scheduleGarbageCollection ide
100-
setSomethingModified (VFSModified vfs) ide [] $ Text.unpack msg
98+
setSomethingModified (VFSModified vfs) ide [] (Text.unpack msg) $ do
99+
deleteFileOfInterest ide file
100+
scheduleGarbageCollection ide
101101
logWith recorder Debug $ LogClosedTextDocument _uri
102102

103103
, mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWatchedFiles $
@@ -116,9 +116,9 @@ 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-
modifyFileExists ide fileEvents'
120-
resetFileStore ide fileEvents'
121-
setSomethingModified (VFSModified vfs) ide [] msg
119+
setSomethingModified (VFSModified vfs) ide [] msg $ do
120+
modifyFileExists ide fileEvents'
121+
resetFileStore ide fileEvents'
122122

123123
, mkPluginNotificationHandler LSP.SMethod_WorkspaceDidChangeWorkspaceFolders $
124124
\ide _ _ (DidChangeWorkspaceFoldersParams events) -> liftIO $ do

‎plugins/hls-cabal-plugin/src/Ide/Plugin/Cabal.hs

Lines changed: 10 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -90,26 +90,26 @@ descriptor recorder plId =
9090
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri, _version}) -> liftIO $ do
9191
whenUriFile _uri $ \file -> do
9292
log' Debug $ LogDocOpened _uri
93-
addFileOfInterest recorder ide file Modified{firstOpen = True}
94-
restartCabalShakeSession (shakeExtras ide) vfs file "(opened)"
93+
restartCabalShakeSession (shakeExtras ide) vfs file "(opened)" $
94+
addFileOfInterest recorder ide file Modified{firstOpen = True}
9595
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
9696
\ide vfs _ (DidChangeTextDocumentParams VersionedTextDocumentIdentifier{_uri} _) -> liftIO $ do
9797
whenUriFile _uri $ \file -> do
9898
log' Debug $ LogDocModified _uri
99-
addFileOfInterest recorder ide file Modified{firstOpen = False}
100-
restartCabalShakeSession (shakeExtras ide) vfs file "(changed)"
99+
restartCabalShakeSession (shakeExtras ide) vfs file "(changed)" $
100+
addFileOfInterest recorder ide file Modified{firstOpen = False}
101101
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
102102
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
103103
whenUriFile _uri $ \file -> do
104104
log' Debug $ LogDocSaved _uri
105-
addFileOfInterest recorder ide file OnDisk
106-
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)"
105+
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
106+
addFileOfInterest recorder ide file OnDisk
107107
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
108108
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
109109
whenUriFile _uri $ \file -> do
110110
log' Debug $ LogDocClosed _uri
111-
deleteFileOfInterest recorder ide file
112-
restartCabalShakeSession (shakeExtras ide) vfs file "(closed)"
111+
restartCabalShakeSession (shakeExtras ide) vfs file "(closed)" $
112+
deleteFileOfInterest recorder ide file
113113
]
114114
, pluginConfigDescriptor = defaultConfigDescriptor
115115
{ configHasDiagnostics = True
@@ -132,8 +132,8 @@ Then we restart the shake session, so that changes to our virtual files are actu
132132
-}
133133
restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO ()
134134
restartCabalShakeSession shakeExtras vfs file actionMsg = do
135-
join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file]
136-
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] []
135+
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $
136+
join $ atomically $ Shake.recordDirtyKeys shakeExtras GetModificationTime [file]
137137

138138
-- ----------------------------------------------------------------
139139
-- Plugin Rules

0 commit comments

Comments
 (0)