Skip to content
This repository has been archived by the owner on Jan 2, 2021. It is now read-only.

Favor lookupPathToId over pathToId #926

Merged
merged 3 commits into from
Nov 29, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 6 additions & 4 deletions src/Development/IDE/Core/FileStore.hs
Original file line number Diff line number Diff line change
Expand Up @@ -239,10 +239,12 @@ typecheckParentsAction nfp = do
revs <- transitiveReverseDependencies nfp <$> useNoFile_ GetModuleGraph
logger <- logger <$> getShakeExtras
let log = L.logInfo logger . T.pack
liftIO $ do
(log $ "Typechecking reverse dependencies for" ++ show nfp ++ ": " ++ show revs)
`catch` \(e :: SomeException) -> log (show e)
() <$ uses GetModIface revs
case revs of
Nothing -> liftIO $ log $ "Could not identify reverse dependencies for " ++ show nfp
Just rs -> do
liftIO $ (log $ "Typechecking reverse dependencies for " ++ show nfp ++ ": " ++ show revs)
`catch` \(e :: SomeException) -> log (show e)
() <$ uses GetModIface rs

-- | Note that some buffer somewhere has been modified, but don't say what.
-- Only valid if the virtual file system was initialised by LSP, as that
Expand Down
15 changes: 11 additions & 4 deletions src/Development/IDE/Core/Rules.hs
Original file line number Diff line number Diff line change
Expand Up @@ -905,13 +905,20 @@ getLinkableType f = do
needsCompilationRule :: Rules ()
needsCompilationRule = defineEarlyCutoff $ \NeedsCompilation file -> do
((ms,_),_) <- useWithStale_ GetModSummaryWithoutTimestamps file
-- A file needs object code if it uses TH or any file that depends on it uses TH
-- A file needs object code if it uses TemplateHaskell or any file that depends on it uses TemplateHaskell
res <-
if uses_th_qq ms
then pure True
-- Treat as False if some reverse dependency header fails to parse
else anyM (fmap (fromMaybe False) . use NeedsCompilation) . maybe [] (immediateReverseDependencies file)
=<< useNoFile GetModuleGraph
else do
graph <- useNoFile GetModuleGraph
case graph of
-- Treat as False if some reverse dependency header fails to parse
Nothing -> pure False
Just depinfo -> case immediateReverseDependencies file depinfo of
-- If we fail to get immediate reverse dependencies, fail with an error message
Nothing -> fail $ "Failed to get the immediate reverse dependencies of " ++ show file
Just revdeps -> anyM (fmap (fromMaybe False) . use NeedsCompilation) revdeps

pure (Just $ BS.pack $ show $ hash res, ([], Just res))
where
uses_th_qq (ms_hspp_opts -> dflags) =
Expand Down
19 changes: 9 additions & 10 deletions src/Development/IDE/Import/DependencyInformation.hs
Original file line number Diff line number Diff line change
Expand Up @@ -317,23 +317,23 @@ partitionSCC (AcyclicSCC x:rest) = first (x:) $ partitionSCC rest
partitionSCC [] = ([], [])

-- | Transitive reverse dependencies of a file
transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
transitiveReverseDependencies file DependencyInformation{..} =
let FilePathId cur_id = pathToId depPathIdMap file
in map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty))
transitiveReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
transitiveReverseDependencies file DependencyInformation{..} = do
FilePathId cur_id <- lookupPathToId depPathIdMap file
return $ map (idToPath depPathIdMap . FilePathId) (IntSet.toList (go cur_id IntSet.empty))
where
go :: Int -> IntSet -> IntSet
go k i =
let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps )
let outwards = fromMaybe IntSet.empty (IntMap.lookup k depReverseModuleDeps)
res = IntSet.union i outwards
new = IntSet.difference i outwards
in IntSet.foldr go res new

-- | Immediate reverse dependencies of a file
immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> [NormalizedFilePath]
immediateReverseDependencies file DependencyInformation{..} =
let FilePathId cur_id = pathToId depPathIdMap file
in map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
immediateReverseDependencies :: NormalizedFilePath -> DependencyInformation -> Maybe [NormalizedFilePath]
immediateReverseDependencies file DependencyInformation{..} = do
FilePathId cur_id <- lookupPathToId depPathIdMap file
return $ map (idToPath depPathIdMap . FilePathId) (maybe mempty IntSet.toList (IntMap.lookup cur_id depReverseModuleDeps))
pepeiborra marked this conversation as resolved.
Show resolved Hide resolved

transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe TransitiveDependencies
transitiveDeps DependencyInformation{..} file = do
Expand Down Expand Up @@ -401,4 +401,3 @@ instance NFData NamedModuleDep where

instance Show NamedModuleDep where
show NamedModuleDep{..} = show nmdFilePath