Skip to content

Commit e4efd0d

Browse files
nlandernlander
committed
Properly handle open dependency files
1 parent dbda632 commit e4efd0d

File tree

10 files changed

+190
-46
lines changed

10 files changed

+190
-46
lines changed

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

Lines changed: 10 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -141,11 +141,18 @@ getAtPoint file pos = runMaybeT $ do
141141
opts <- liftIO $ getIdeOptionsIO ide
142142

143143
(hf, mapping) <- useWithStaleFastMT GetHieAst file
144-
env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
145-
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
144+
-- The HscEnv and DKMap are not strictly necessary for hover
145+
-- to work, so we only calculate them for project files, not
146+
-- for dependency files.
147+
(mEnv, mDkMap) <- case getSourceFileOrigin file of
148+
FromDependency -> pure (Nothing, Nothing)
149+
FromProject -> do
150+
env <- hscEnv . fst <$> useWithStaleFastMT GhcSession file
151+
dkMap <- lift $ maybe (DKMap mempty mempty) fst <$> runMaybeT (useWithStaleFastMT GetDocMap file)
152+
pure (Just env, Just dkMap)
146153

147154
!pos' <- MaybeT (return $ fromCurrentPosition mapping pos)
148-
MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf dkMap env pos'
155+
MaybeT $ liftIO $ fmap (first (toCurrentRange mapping =<<)) <$> AtPoint.atPoint opts hf mDkMap mEnv pos'
149156

150157
-- | For each Loacation, determine if we have the PositionMapping
151158
-- for the correct file. If not, get the correct position mapping

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

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -78,6 +78,7 @@ ofInterestRules recorder = do
7878
summarize (IsFOI OnDisk) = BS.singleton 1
7979
summarize (IsFOI (Modified False)) = BS.singleton 2
8080
summarize (IsFOI (Modified True)) = BS.singleton 3
81+
summarize (IsFOI ReadOnly) = BS.singleton 4
8182

8283
------------------------------------------------------------
8384
newtype GarbageCollectVar = GarbageCollectVar (Var Bool)
@@ -130,23 +131,30 @@ scheduleGarbageCollection state = do
130131
-- Could be improved
131132
kick :: Action ()
132133
kick = do
133-
files <- HashMap.keys <$> getFilesOfInterestUntracked
134+
filesOfInterestMap <- getFilesOfInterestUntracked
134135
ShakeExtras{exportsMap, ideTesting = IdeTesting testing, lspEnv, progress} <- getShakeExtras
135136
let signal :: KnownSymbol s => Proxy s -> Action ()
136137
signal msg = when testing $ liftIO $
137138
mRunLspT lspEnv $
138139
LSP.sendNotification (LSP.SMethod_CustomMethod msg) $
139140
toJSON $ map fromNormalizedFilePath files
141+
files :: [NormalizedFilePath]
142+
files = HashMap.keys filesOfInterestMap
143+
-- We cannot run all the Rules on ReadOnly dependency files, so
144+
-- we filter those out.
145+
projectFiles :: [NormalizedFilePath]
146+
projectFiles = HashMap.keys
147+
$ HashMap.filter (/= ReadOnly) filesOfInterestMap
140148

141149
signal (Proxy @"kick/start")
142150
liftIO $ progressUpdate progress KickStarted
143151

144152
-- Update the exports map
145-
results <- uses GenerateCore files
153+
results <- uses GenerateCore projectFiles
146154
<* uses GetHieAst files
147155
-- needed to have non local completions on the first edit
148156
-- when the first edit breaks the module header
149-
<* uses NonLocalCompletions files
157+
<* uses NonLocalCompletions projectFiles
150158
let mguts = catMaybes results
151159
void $ liftIO $ atomically $ modifyTVar' exportsMap (updateExportsMapMg mguts)
152160

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -335,6 +335,7 @@ instance Hashable GetFileExists
335335

336336
data FileOfInterestStatus
337337
= OnDisk
338+
| ReadOnly
338339
| Modified { firstOpen :: !Bool -- ^ was this file just opened
339340
}
340341
deriving (Eq, Show, Typeable, Generic)

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

Lines changed: 30 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -570,9 +570,36 @@ reportImportCyclesRule recorder =
570570
getHieAstsRule :: Recorder (WithPriority Log) -> Rules ()
571571
getHieAstsRule recorder =
572572
define (cmapWithPrio LogShake recorder) $ \GetHieAst f -> do
573-
tmr <- use_ TypeCheck f
574-
hsc <- hscEnv <$> use_ GhcSessionDeps f
575-
getHieAstRuleDefinition f hsc tmr
573+
case getSourceFileOrigin f of
574+
-- For dependency source files, get the HieAstResult from
575+
-- the HIE file in the HieDb database.
576+
FromDependency -> do
577+
se <- getShakeExtras
578+
mHieFile <- liftIO
579+
$ runIdeAction "GetHieAst" se
580+
$ runMaybeT
581+
-- We can look up the HIE file from its source
582+
-- because at this point lookupMod has already been
583+
-- called and has created the the source file in
584+
-- the .hls directory and indexed it.
585+
$ readHieFileForSrcFromDisk recorder f
586+
pure ([], makeHieAstResult <$> mHieFile)
587+
FromProject -> do
588+
tmr <- use_ TypeCheck f
589+
hsc <- hscEnv <$> use_ GhcSessionDeps f
590+
getHieAstRuleDefinition f hsc tmr
591+
where
592+
makeHieAstResult :: Compat.HieFile -> HieAstResult
593+
makeHieAstResult hieFile =
594+
HAR
595+
(Compat.hie_module hieFile)
596+
hieAsts
597+
(Compat.generateReferencesMap $ M.elems $ getAsts hieAsts)
598+
mempty
599+
(HieFromDisk hieFile)
600+
where
601+
hieAsts :: HieASTs TypeIndex
602+
hieAsts = Compat.hie_asts hieFile
576603

577604
persistentHieFileRule :: Recorder (WithPriority Log) -> Rules ()
578605
persistentHieFileRule recorder = addPersistentRule GetHieAst $ \file -> runMaybeT $ do

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

Lines changed: 37 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -44,6 +44,8 @@ module Development.IDE.Core.Shake(
4444
define, defineNoDiagnostics,
4545
defineEarlyCutoff,
4646
defineNoFile, defineEarlyCutOffNoFile,
47+
getSourceFileOrigin,
48+
SourceFileOrigin(..),
4749
getDiagnostics,
4850
mRunLspT, mRunLspTCallback,
4951
getHiddenDiagnostics,
@@ -165,7 +167,8 @@ import Ide.Plugin.Config
165167
import qualified Ide.PluginUtils as HLS
166168
import Ide.Types (IdePlugins (IdePlugins),
167169
PluginDescriptor (pluginId),
168-
PluginId)
170+
PluginId, SourceFileOrigin(..),
171+
getSourceFileOrigin)
169172
import Language.LSP.Diagnostics
170173
import Language.LSP.Protocol.Message
171174
import Language.LSP.Protocol.Types
@@ -1185,11 +1188,23 @@ defineEarlyCutoff' doDiagnostics cmp key file old mode action = do
11851188
Just (Succeeded ver v, _) -> Stale Nothing ver v
11861189
Just (Stale d ver v, _) -> Stale d ver v
11871190
Just (Failed b, _) -> Failed b
1188-
(bs, (diags, res)) <- actionCatch
1189-
(do v <- action staleV; liftIO $ evaluate $ force v) $
1190-
\(e :: SomeException) -> do
1191-
pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
1192-
1191+
(bs, (diags, res)) <- do
1192+
let doAction = actionCatch
1193+
(do v <- action staleV; liftIO $ evaluate $ force v) $
1194+
\(e :: SomeException) -> do
1195+
pure (Nothing, ([ideErrorText file $ T.pack $ show e | not $ isBadDependency e],Nothing))
1196+
case getSourceFileOrigin file of
1197+
FromProject -> doAction
1198+
FromDependency -> if isSafeDependencyRule key
1199+
then doAction
1200+
-- This should never happen. All code paths that run a
1201+
-- Rule that is not on the whitelist defined by
1202+
-- isSafeDependencyRule should be disabled for dependency
1203+
-- files. If one is found, it should be changed.
1204+
else error $
1205+
"defineEarlyCutoff': Undefined action for dependency source files\n"
1206+
++ show file ++ "\n"
1207+
++ show key
11931208
ver <- estimateFileVersionUnsafely key res file
11941209
(bs, res) <- case res of
11951210
Nothing -> do
@@ -1232,6 +1247,22 @@ defineEarlyCutoff' doDiagnostics cmp key file old mode action = do
12321247
-- * creating a dependency: If everything depends on GetModificationTime, we lose early cutoff
12331248
-- * creating bogus "file does not exists" diagnostics
12341249
| otherwise = useWithoutDependency (GetModificationTime_ False) fp
1250+
isSafeDependencyRule
1251+
:: forall k v
1252+
. IdeRule k v
1253+
=> k
1254+
-> Bool
1255+
isSafeDependencyRule _k
1256+
-- The only Rules that are safe for dependencies.
1257+
-- GetHieAst is necessary for hover,
1258+
-- which can be called in dependency files.
1259+
| Just Refl <- eqT @k @GetHieAst = True
1260+
-- Dependency files can be files of interest.
1261+
| Just Refl <- eqT @k @IsFileOfInterest = True
1262+
-- GetModificationTime is safe for any file, and
1263+
-- can be called in dependency files by estimateFileVersionUnsafely.
1264+
| Just Refl <- eqT @k @GetModificationTime = True
1265+
| otherwise = False
12351266

12361267
traceA :: A v -> String
12371268
traceA (A Failed{}) = "Failed"

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

Lines changed: 19 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -61,25 +61,37 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
6161
\ide vfs _ (DidOpenTextDocumentParams TextDocumentItem{_uri,_version}) -> liftIO $ do
6262
atomically $ updatePositionMapping ide (VersionedTextDocumentIdentifier _uri _version) []
6363
whenUriFile _uri $ \file -> do
64+
let foiStatus = case getSourceFileOrigin file of
65+
FromProject -> Modified{firstOpen=True}
66+
FromDependency -> ReadOnly
6467
-- We don't know if the file actually exists, or if the contents match those on disk
6568
-- For example, vscode restores previously unsaved contents on open
66-
addFileOfInterest ide file Modified{firstOpen=True}
67-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
69+
addFileOfInterest ide file foiStatus
70+
unless (foiStatus == ReadOnly)
71+
$ setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
6872
logDebug (ideLogger ide) $ "Opened text document: " <> getUri _uri
6973

7074
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidChange $
7175
\ide vfs _ (DidChangeTextDocumentParams identifier@VersionedTextDocumentIdentifier{_uri} changes) -> liftIO $ do
7276
atomically $ updatePositionMapping ide identifier changes
7377
whenUriFile _uri $ \file -> do
74-
addFileOfInterest ide file Modified{firstOpen=False}
75-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
78+
let foiStatus = case getSourceFileOrigin file of
79+
FromProject -> Modified{firstOpen=True}
80+
FromDependency -> ReadOnly
81+
addFileOfInterest ide file foiStatus
82+
unless (foiStatus == ReadOnly)
83+
$ setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide False file
7684
logDebug (ideLogger ide) $ "Modified text document: " <> getUri _uri
7785

7886
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidSave $
7987
\ide vfs _ (DidSaveTextDocumentParams TextDocumentIdentifier{_uri} _) -> liftIO $ do
8088
whenUriFile _uri $ \file -> do
81-
addFileOfInterest ide file OnDisk
82-
setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file
89+
let foiStatus = case getSourceFileOrigin file of
90+
FromProject -> OnDisk
91+
FromDependency -> ReadOnly
92+
addFileOfInterest ide file foiStatus
93+
unless (foiStatus == ReadOnly)
94+
$ setFileModified (cmapWithPrio LogFileStore recorder) (VFSModified vfs) ide True file
8395
logDebug (ideLogger ide) $ "Saved text document: " <> getUri _uri
8496

8597
, mkPluginNotificationHandler LSP.SMethod_TextDocumentDidClose $
@@ -146,6 +158,7 @@ descriptor recorder plId = (defaultPluginDescriptor plId) { pluginNotificationHa
146158
-- The ghcide descriptors should come last'ish so that the notification handlers
147159
-- (which restart the Shake build) run after everything else
148160
pluginPriority = ghcideNotificationsPluginPriority
161+
, pluginFileType = PluginFileType [FromProject, FromDependency] defaultPluginFileExtensions
149162
}
150163

151164
ghcideNotificationsPluginPriority :: Natural

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -38,7 +38,9 @@ moduleOutline
3838
moduleOutline ideState _ DocumentSymbolParams{ _textDocument = TextDocumentIdentifier uri }
3939
= liftIO $ case uriToFilePath uri of
4040
Just (toNormalizedFilePath' -> fp) -> do
41-
mb_decls <- fmap fst <$> runAction "Outline" ideState (useWithStale GetParsedModule fp)
41+
mb_decls <- case getSourceFileOrigin fp of
42+
FromDependency -> pure Nothing
43+
FromProject -> fmap fst <$> runAction "Outline" ideState (useWithStale GetParsedModule fp)
4244
pure $ case mb_decls of
4345
Nothing -> InL []
4446
Just ParsedModule { pm_parsed_source = L _ltop HsModule { hsmodName, hsmodDecls, hsmodImports } }

‎ghcide/src/Development/IDE/Plugin/HLS/GhcIde.hs

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -52,9 +52,10 @@ descriptor plId = (defaultPluginDescriptor plId)
5252
<> mkPluginHandler SMethod_TextDocumentDocumentHighlight (\ide _ DocumentHighlightParams{..} ->
5353
documentHighlight ide TextDocumentPositionParams{..})
5454
<> mkPluginHandler SMethod_TextDocumentReferences references
55-
<> mkPluginHandler SMethod_WorkspaceSymbol wsSymbols,
55+
<> mkPluginHandler SMethod_WorkspaceSymbol wsSymbols
5656

57-
pluginConfigDescriptor = defaultConfigDescriptor
57+
, pluginConfigDescriptor = defaultConfigDescriptor
58+
, pluginFileType = PluginFileType [FromProject, FromDependency] defaultPluginFileExtensions
5859
}
5960

6061
-- ---------------------------------------------------------------------

‎ghcide/src/Development/IDE/Spans/AtPoint.hs

Lines changed: 33 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -212,11 +212,11 @@ gotoDefinition withHieDb getHieFile ideOpts imports srcSpans pos
212212
atPoint
213213
:: IdeOptions
214214
-> HieAstResult
215-
-> DocAndKindMap
216-
-> HscEnv
215+
-> Maybe DocAndKindMap
216+
-> Maybe HscEnv
217217
-> Position
218218
-> IO (Maybe (Maybe Range, [T.Text]))
219-
atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env pos =
219+
atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) mDkMap mEnv pos =
220220
listToMaybe <$> sequence (pointCommand hf pos hoverInfo)
221221
where
222222
-- Hover info for values/data
@@ -259,9 +259,15 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env
259259
prettyName (Right n, dets) = pure $ T.unlines $
260260
wrapHaskell (printOutputable n <> maybe "" (" :: " <>) ((prettyType <$> identType dets) <|> maybeKind))
261261
: maybeToList (pretty (definedAt n) (prettyPackageName n))
262-
++ catMaybes [ T.unlines . spanDocToMarkdown <$> lookupNameEnv dm n
262+
++ catMaybes [ T.unlines . spanDocToMarkdown <$> maybeDoc
263263
]
264-
where maybeKind = fmap printOutputable $ safeTyThingType =<< lookupNameEnv km n
264+
where maybeKind = do
265+
(DKMap _ km) <- mDkMap
266+
nameEnv <- lookupNameEnv km n
267+
printOutputable <$> safeTyThingType nameEnv
268+
maybeDoc = do
269+
(DKMap dm _) <- mDkMap
270+
lookupNameEnv dm n
265271
pretty Nothing Nothing = Nothing
266272
pretty (Just define) Nothing = Just $ define <> "\n"
267273
pretty Nothing (Just pkgName) = Just $ pkgName <> "\n"
@@ -271,28 +277,40 @@ atPoint IdeOptions{} (HAR _ hf _ _ (kind :: HieKind hietype)) (DKMap dm km) env
271277
prettyPackageName :: Name -> Maybe T.Text
272278
prettyPackageName n = do
273279
m <- nameModule_maybe n
274-
pkgTxt <- packageNameWithVersion m env
280+
pkgTxt <- packageNameWithVersion m
275281
pure $ "*(" <> pkgTxt <> ")*"
276282

277283
-- Return the module text itself and
278284
-- the package(with version) this `ModuleName` belongs to.
279285
packageNameForImportStatement :: ModuleName -> IO T.Text
280286
packageNameForImportStatement mod = do
281-
mpkg <- findImportedModule env mod :: IO (Maybe Module)
287+
mpkg <- fmap join $ sequence $
288+
flip findImportedModule mod <$> mEnv :: IO (Maybe Module)
282289
let moduleName = printOutputable mod
283-
case mpkg >>= flip packageNameWithVersion env of
290+
case mpkg >>= packageNameWithVersion of
284291
Nothing -> pure moduleName
285292
Just pkgWithVersion -> pure $ moduleName <> "\n\n" <> pkgWithVersion
286293

287294
-- Return the package name and version of a module.
288295
-- For example, given module `Data.List`, it should return something like `base-4.x`.
289-
packageNameWithVersion :: Module -> HscEnv -> Maybe T.Text
290-
packageNameWithVersion m env = do
291-
let pid = moduleUnit m
292-
conf <- lookupUnit env pid
293-
let pkgName = T.pack $ unitPackageNameString conf
294-
version = T.pack $ showVersion (unitPackageVersion conf)
295-
pure $ pkgName <> "-" <> version
296+
packageNameWithVersion :: Module -> Maybe T.Text
297+
packageNameWithVersion m = let pid = moduleUnit m in
298+
case mEnv of
299+
-- If we have an HscEnv (because this is a project file),
300+
-- we can get the package name from that.
301+
Just env -> do
302+
let pid = moduleUnit m
303+
conf <- lookupUnit env pid
304+
let pkgName = T.pack $ unitPackageNameString conf
305+
version = T.pack $ showVersion (unitPackageVersion conf)
306+
pure $ pkgName <> "-" <> version
307+
-- If we don't have an HscEnv (because this is a dependency file),
308+
-- then we can get a similar format for the package name
309+
-- from the UnitId.
310+
Nothing ->
311+
let uid = toUnitId pid
312+
pkgStr = takeWhile (/= ':') $ show uid
313+
in Just $ T.pack pkgStr
296314

297315
-- Type info for the current node, it may contains several symbols
298316
-- for one range, like wildcard

0 commit comments

Comments
 (0)