@@ -3,6 +3,7 @@
33
44module Development.IDE.Import.DependencyInformation
55 ( DependencyInformation(..)
6+ , ModuleImports(..)
67 , RawDependencyInformation(..)
78 , NodeError(..)
89 , ModuleParseError(..)
@@ -34,13 +35,22 @@ import Development.IDE.Types.Location
3435import GHC
3536import Module
3637
37−-- | Unprocessed results that we get from following all imports recursively starting from a module.
38−data RawDependencyInformation = RawDependencyInformation
39− { moduleDependencies :: Map NormalizedFilePath (Either ModuleParseError [(Located ModuleName, Maybe NormalizedFilePath)])
40− , pkgDependencies :: Map NormalizedFilePath (Set InstalledUnitId)
41− -- ^ Transitive dependencies on pkgs of this file, i.e. immidiate package dependencies and the
42− -- transitive package dependencies of those packages.
43− }
38+-- | The imports for a given module.
39+data ModuleImports = ModuleImports
40+ { moduleImports :: ![(Located ModuleName, Maybe NormalizedFilePath)]
41+ -- ^ Imports of a module in the current package and the file path of
42+ -- that module on disk (if we found it)
43+ , packageImports :: !(Set InstalledUnitId)
44+ -- ^ Transitive package dependencies unioned for all imports.
45+ }
46+
47+-- | Unprocessed results that we find by following imports recursively.
48+newtype RawDependencyInformation = RawDependencyInformation
49+ { getRawDeps :: Map NormalizedFilePath (Either ModuleParseError ModuleImports)
50+ }
51+
52+pkgDependencies :: RawDependencyInformation -> Map NormalizedFilePath (Set InstalledUnitId)
53+pkgDependencies (RawDependencyInformation m) = MS.map (either (const Set.empty) packageImports) m
4454
4555data DependencyInformation =
4656 DependencyInformation
@@ -144,13 +154,13 @@ buildResultGraph g = propagatedErrors
144154 cycleErrorsForFile cycle f =
145155 let entryPoints = mapMaybe (findImport f) cycle
146156 in map (\imp -> (f, ErrorNode (PartOfCycle imp cycle :| []))) entryPoints
147− otherErrors = MS.map otherErrorsForFile (moduleDependencies g)
148− otherErrorsForFile :: Either ModuleParseError [(Located ModuleName, Maybe NormalizedFilePath)] -> NodeResult
157+ otherErrors = MS.map otherErrorsForFile (getRawDeps g)
158+ otherErrorsForFile :: Either ModuleParseError ModuleImports -> NodeResult
149159 otherErrorsForFile (Left err) = ErrorNode (ParseError err :| [])
150− otherErrorsForFile (Right imports) =
160+ otherErrorsForFile (Right ModuleImports{moduleImports}) =
151161 let toEither (imp, Nothing) = Left imp
152162 toEither (imp, Just path) = Right (imp, path)
153− (errs, imports') = partitionEithers (map toEither imports)
163+ (errs, imports') = partitionEithers (map toEither moduleImports)
154164 in case nonEmpty errs of
155165 Nothing -> SuccessNode imports'
156166 Just errs' -> ErrorNode (NonEmpty.map FailedToLocateImport errs')
@@ -172,17 +182,17 @@ buildResultGraph g = propagatedErrors
172182 Just errs' -> ErrorNode (NonEmpty.map (ParentOfErrorNode . fst) errs')
173183 findImport :: NormalizedFilePath -> NormalizedFilePath -> Maybe (Located ModuleName)
174184 findImport file importedFile =
175− case moduleDependencies g MS.! file of
185+ case getRawDeps g MS.! file of
176186 Left _ -> error "Tried to call findImport on a module with a parse error"
177− Right imports ->
178− fmap fst $ find (\(_, resolvedImp) -> resolvedImp == Just importedFile) imports
187+ Right ModuleImports{moduleImports} ->
188+ fmap fst $ find (\(_, resolvedImp) -> resolvedImp == Just importedFile) moduleImports
179189
180190graphEdges :: RawDependencyInformation -> [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])]
181191graphEdges g =
182− map (\(k, ks) -> (k, k, ks)) $ MS.toList $ MS.map deps $ moduleDependencies g
183− where deps :: Either e [(i, Maybe NormalizedFilePath)] -> [NormalizedFilePath]
192+ map (\(k, v) -> (k, k, deps v)) $ MS.toList $ getRawDeps g
193+ where deps :: Either e ModuleImports -> [NormalizedFilePath]
184194 deps (Left _) = []
185− deps (Right imports) = mapMaybe snd imports
195+ deps (Right ModuleImports{moduleImports}) = mapMaybe snd moduleImports
186196
187197partitionSCC :: [SCC a] -> ([a], [[a]])
188198partitionSCC (CyclicSCC xs:rest) = second (xs:) $ partitionSCC rest
@@ -193,7 +203,7 @@ transitiveDeps :: DependencyInformation -> NormalizedFilePath -> Maybe Transitiv
193203transitiveDeps DependencyInformation{..} f = do
194204 reachableVs <- Set.delete f . Set.fromList . map (fst3 . fromVertex) . reachable g <$> toVertex f
195205 let transitiveModuleDeps = filter (\v -> v `Set.member` reachableVs) $ map (fst3 . fromVertex) vs
196− let transitivePkgDeps = Set.toList $ foldMap (\f -> MS.findWithDefault Set.empty f depPkgDeps) (f : transitiveModuleDeps)
206+ let transitivePkgDeps = Set.toList $ Set.unions $ map (\f -> MS.findWithDefault Set.empty f depPkgDeps) (f : transitiveModuleDeps)
197207 pure TransitiveDependencies {..}
198208 where (g, fromVertex, toVertex) = graphFromEdges (map (\(f, fs) -> (f, f, Set.toList fs)) $ MS.toList depModuleDeps)
199209 vs = topSort g