- text "package" <+> text (showPackageId pid) <+> text "has missing dependencies:"
- $$ nest 4 (fsep (punctuate comma (map (text . showPackageId) deps)))
-
-missingPackageDeps :: InstalledPackageInfo
- -> [(PackageIdentifier, InstalledPackageInfo)]
- -> [PackageIdentifier]
-missingPackageDeps pkg pkg_map =
- [ d | d <- depends pkg, isNothing (lookup d pkg_map)] ++
- [ d | d <- depends pkg, Just p <- return (lookup d pkg_map),
- isBrokenPackage p pkg_map]
-
-isBrokenPackage :: InstalledPackageInfo -> [(PackageIdentifier, InstalledPackageInfo)] -> Bool
-isBrokenPackage pkg pkg_map
- = not . null $ missingPackageDeps pkg (filter notme pkg_map)
- where notme (p,ipi) = package pkg /= p
- -- remove p from the database when we invoke missingPackageDeps,
- -- because we want mutually recursive groups of package to show up
+ text "package" <+> text (display pid) <+> text "has missing dependencies:"
+ $$ nest 4 (fsep (punctuate comma (map (text . display) deps)))
+
+
+brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]
+brokenPackages pkgs = go [] pkgs
+ where
+ go avail not_avail =
+ case partition (depsAvailable avail) not_avail of
+ ([], not_avail) -> not_avail
+ (new_avail, not_avail) -> go (new_avail ++ avail) not_avail
+
+ depsAvailable :: [InstalledPackageInfo] -> InstalledPackageInfo
+ -> Bool
+ depsAvailable pkgs_ok pkg = null dangling
+ where dangling = filter (`notElem` pids) (depends pkg)
+ pids = map package pkgs_ok
+
+ -- we want mutually recursive groups of package to show up