| ... |
... |
@@ -1826,7 +1826,7 @@ checkConsistency verbosity my_flags = do |
|
1826
|
1826
|
all_ps = map mungedId pkgs1
|
|
1827
|
1827
|
|
|
1828
|
1828
|
let not_broken_pkgs = filterOut broken_pkgs pkgs
|
|
1829
|
|
- (_, trans_broken_pkgs) = closure [] not_broken_pkgs
|
|
|
1829
|
+ trans_broken_pkgs = brokenPackages not_broken_pkgs
|
|
1830
|
1830
|
|
|
1831
|
1831
|
all_broken_pkgs :: [InstalledPackageInfo]
|
|
1832
|
1832
|
all_broken_pkgs = broken_pkgs ++ trans_broken_pkgs
|
| ... |
... |
@@ -1845,34 +1845,30 @@ checkConsistency verbosity my_flags = do |
|
1845
|
1845
|
when (not (null all_broken_pkgs)) $ exitWith (ExitFailure 1)
|
|
1846
|
1846
|
|
|
1847
|
1847
|
|
|
1848
|
|
-closure :: [InstalledPackageInfo] -> [InstalledPackageInfo]
|
|
1849
|
|
- -> ([InstalledPackageInfo], [InstalledPackageInfo])
|
|
1850
|
|
-closure pkgs db_stack = go (pkgs, pkg_ids) db_stack
|
|
|
1848
|
+-- | Compute the set of transitive broken packages.
|
|
|
1849
|
+--
|
|
|
1850
|
+-- A package is assumed to be broken if any of its dependencies is not
|
|
|
1851
|
+-- found in the 'db_stack' after a transitive reduction.
|
|
|
1852
|
+brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]
|
|
|
1853
|
+brokenPackages db_stack = go Set.empty db_stack
|
|
1851
|
1854
|
where
|
|
1852
|
|
- pkg_ids = Set.fromList $ map installedUnitId pkgs
|
|
1853
|
|
- go (avail, avail_ids) not_avail =
|
|
|
1855
|
+ go avail_ids not_avail =
|
|
1854
|
1856
|
case partition (depsAvailable avail_ids) not_avail of
|
|
1855
|
1857
|
([], not_avail') ->
|
|
1856
|
|
- (avail, not_avail')
|
|
|
1858
|
+ not_avail'
|
|
1857
|
1859
|
(new_avail, not_avail') ->
|
|
1858
|
1860
|
let
|
|
1859
|
1861
|
all_pkg_ids =
|
|
1860
|
1862
|
foldl' (flip Set.insert) avail_ids (map installedUnitId new_avail)
|
|
1861
|
1863
|
in
|
|
1862
|
|
- go (new_avail ++ avail, all_pkg_ids) not_avail'
|
|
1863
|
|
-
|
|
|
1864
|
+ go all_pkg_ids not_avail'
|
|
1864
|
1865
|
|
|
1865
|
|
- depsAvailable :: Set.Set UnitId -> InstalledPackageInfo
|
|
1866
|
|
- -> Bool
|
|
1867
|
|
- depsAvailable pids pkg = null dangling
|
|
1868
|
|
- where dangling = filter (`Set.notMember` pids) (depends pkg)
|
|
|
1866
|
+ depsAvailable :: Set.Set UnitId -> InstalledPackageInfo -> Bool
|
|
|
1867
|
+ depsAvailable pids pkg = all (`Set.member` pids) (depends pkg)
|
|
1869
|
1868
|
|
|
1870
|
1869
|
-- we want mutually recursive groups of package to show up
|
|
1871
|
1870
|
-- as broken. (#1750)
|
|
1872
|
1871
|
|
|
1873
|
|
-brokenPackages :: [InstalledPackageInfo] -> [InstalledPackageInfo]
|
|
1874
|
|
-brokenPackages pkgs = snd (closure [] pkgs)
|
|
1875
|
|
-
|
|
1876
|
1872
|
-----------------------------------------------------------------------------
|
|
1877
|
1873
|
-- Sanity-check a new package config, and automatically build GHCi libs
|
|
1878
|
1874
|
-- if requested.
|