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 d18697c

Browse files
committed
Reload .cabal files when they are modified
1 parent 7346145 commit d18697c

File tree

12 files changed

+162
-11
lines changed

12 files changed

+162
-11
lines changed

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -499,7 +499,7 @@ loadSessionWithOptions recorder SessionLoadingOptions{..} rootDir que = do
499499
hscEnv <- emptyHscEnv ideNc libDir
500500
newTargetDfs <- evalGhcEnv hscEnv $ setOptions optHaddockParse cfp opts (hsc_dflags hscEnv) rootDir
501501
let deps = componentDependencies opts ++ maybeToList hieYaml
502-
dep_info <- getDependencyInfo deps
502+
dep_info <- getDependencyInfo (fmap toAbsolutePath deps)
503503
-- Now lookup to see whether we are combining with an existing HscEnv
504504
-- or making a new one. The lookup returns the HscEnv and a list of
505505
-- information about other components loaded into the HscEnv

‎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))

‎haskell-language-server.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -318,6 +318,7 @@ test-suite hls-cabal-plugin-tests
318318
, haskell-language-server:hls-cabal-plugin
319319
, hls-test-utils == 2.11.0.0
320320
, lens
321+
, lsp
321322
, lsp-types
322323
, text
323324

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

Lines changed: 12 additions & 2 deletions
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
@@ -145,7 +146,7 @@ descriptor recorder plId =
145146
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
146147
whenUriFile _uri $ \file -> do
147148
log' Debug $ LogDocSaved _uri
148-
restartCabalShakeSession (shakeExtras ide) vfs file "(saved)" $
149+
restartCabalShakeSessionPhysical (shakeExtras ide) vfs file "(saved)" $
149150
OfInterest.addFileOfInterest ofInterestRecorder ide file OnDisk
150151
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
151152
\ide vfs _ (DidCloseTextDocumentParams TextDocumentIdentifier{_uri}) -> liftIO $ do
@@ -180,7 +181,16 @@ restartCabalShakeSession :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> Stri
180181
restartCabalShakeSession shakeExtras vfs file actionMsg actionBetweenSession = do
181182
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
182183
keys <- actionBetweenSession
183-
return (toKey GetModificationTime file : keys)
184+
return (toKey GetModificationTime file:keys)
185+
186+
-- | Just like 'restartCabalShakeSession', but records that the 'file' has been changed on disk.
187+
-- So, any action that can only work with on-disk modifications may depend on the 'GetPhysicalModificationTime'
188+
-- rule to get re-run if the file changes on disk.
189+
restartCabalShakeSessionPhysical :: ShakeExtras -> VFS.VFS -> NormalizedFilePath -> String -> IO [Key] -> IO ()
190+
restartCabalShakeSessionPhysical shakeExtras vfs file actionMsg actionBetweenSession = do
191+
restartShakeSession shakeExtras (VFSModified vfs) (fromNormalizedFilePath file ++ " " ++ actionMsg) [] $ do
192+
keys <- actionBetweenSession
193+
return (toKey GetModificationTime file:toKey GetPhysicalModificationTime file:keys)
184194

185195
-- ----------------------------------------------------------------
186196
-- Code Actions

‎plugins/hls-cabal-plugin/test/Main.hs

Lines changed: 68 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,8 @@
11
{-# LANGUAGE CPP #-}
2+
{-# LANGUAGE DataKinds #-}
23
{-# LANGUAGE DisambiguateRecordFields #-}
34
{-# LANGUAGE OverloadedStrings #-}
5+
{-# LANGUAGE QuasiQuotes #-}
46

57
module Main (
68
main,
@@ -17,14 +19,19 @@ import qualified Data.ByteString as BS
1719
import Data.Either (isRight)
1820
import Data.List.Extra (nubOrdOn)
1921
import qualified Data.Maybe as Maybe
22+
import Data.Text (Text)
2023
import qualified Data.Text as T
24+
import qualified Data.Text.IO as Text
2125
import Definition (gotoDefinitionTests)
26+
import Development.IDE.Test
2227
import Ide.Plugin.Cabal.LicenseSuggest (licenseErrorSuggestion)
2328
import qualified Ide.Plugin.Cabal.Parse as Lib
2429
import qualified Language.LSP.Protocol.Lens as L
30+
import qualified Language.LSP.Protocol.Message as L
2531
import Outline (outlineTests)
2632
import System.FilePath
2733
import Test.Hls
34+
import Test.Hls.FileSystem
2835
import Utils
2936

3037
main :: IO ()
@@ -40,6 +47,7 @@ main = do
4047
, codeActionTests
4148
, gotoDefinitionTests
4249
, hoverTests
50+
, reloadOnCabalChangeTests
4351
]
4452

4553
-- ------------------------------------------------------------------------
@@ -128,11 +136,6 @@ pluginTests =
128136
_ <- applyEdit doc $ TextEdit (Range (Position 3 20) (Position 4 0)) "BSD-3-Clause\n"
129137
newDiags <- cabalCaptureKick
130138
liftIO $ newDiags @?= []
131-
, runCabalTestCaseSession "No Diagnostics in .hs files from valid .cabal file" "simple-cabal" $ do
132-
hsDoc <- openDoc "A.hs" "haskell"
133-
expectNoMoreDiagnostics 1 hsDoc "typechecking"
134-
cabalDoc <- openDoc "simple-cabal.cabal" "cabal"
135-
expectNoMoreDiagnostics 1 cabalDoc "parsing"
136139
]
137140
]
138141
-- ----------------------------------------------------------------------------
@@ -262,3 +265,63 @@ hoverOnDependencyTests = testGroup "Hover Dependency"
262265
h <- getHover doc pos
263266
liftIO $ assertBool ("Found hover `" <> show h <> "`") $ Maybe.isNothing h
264267
closeDoc doc
268+
269+
-- ----------------------------------------------------------------------------
270+
-- Reloading of Haskell files on .cabal changes
271+
-- ----------------------------------------------------------------------------
272+
273+
simpleCabalVft :: [FileTree]
274+
simpleCabalVft =
275+
[ copy "hie.yaml"
276+
, copy "simple-reload.cabal"
277+
, copy "Main.hs"
278+
]
279+
280+
simpleCabalFs :: VirtualFileTree
281+
simpleCabalFs = mkVirtualFileTree
282+
(testDataDir </> "simple-reload")
283+
simpleCabalVft
284+
285+
-- Slow tests
286+
reloadOnCabalChangeTests :: TestTree
287+
reloadOnCabalChangeTests = testGroup "Reload on .cabal changes"
288+
[ runCabalTestCaseSessionVft "Change warnings when .cabal file changes" simpleCabalFs $ do
289+
_ <- openDoc "Main.hs" "haskell"
290+
expectDiagnostics [("Main.hs", [(DiagnosticSeverity_Warning, (8, 0), "Top-level binding with no type signature", Just "GHC-38417")])]
291+
waitForAllProgressDone
292+
cabalDoc <- openDoc "simple-reload.cabal" "cabal"
293+
skipManyTill anyMessage cabalKickDone
294+
saveDoc cabalDoc
295+
[trimming|
296+
cabal-version: 3.4
297+
name: simple-reload
298+
version: 0.1.0.0
299+
-- copyright:
300+
build-type: Simple
301+
302+
common warnings
303+
ghc-options: -Wall -Wno-missing-signatures
304+
305+
executable simple-reload
306+
import: warnings
307+
main-is: Main.hs
308+
build-depends: base
309+
default-language: Haskell2010
310+
|]
311+
312+
expectDiagnostics [("Main.hs", [(DiagnosticSeverity_Warning, (2, 0), "The import of 8216円Data.List8217円 is redundant", Nothing)])]
313+
]
314+
315+
-- | Persists the given contents to the 'TextDocumentIdentifier' on disk
316+
-- and sends the @textDocument/didSave@ notification.
317+
saveDoc :: TextDocumentIdentifier -> Text -> Session ()
318+
saveDoc docId t = do
319+
-- I couldn't figure out how to get the virtual file contents, so we write it
320+
-- to disk and send the 'SMethod_TextDocumentDidSave' notification
321+
case uriToFilePath (docId ^. L.uri) of
322+
Nothing -> pure ()
323+
Just fp -> do
324+
liftIO $ Text.writeFile fp t
325+
326+
let params = DidSaveTextDocumentParams docId Nothing
327+
sendNotification L.SMethod_TextDocumentDidSave params

‎plugins/hls-cabal-plugin/test/Utils.hs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ import qualified Ide.Plugin.Cabal
1414
import Ide.Plugin.Cabal.Completion.Types
1515
import System.FilePath
1616
import Test.Hls
17+
import Test.Hls.FileSystem (VirtualFileTree)
1718

1819

1920
cabalPlugin :: PluginTestDescriptor Ide.Plugin.Cabal.Log
@@ -57,6 +58,13 @@ runCabalSession :: FilePath -> Session a -> IO a
5758
runCabalSession subdir =
5859
failIfSessionTimeout . runSessionWithServer def cabalPlugin (testDataDir </> subdir)
5960

61+
runCabalTestCaseSessionVft :: TestName -> VirtualFileTree -> Session () -> TestTree
62+
runCabalTestCaseSessionVft title vft = testCase title . runCabalSessionVft vft
63+
64+
runCabalSessionVft :: VirtualFileTree -> Session a -> IO a
65+
runCabalSessionVft vft =
66+
failIfSessionTimeout . runSessionWithServerInTmpDir def cabalPlugin vft
67+
6068
runHaskellAndCabalSession :: FilePath -> Session a -> IO a
6169
runHaskellAndCabalSession subdir =
6270
failIfSessionTimeout . runSessionWithServer def (cabalPlugin <> cabalHaskellPlugin) (testDataDir </> subdir)
@@ -82,3 +90,4 @@ cabalCaptureKick = captureKickDiagnostics cabalKickStart cabalKickDone
8290
-- | list comparison where the order in the list is irrelevant
8391
(@?==) :: (HasCallStack, Ord a, Show a) => [a] -> [a] -> Assertion
8492
(@?==) l1 l2 = sort l1 @?= sort l2
93+
Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
module Main where
2+
3+
import Data.List -- Intentionally unused import, used in the testcase
4+
5+
main :: IO ()
6+
main = foo
7+
8+
-- Missing signature
9+
foo = putStrLn "Hello, World"
Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1 @@
1+
packages: .

0 commit comments

Comments
(0)

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