2ae46ae · ghcide · git.iko.soy

git.iko.soy/ghcide

Track module dependencies (#431)

* Add ModLocation to Import type * Add ModuleNames to dependency information With @adamse * Clarify ModLocation assumption * Add a comment on use of rwhnf * newtype ArtifactsLocation Co-authored-by: Marcelo Lazaroni <lazamar@users.noreply.github.com>

commit2ae46aea15624bf7847d2d02d3da7e30b25ccd0d authorPepe Iborra <pepeiborra@gmail.com> dateMon 17 Feb 2020, 08:55 (7 years ago) parentfd01d20

6 files changed+109−28

compare with master

unifiedsplit

src/Development/IDE/Core/RuleTypes.hs+2−2 src/Development/IDE/Core/Rules.hs+7−6 src/Development/IDE/GHC/Compat.hs+13−3 src/Development/IDE/Import/DependencyInformation.hs+71−13 src/Development/IDE/Import/FindImports.hs+15−3 src/Development/IDE/Plugin/Completions.hs+1−1

src/Development/IDE/Core/RuleTypes.hs+2−2

@@ -15,7 +15,6 @@ import Control.DeepSeq

1515import Data.Binary

1616import Development.IDE.Import.DependencyInformation

1717import Development.IDE.GHC.Util

18−import Development.IDE.Types.Location

1918import Data.Hashable

2019import Data.Typeable

2120import qualified Data.Set as S

@@ -28,6 +27,7 @@ import HscTypes (CgGuts, Linkable, HomeModInfo, ModDetails)

2827import Development.IDE.GHC.Compat

2928

3029import Development.IDE.Spans.Type

30+import Development.IDE.Import.FindImports (ArtifactsLocation)

3131

3232

3333-- NOTATION

@@ -75,7 +75,7 @@ type instance RuleResult GhcSession = HscEnvEq

7575

7676-- | Resolve the imports in a module to the file path of a module

7777-- in the same package or the package id of another package.

78−type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe NormalizedFilePath)], S.Set InstalledUnitId)

78+type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe ArtifactsLocation)], S.Set InstalledUnitId)

7979

8080-- | This rule is used to report import cycles. It depends on GetDependencyInformation.

8181-- We cannot report the cycles directly from GetDependencyInformation since

src/Development/IDE/Core/Rules.hs+7−6

@@ -4,6 +4,7 @@

44{-# LANGUAGE TypeFamilies #-}

55{-# LANGUAGE FlexibleInstances #-}

66{-# LANGUAGE DuplicateRecordFields #-}

7+{-# LANGUAGE PatternSynonyms #-}

89-- | A Shake implementation of the compiler service, built

910-- using the "Shaker" abstraction layer for in-memory use.

@@ -27,6 +28,7 @@ module Development.IDE.Core.Rules(

2728import Fingerprint

2829

2930import Data.Binary

31+import Data.Bifunctor (second)

3032import Control.Monad

3133import Control.Monad.Trans.Class

3234import Control.Monad.Trans.Maybe

@@ -39,6 +41,7 @@ import Development.IDE.Core.FileExists

3941import Development.IDE.Core.FileStore (getFileContents)

4042import Development.IDE.Types.Diagnostics

4143import Development.IDE.Types.Location

44+import Development.IDE.GHC.Compat hiding (parseModule, typecheckModule)

4245import Development.IDE.GHC.Util

4346import Data.Coerce

4447import Data.Either.Extra

@@ -54,9 +57,7 @@ import Development.Shake hiding (Diagnostic)

5457import Development.IDE.Core.RuleTypes

5558import Development.IDE.Spans.Type

5659

57−import GHC hiding (parseModule, typecheckModule)

5860import qualified GHC.LanguageExtensions as LangExt

59−import Development.IDE.GHC.Compat (hie_file_result, readHieFile)

6061import UniqSupply

6162import NameCache

6263import HscTypes

@@ -176,7 +177,7 @@ getLocatedImportsRule =

176177-- imports recursively.

177178rawDependencyInformation :: NormalizedFilePath -> Action RawDependencyInformation

178179rawDependencyInformation f = do

179− let (initialId, initialMap) = getPathId f emptyPathIdMap

180+ let (initialId, initialMap) = getPathId (ArtifactsLocation $ ModLocation (Just $ fromNormalizedFilePath f) "" "") emptyPathIdMap

180181 go (IntSet.singleton $ getFilePathId initialId)

181182 (RawDependencyInformation IntMap.empty initialMap)

182183 where

@@ -194,7 +195,7 @@ rawDependencyInformation f = do

194195 let rawDepInfo' = insertImport fId (Left ModuleParseError) rawDepInfo

195196 in go fs rawDepInfo'

196197 Just (modImports, pkgImports) -> do

197− let f :: PathIdMap -> (a, Maybe NormalizedFilePath) -> (PathIdMap, (a, Maybe FilePathId))

198+ let f :: PathIdMap -> (a, Maybe ArtifactsLocation) -> (PathIdMap, (a, Maybe FilePathId))

198199 f pathMap (imp, mbPath) = case mbPath of

199200 Nothing -> (pathMap, (imp, Nothing))

200201 Just path ->

@@ -265,11 +266,11 @@ getSpanInfoRule :: Rules ()

265266getSpanInfoRule =

266267 define $ \GetSpanInfo file -> do

267268 tc <- use_ TypeCheck file

268− deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file

269+ deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file

269270 parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)

270271 (fileImports, _) <- use_ GetLocatedImports file

271272 packageState <- hscEnv <$> use_ GhcSession file

272− x <- liftIO $ getSrcSpanInfos packageState fileImports tc parsedDeps

273+ x <- liftIO $ getSrcSpanInfos packageState (fmap (second (fmap modLocationToNormalizedFilePath)) fileImports) tc parsedDeps

273274 return ([], Just x)

274275

275276-- Typechecks a module.

src/Development/IDE/GHC/Compat.hs+13−3

@@ -23,6 +23,8 @@ module Development.IDE.GHC.Compat(

2323 pattern ValD,

2424 pattern ClassOpSig,

2525 pattern IEThingWith,

26+ GHC.ModLocation,

27+ pattern ModLocation,

2628

2729 module GHC

2830 ) where

@@ -32,14 +34,14 @@ import DynFlags

3234import FieldLabel

3335

3436import qualified GHC

35−import GHC hiding (ClassOpSig, DerivD, ForD, IEThingWith, InstD, TyClD, ValD)

37+import GHC hiding (ClassOpSig, DerivD, ForD, IEThingWith, InstD, TyClD, ValD, ModLocation)

3638

3739#if MIN_GHC_API_VERSION(8,8,0)

3840import HieAst

3941import HieBin

4042import HieTypes

4143#else

42−import GhcPlugins

44+import GhcPlugins hiding (ModLocation)

4345import NameCache

4446import Avail

4547import TcRnTypes

@@ -136,4 +138,12 @@ pattern IEThingWith a b c d <-

136138 GHC.IEThingWith _ a b c d

137139#else

138140 GHC.IEThingWith a b c d

139−#endif

141+#endif

142+

143+pattern ModLocation :: Maybe FilePath -> FilePath -> FilePath -> GHC.ModLocation

144+pattern ModLocation a b c <-

145+#if MIN_GHC_API_VERSION(8,8,0)

146+ GHC.ModLocation a b c _ where ModLocation a b c = GHC.ModLocation a b c ""

147+#else

148+ GHC.ModLocation a b c where ModLocation a b c = GHC.ModLocation a b c

149+#endif

src/Development/IDE/Import/DependencyInformation.hs+71−13

@@ -9,6 +9,7 @@ module Development.IDE.Import.DependencyInformation

99 , ModuleParseError(..)

1010 , TransitiveDependencies(..)

1111 , FilePathId(..)

12+ , NamedModuleDep(..)

1213

1314 , PathIdMap

1415 , emptyPathIdMap

@@ -17,7 +18,7 @@ module Development.IDE.Import.DependencyInformation

1718 , pathToId

1819 , idToPath

1920 , reachableModules

20−

21+ , modLocationToNormalizedFilePath

2122 , processDependencyInformation

2223 , transitiveDeps

2324 ) where

@@ -46,6 +47,7 @@ import GHC.Generics (Generic)

4647

4748import Development.IDE.Types.Diagnostics

4849import Development.IDE.Types.Location

50+import Development.IDE.Import.FindImports (ArtifactsLocation(..))

4951

5052import GHC

5153import Module

@@ -67,27 +69,34 @@ newtype FilePathId = FilePathId { getFilePathId :: Int }

6769 deriving (Show, NFData, Eq, Ord)

6870

6971data PathIdMap = PathIdMap

70− { idToPathMap :: !(IntMap NormalizedFilePath)

72+ { idToPathMap :: !(IntMap ArtifactsLocation)

7173 , pathToIdMap :: !(HashMap NormalizedFilePath FilePathId)

7274 }

7375 deriving (Show, Generic)

7476

7577instance NFData PathIdMap

7678

79+modLocationToNormalizedFilePath :: ArtifactsLocation -> NormalizedFilePath

80+modLocationToNormalizedFilePath (ArtifactsLocation loc) =

81+ case ml_hs_file loc of

82+ Just filePath -> toNormalizedFilePath filePath

83+ -- Since we craete all 'ModLocation' values via 'mkHomeModLocation'

84+ Nothing -> error "Has something changed in mkHomeModLocation?"

85+

7786emptyPathIdMap :: PathIdMap

7887emptyPathIdMap = PathIdMap IntMap.empty HMS.empty

7988

80−getPathId :: NormalizedFilePath -> PathIdMap -> (FilePathId, PathIdMap)

89+getPathId :: ArtifactsLocation -> PathIdMap -> (FilePathId, PathIdMap)

8190getPathId path m@PathIdMap{..} =

82− case HMS.lookup path pathToIdMap of

91+ case HMS.lookup (modLocationToNormalizedFilePath path) pathToIdMap of

8392 Nothing ->

8493 let !newId = FilePathId $ HMS.size pathToIdMap

8594 in (newId, insertPathId path newId m)

8695 Just id -> (id, m)

8796

88−insertPathId :: NormalizedFilePath -> FilePathId -> PathIdMap -> PathIdMap

97+insertPathId :: ArtifactsLocation -> FilePathId -> PathIdMap -> PathIdMap

8998insertPathId path id PathIdMap{..} =

90− PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert path id pathToIdMap)

99+ PathIdMap (IntMap.insert (getFilePathId id) path idToPathMap) (HMS.insert (modLocationToNormalizedFilePath path) id pathToIdMap)

91100

92101insertImport :: FilePathId -> Either ModuleParseError ModuleImports -> RawDependencyInformation -> RawDependencyInformation

93102insertImport (FilePathId k) v rawDepInfo = rawDepInfo { rawImports = IntMap.insert k v (rawImports rawDepInfo) }

@@ -96,7 +105,11 @@ pathToId :: PathIdMap -> NormalizedFilePath -> FilePathId

96105pathToId PathIdMap{pathToIdMap} path = pathToIdMap HMS.! path

97106

98107idToPath :: PathIdMap -> FilePathId -> NormalizedFilePath

99−idToPath PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id

108+idToPath pathIdMap filePathId = modLocationToNormalizedFilePath $ idToModLocation pathIdMap filePathId

109+

110+idToModLocation :: PathIdMap -> FilePathId -> ArtifactsLocation

111+idToModLocation PathIdMap{idToPathMap} (FilePathId id) = idToPathMap IntMap.! id

112+

100113

101114-- | Unprocessed results that we find by following imports recursively.

102115data RawDependencyInformation = RawDependencyInformation

@@ -112,6 +125,7 @@ data DependencyInformation =

112125 DependencyInformation

113126 { depErrorNodes :: !(IntMap (NonEmpty NodeError))

114127 -- ^ Nodes that cannot be processed correctly.

128+ , depModuleNames :: !(IntMap ShowableModuleName)

115129 , depModuleDeps :: !(IntMap IntSet)

116130 -- ^ For a non-error node, this contains the set of module immediate dependencies

117131 -- in the same package.

@@ -120,6 +134,12 @@ data DependencyInformation =

120134 , depPathIdMap :: !PathIdMap

121135 } deriving (Show, Generic)

122136

137+newtype ShowableModuleName =

138+ ShowableModuleName {showableModuleName :: ModuleName}

139+ deriving NFData

140+

141+instance Show ShowableModuleName where show = moduleNameString . showableModuleName

142+

123143reachableModules :: DependencyInformation -> [NormalizedFilePath]

124144reachableModules DependencyInformation{..} =

125145 map (idToPath depPathIdMap . FilePathId) $ IntMap.keys depErrorNodes <> IntMap.keys depModuleDeps

@@ -186,16 +206,24 @@ processDependencyInformation rawDepInfo@RawDependencyInformation{..} =

186206 DependencyInformation

187207 { depErrorNodes = IntMap.fromList errorNodes

188208 , depModuleDeps = moduleDeps

209+ , depModuleNames = IntMap.fromList $ coerce moduleNames

189210 , depPkgDeps = pkgDependencies rawDepInfo

190211 , depPathIdMap = rawPathIdMap

191212 }

192213 where resultGraph = buildResultGraph rawImports

193214 (errorNodes, successNodes) = partitionNodeResults $ IntMap.toList resultGraph

215+ moduleNames :: [(FilePathId, ModuleName)]

216+ moduleNames =

217+ [ (fId, modName) | (_, imports) <- successNodes, (L _ modName, fId) <- imports]

194218 successEdges :: [(FilePathId, FilePathId, [FilePathId])]

195219 successEdges =

196− map (\(file, imports) -> (FilePathId file, FilePathId file, map snd imports)) successNodes

220+ map

221+ (\(file, imports) -> (FilePathId file, FilePathId file, map snd imports))

222+ successNodes

197223 moduleDeps =

198− IntMap.fromList $ map (\(_, FilePathId v, vs) -> (v, IntSet.fromList $ coerce vs)) successEdges

224+ IntMap.fromList $

225+ map (\(_, FilePathId v, vs) -> (v, IntSet.fromList $ coerce vs))

226+ successEdges

199227

200228-- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows:

201229-- 1. Mark each node that is part of an import cycle as an error node.

@@ -268,18 +296,27 @@ transitiveDeps DependencyInformation{..} file = do

268296 IntSet.delete (getFilePathId fileId) .

269297 IntSet.fromList . map (fst3 . fromVertex) .

270298 reachable g <$> toVertex (getFilePathId fileId)

271− let transitiveModuleDepIds = filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs

299+ let transitiveModuleDepIds =

300+ filter (\v -> v `IntSet.member` reachableVs) $ map (fst3 . fromVertex) vs

272301 let transitivePkgDeps =

273302 Set.toList $ Set.unions $

274303 map (\f -> IntMap.findWithDefault Set.empty f depPkgDeps) $

275304 getFilePathId fileId : transitiveModuleDepIds

276− let transitiveModuleDeps = map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds

305+ let transitiveModuleDeps =

306+ map (idToPath depPathIdMap . FilePathId) transitiveModuleDepIds

307+ let transitiveNamedModuleDeps =

308+ [ NamedModuleDep (idToPath depPathIdMap (FilePathId fid)) mn ml

309+ | (fid, ShowableModuleName mn) <- IntMap.toList depModuleNames

310+ , let ArtifactsLocation ml = idToPathMap depPathIdMap IntMap.! fid

311+ ]

277312 pure TransitiveDependencies {..}

278− where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, IntSet.toList fs)) $ IntMap.toList depModuleDeps)

279− vs = topSort g

313+ where

314+ (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, IntSet.toList fs)) $ IntMap.toList depModuleDeps)

315+ vs = topSort g

280316

281317data TransitiveDependencies = TransitiveDependencies

282318 { transitiveModuleDeps :: [NormalizedFilePath]

319+ , transitiveNamedModuleDeps :: [NamedModuleDep]

283320 -- ^ Transitive module dependencies in topological order.

284321 -- The module itself is not included.

285322 , transitivePkgDeps :: [InstalledUnitId]

@@ -287,3 +324,24 @@ data TransitiveDependencies = TransitiveDependencies

287324 } deriving (Eq, Show, Generic)

288325

289326instance NFData TransitiveDependencies

327+

328+data NamedModuleDep = NamedModuleDep {

329+ nmdFilePath :: !NormalizedFilePath,

330+ nmdModuleName :: !ModuleName,

331+ nmdModLocation :: !ModLocation

332+ }

333+ deriving Generic

334+

335+instance Eq NamedModuleDep where

336+ a == b = nmdFilePath a == nmdFilePath b

337+

338+instance NFData NamedModuleDep where

339+ rnf NamedModuleDep{..} =

340+ rnf nmdFilePath `seq`

341+ rnf nmdModuleName `seq`

342+ -- 'ModLocation' lacks an 'NFData' instance

343+ rwhnf nmdModLocation

344+

345+instance Show NamedModuleDep where

346+ show NamedModuleDep{..} = show nmdFilePath

347+

src/Development/IDE/Import/FindImports.hs+15−3

@@ -7,6 +7,7 @@

77module Development.IDE.Import.FindImports

88 ( locateModule

99 , Import(..)

10+ , ArtifactsLocation(..)

1011 ) where

1112

1213import Development.IDE.GHC.Error as ErrUtils

@@ -29,10 +30,16 @@ import Control.Monad.IO.Class

2930import System.FilePath

3031

3132data Import

32− = FileImport !NormalizedFilePath

33+ = FileImport !ArtifactsLocation

3334 | PackageImport !M.InstalledUnitId

3435 deriving (Show)

3536

37+newtype ArtifactsLocation = ArtifactsLocation ModLocation

38+ deriving (Show)

39+

40+instance NFData ArtifactsLocation where

41+ rnf = const ()

42+

3643instance NFData Import where

3744 rnf (FileImport x) = rnf x

3845 rnf (PackageImport x) = rnf x

@@ -74,7 +81,7 @@ locateModule dflags exts doesExist modName mbPkgName isSource = do

7481 mbFile <- locateModuleFile dflags exts doesExist isSource $ unLoc modName

7582 case mbFile of

7683 Nothing -> return $ Left $ notFoundErr dflags modName $ LookupNotFound []

77− Just file -> return $ Right $ FileImport file

84+ Just file -> toModLocation file

7885 -- if a package name is given we only go look for a package

7986 Just _pkgName -> lookupInPackageDB dflags

8087 Nothing -> do

@@ -83,8 +90,13 @@ locateModule dflags exts doesExist modName mbPkgName isSource = do

8390 mbFile <- locateModuleFile dflags exts doesExist isSource $ unLoc modName

8491 case mbFile of

8592 Nothing -> lookupInPackageDB dflags

86− Just file -> return $ Right $ FileImport file

93+ Just file -> toModLocation file

8794 where

95+ toModLocation file = liftIO $ do

96+ loc <- mkHomeModLocation dflags (unLoc modName) (fromNormalizedFilePath file)

97+ return $ Right $ FileImport $ ArtifactsLocation loc

98+

99+

88100 lookupInPackageDB dfs =

89101 case lookupModuleWithSuggestions dfs (unLoc modName) mbPkgName of

90102 LookupFound _m pkgConfig -> return $ Right $ PackageImport $ unitId pkgConfig

src/Development/IDE/Plugin/Completions.hs+1−1

@@ -31,7 +31,7 @@ plugin = Plugin produceCompletions setHandlersCompletion

3131produceCompletions :: Rules ()

3232produceCompletions =

3333 define $ \ProduceCompletions file -> do

34− deps <- maybe (TransitiveDependencies [] []) fst <$> useWithStale GetDependencies file

34+ deps <- maybe (TransitiveDependencies [] [] []) fst <$> useWithStale GetDependencies file

3535 parsedDeps <- mapMaybe (fmap fst) <$> usesWithStale GetParsedModule (transitiveModuleDeps deps)

3636 tm <- fmap fst <$> useWithStale TypeCheck file

3737 packageState <- fmap (hscEnv . fst) <$> useWithStale GhcSession file