+-- -----------------------------------------------------------------------------
+-- Eliminate shadowed packages, giving the user some feedback
+
+-- later packages in the list should shadow earlier ones with the same
+-- package name/version. Additionally, a package may be preferred if
+-- it is in the transitive closure of packages selected using -package-id
+-- flags.
+shadowPackages :: [PackageConfig] -> [InstalledPackageId] -> UnusablePackages
+shadowPackages pkgs preferred
+ = let (shadowed,_) = foldl check ([],emptyUFM) pkgs
+ in listToFM shadowed
+ where
+ check (shadowed,pkgmap) pkg
+ | Just oldpkg <- lookupUFM pkgmap (packageConfigId pkg),
+ let
+ ipid_new = installedPackageId pkg
+ ipid_old = installedPackageId oldpkg,
+ --
+ ipid_old /= ipid_new
+ = if ipid_old `elem` preferred
+ then ( (ipid_new, ShadowedBy ipid_old) : shadowed, pkgmap )
+ else ( (ipid_old, ShadowedBy ipid_new) : shadowed, pkgmap' )
+ | otherwise
+ = (shadowed, pkgmap')
+ where
+ pkgmap' = addToUFM pkgmap (packageConfigId pkg) pkg
+
+-- -----------------------------------------------------------------------------
+
+ignorePackages :: [PackageFlag] -> [PackageConfig] -> UnusablePackages
+ignorePackages flags pkgs = listToFM (concatMap doit flags)
+ where
+ doit (IgnorePackage str) =
+ case partition (matchingStr str) pkgs of
+ (ps, _) -> [ (installedPackageId p, IgnoredWithFlag)
+ | p <- ps ]
+ -- missing package is not an error for -ignore-package,
+ -- because a common usage is to -ignore-package P as
+ -- a preventative measure just in case P exists.
+ doit _ = panic "ignorePackages"
+
+-- -----------------------------------------------------------------------------
+
+depClosure :: InstalledPackageIndex
+ -> [InstalledPackageId]
+ -> [InstalledPackageId]
+depClosure index ipids = closure emptyFM ipids
+ where
+ closure set [] = keysFM set
+ closure set (ipid : ipids)
+ | ipid `elemFM` set = closure set ipids
+ | Just p <- lookupFM index ipid = closure (addToFM set ipid p)
+ (depends p ++ ipids)
+ | otherwise = closure set ipids