Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

Sign up
Appearance settings

Commit 07759ee

Browse files
committed
Reload .cabal files when they are modified
1 parent 4c7e56a commit 07759ee

File tree

5 files changed

+55
-5
lines changed

5 files changed

+55
-5
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -586,7 +586,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
586586
unless (null new_deps || not checkProject) $ do
587587
cfps' <- liftIO $ filterM (IO.doesFileExist . fromNormalizedFilePath) (concatMap targetLocations all_targets)
588588
void $ shakeEnqueue extras $ mkDelayedAction "InitialLoad" Debug $ void $ do
589-
mmt <- uses GetModificationTime cfps'
589+
mmt <- uses GetPhysicalModificationTime cfps'
590590
let cs_exist = catMaybes (zipWith (<$) cfps' mmt)
591591
modIfaces <- uses GetModIface cs_exist
592592
-- update exports map

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

Lines changed: 29 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -78,7 +78,6 @@ import System.FilePath
7878
import System.IO.Error
7979
import System.IO.Unsafe
8080

81-
8281
data Log
8382
= LogCouldNotIdentifyReverseDeps !NormalizedFilePath
8483
| LogTypeCheckingReverseDeps !NormalizedFilePath !(Maybe [NormalizedFilePath])
@@ -147,6 +146,29 @@ getModificationTimeImpl missingFileDiags file = do
147146
then return (Nothing, ([], Nothing))
148147
else return (Nothing, ([diag], Nothing))
149148

149+
150+
getPhysicalModificationTimeRule :: Recorder (WithPriority Log) -> Rules ()
151+
getPhysicalModificationTimeRule recorder = defineEarlyCutoff (cmapWithPrio LogShake recorder) $ Rule $ \GetPhysicalModificationTime file ->
152+
getPhysicalModificationTimeImpl file
153+
154+
getPhysicalModificationTimeImpl
155+
:: NormalizedFilePath
156+
-> Action (Maybe BS.ByteString, ([FileDiagnostic], Maybe FileVersion))
157+
getPhysicalModificationTimeImpl file = do
158+
let file' = fromNormalizedFilePath file
159+
let wrap time = (Just $ LBS.toStrict $ B.encode $ toRational time, ([], Just $ ModificationTime time))
160+
161+
alwaysRerun
162+
163+
liftIO $ fmap wrap (getModTime file')
164+
`catch` \(e :: IOException) -> do
165+
let err | isDoesNotExistError e = "File does not exist: " ++ file'
166+
| otherwise = "IO error while reading " ++ file' ++ ", " ++ displayException e
167+
diag = ideErrorText file (T.pack err)
168+
if isDoesNotExistError e
169+
then return (Nothing, ([], Nothing))
170+
else return (Nothing, ([diag], Nothing))
171+
150172
-- | Interface files cannot be watched, since they live outside the workspace.
151173
-- But interface files are private, in that only HLS writes them.
152174
-- So we implement watching ourselves, and bypass the need for alwaysRerun.
@@ -170,7 +192,11 @@ resetFileStore ideState changes = mask $ \_ -> do
170192
case c of
171193
LSP.FileChangeType_Changed
172194
-- already checked elsewhere | not $ HM.member nfp fois
173-
-> atomically $ deleteValue (shakeExtras ideState) GetModificationTime nfp
195+
->
196+
atomically $ do
197+
ks <- deleteValue (shakeExtras ideState) GetModificationTime nfp
198+
vs <- deleteValue (shakeExtras ideState) GetPhysicalModificationTime nfp
199+
pure $ ks ++ vs
174200
_ -> pure []
175201

176202

@@ -233,6 +259,7 @@ getVersionedTextDoc doc = do
233259
fileStoreRules :: Recorder (WithPriority Log) -> (NormalizedFilePath -> Action Bool) -> Rules ()
234260
fileStoreRules recorder isWatched = do
235261
getModificationTimeRule recorder
262+
getPhysicalModificationTimeRule recorder
236263
getFileContentsRule recorder
237264
addWatchedFileRule recorder isWatched
238265

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

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
-- Copyright (c) 2019 The DAML Authors. All rights reserved.
22
-- SPDX-License-Identifier: Apache-2.0
33

4+
{-# LANGUAGE DeriveAnyClass #-}
45
{-# LANGUAGE DerivingStrategies #-}
56
{-# LANGUAGE GADTs #-}
67
{-# LANGUAGE PatternSynonyms #-}
@@ -316,6 +317,13 @@ instance Hashable GetModificationTime where
316317

317318
instance NFData GetModificationTime
318319

320+
data GetPhysicalModificationTime = GetPhysicalModificationTime
321+
deriving (Generic, Show, Eq)
322+
deriving anyclass (Hashable, NFData)
323+
324+
-- | Get the modification time of a file on disk, ignoring any version in the VFS.
325+
type instance RuleResult GetPhysicalModificationTime = FileVersion
326+
319327
pattern GetModificationTime :: GetModificationTime
320328
pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
321329

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

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -181,6 +181,7 @@ data Log
181181
| LogLoadingHieFileFail !FilePath !SomeException
182182
| LogLoadingHieFileSuccess !FilePath
183183
| LogTypecheckedFOI !NormalizedFilePath
184+
| LogDependencies !NormalizedFilePath [FilePath]
184185
deriving Show
185186

186187
instance Pretty Log where
@@ -205,6 +206,11 @@ instance Pretty Log where
205206
<+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"
206207
<+> "triggered this warning."
207208
]
209+
LogDependencies nfp deps ->
210+
vcat
211+
[ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)
212+
, nest 2 $ pretty deps
213+
]
208214

209215
templateHaskellInstructions :: T.Text
210216
templateHaskellInstructions = "https://haskell-language-server.readthedocs.io/en/latest/troubleshooting.html#static-binaries"
@@ -715,7 +721,8 @@ loadGhcSession recorder ghcSessionDepsConfig = do
715721
let nfp = toNormalizedFilePath' fp
716722
itExists <- getFileExists nfp
717723
when itExists $ void $ do
718-
use_ GetModificationTime nfp
724+
use_ GetPhysicalModificationTime nfp
725+
logWith recorder Logger.Info $ LogDependencies file deps
719726
mapM_ addDependency deps
720727

721728
let cutoffHash = LBS.toStrict $ B.encode (hash (snd val))

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

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DuplicateRecordFields #-}
33
{-# LANGUAGE LambdaCase #-}
44
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE PatternSynonyms #-}
56
{-# LANGUAGE TypeFamilies #-}
67

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

192+
193+
restartCabalShakeSessionPhysical :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
194+
restartCabalShakeSessionPhysical shakeExtras vfs file actionMsg actionBetweenSession = do
195+
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
196+
keys <- actionBetweenSession
197+
return (toKey GetModificationTime file:toKey GetPhysicalModificationTime file:keys)
198+
191199
-- ----------------------------------------------------------------
192200
-- Plugin Rules
193201
-- ----------------------------------------------------------------

0 commit comments

Comments
(0)

AltStyle によって変換されたページ (->オリジナル) /