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 03ffe6f

Browse files
committed
Reload .cabal files when they are modified
1 parent 59b733f commit 03ffe6f

File tree

4 files changed

+54
-4
lines changed

4 files changed

+54
-4
lines changed

‎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 #-}
@@ -319,6 +320,13 @@ instance Hashable GetModificationTime where
319320

320321
instance NFData GetModificationTime
321322

323+
data GetPhysicalModificationTime = GetPhysicalModificationTime
324+
deriving (Generic, Show, Eq)
325+
deriving anyclass (Hashable, NFData)
326+
327+
-- | Get the modification time of a file on disk, ignoring any version in the VFS.
328+
type instance RuleResult GetPhysicalModificationTime = FileVersion
329+
322330
pattern GetModificationTime :: GetModificationTime
323331
pattern GetModificationTime = GetModificationTime_ {missingFileDiagnostics=True}
324332

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

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -183,6 +183,7 @@ data Log
183183
| LogLoadingHieFileFail !FilePath !SomeException
184184
| LogLoadingHieFileSuccess !FilePath
185185
| LogTypecheckedFOI !NormalizedFilePath
186+
| LogDependencies !NormalizedFilePath [FilePath]
186187
deriving Show
187188

188189
instance Pretty Log where
@@ -207,6 +208,11 @@ instance Pretty Log where
207208
<+> "the HLS version being used, the plugins enabled, and if possible the codebase and file which"
208209
<+> "triggered this warning."
209210
]
211+
LogDependencies nfp deps ->
212+
vcat
213+
[ "Add dependency" <+> pretty (fromNormalizedFilePath nfp)
214+
, nest 2 $ pretty deps
215+
]
210216

211217
templateHaskellInstructions :: T.Text
212218
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 によって変換されたページ (->オリジナル) /