diff --git a/src/Development/IDE/Core/RuleTypes.hs b/src/Development/IDE/Core/RuleTypes.hs index 571f1b1e..15d59be1 100644 --- a/src/Development/IDE/Core/RuleTypes.hs +++ b/src/Development/IDE/Core/RuleTypes.hs @@ -12,14 +12,16 @@ module Development.IDE.Core.RuleTypes( ) where import Control.DeepSeq -import Development.IDE.Import.FindImports (Import(..)) import Development.IDE.Import.DependencyInformation +import Development.IDE.Types.Location import Data.Hashable import Data.Typeable +import qualified Data.Set as S import Development.Shake hiding (Env, newCache) import GHC.Generics (Generic) import GHC +import Module (InstalledUnitId) import HscTypes (HomeModInfo) import Development.IDE.GHC.Compat @@ -66,9 +68,9 @@ type instance RuleResult GenerateCore = CoreModule -- | A GHC session that we reuse. type instance RuleResult GhcSession = HscEnv --- | Resolve the imports in a module to the list of either external packages or absolute file paths --- for modules in the same package. -type instance RuleResult GetLocatedImports = [(Located ModuleName, Maybe Import)] +-- | Resolve the imports in a module to the file path of a module +-- in the same package or the package id of another package. +type instance RuleResult GetLocatedImports = ([(Located ModuleName, Maybe NormalizedFilePath)], S.Set InstalledUnitId) -- | This rule is used to report import cycles. It depends on GetDependencyInformation. -- We cannot report the cycles directly from GetDependencyInformation since diff --git a/src/Development/IDE/Core/Rules.hs b/src/Development/IDE/Core/Rules.hs index 1ff2a008..fbcee332 100644 --- a/src/Development/IDE/Core/Rules.hs +++ b/src/Development/IDE/Core/Rules.hs @@ -36,7 +36,6 @@ import Development.IDE.Import.FindImports import Development.IDE.Core.FileStore import Development.IDE.Types.Diagnostics import Development.IDE.Types.Location -import Data.Bifunctor import Data.Either.Extra import Data.Maybe import Data.Foldable @@ -186,9 +185,20 @@ getLocatedImportsRule = env <- useNoFile_ GhcSession let dflags = addRelativeImport pm $ hsc_dflags env opt <- getIdeOptions - xs <- forM imports $ \(mbPkgName, modName) -> - (modName, ) <$> locateModule dflags (optExtensions opt) getFileExists modName mbPkgName - return (concat $ lefts $ map snd xs, Just $ map (second eitherToMaybe) xs) + (diags, imports') <- fmap unzip $ forM imports $ \(mbPkgName, modName) -> do + diagOrImp <- locateModule dflags (optExtensions opt) getFileExists modName mbPkgName + case diagOrImp of + Left diags -> pure (diags, Left (modName, Nothing)) + Right (FileImport path) -> pure ([], Left (modName, Just path)) + Right (PackageImport pkgId) -> liftIO $ do + diagsOrPkgDeps <- computePackageDeps env pkgId + case diagsOrPkgDeps of + Left diags -> pure (diags, Right Nothing) + Right pkgIds -> pure ([], Right $ Just $ pkgId : pkgIds) + let (moduleImports, pkgImports) = partitionEithers imports' + case sequence pkgImports of + Nothing -> pure (concat diags, Nothing) + Just pkgImports -> pure (concat diags, Just (moduleImports, Set.fromList $ concat pkgImports)) -- | Given a target file path, construct the raw dependency results by following @@ -204,19 +214,10 @@ rawDependencyInformation f = go (Set.singleton f) Map.empty Map.empty Nothing -> let modGraph' = Map.insert f (Left ModuleParseError) modGraph in go fs modGraph' pkgs - Just imports -> do - packageState <- lift $ useNoFile_ GhcSession - modOrPkgImports <- forM imports $ \imp -> do - case imp of - (_modName, Just (PackageImport pkg)) -> do - pkgs <- ExceptT $ liftIO $ computePackageDeps packageState pkg - pure $ Right $ pkg:pkgs - (modName, Just (FileImport absFile)) -> pure $ Left (modName, Just absFile) - (modName, Nothing) -> pure $ Left (modName, Nothing) - let (modImports, pkgImports) = partitionEithers modOrPkgImports + Just (modImports, pkgImports) -> do let newFiles = Set.fromList (mapMaybe snd modImports) Set.\\ Map.keysSet modGraph modGraph' = Map.insert f (Right modImports) modGraph - pkgs' = Map.insert f (Set.fromList $ concat pkgImports) pkgs + pkgs' = Map.insert f pkgImports pkgs go (fs `Set.union` newFiles) modGraph' pkgs' getDependencyInformationRule :: Rules () @@ -270,9 +271,9 @@ getSpanInfoRule :: Rules () getSpanInfoRule = define $ \GetSpanInfo file -> do tc <- use_ TypeCheck file - imports <- use_ GetLocatedImports file + (fileImports, _) <- use_ GetLocatedImports file packageState <- useNoFile_ GhcSession - x <- liftIO $ getSrcSpanInfos packageState (fileImports imports) tc + x <- liftIO $ getSrcSpanInfos packageState fileImports tc return ([], Just x) -- Typechecks a module. @@ -328,11 +329,3 @@ mainRule = do fileFromParsedModule :: ParsedModule -> NormalizedFilePath fileFromParsedModule = toNormalizedFilePath . ms_hspp_file . pm_mod_summary - -fileImports :: - [(Located ModuleName, Maybe Import)] - -> [(Located ModuleName, Maybe NormalizedFilePath)] -fileImports = mapMaybe $ \case - (modName, Nothing) -> Just (modName, Nothing) - (modName, Just (FileImport absFile)) -> Just (modName, Just absFile) - (_modName, Just (PackageImport _pkg)) -> Nothing diff --git a/src/Development/IDE/Import/DependencyInformation.hs b/src/Development/IDE/Import/DependencyInformation.hs index 8b69098d..b1587361 100644 --- a/src/Development/IDE/Import/DependencyInformation.hs +++ b/src/Development/IDE/Import/DependencyInformation.hs @@ -13,9 +13,9 @@ module Development.IDE.Import.DependencyInformation import Control.DeepSeq import Data.Bifunctor +import Data.List import Development.IDE.GHC.Orphans() import Data.Either -import Data.Foldable import Data.Graph import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.List.NonEmpty as NonEmpty @@ -113,20 +113,17 @@ instance Semigroup NodeResult where processDependencyInformation :: RawDependencyInformation -> DependencyInformation processDependencyInformation rawResults = DependencyInformation - { depErrorNodes = MS.mapMaybe errorNode resultGraph + { depErrorNodes = MS.fromList errorNodes , depModuleDeps = moduleDeps , depPkgDeps = pkgDependencies rawResults } where resultGraph = buildResultGraph rawResults + (errorNodes, successNodes) = partitionNodeResults $ MS.toList resultGraph successEdges :: [(NormalizedFilePath, NormalizedFilePath, [NormalizedFilePath])] - successEdges = map (\(k,ks) -> (k,k,ks)) $ MS.toList $ - MS.map (map snd) $ MS.mapMaybe successNode resultGraph + successEdges = + map (\(file, imports) -> (file, file, map snd imports)) successNodes moduleDeps = MS.fromList $ map (\(_, v, vs) -> (v, Set.fromList vs)) successEdges - errorNode (ErrorNode errs) = Just errs - errorNode _ = Nothing - successNode (SuccessNode fs) = Just fs - successNode _ = Nothing -- | Given a dependency graph, buildResultGraph detects and propagates errors in that graph as follows: -- 1. Mark each node that is part of an import cycle as an error node.