- --
- -- Check whether any of the dependencies of the current package
- -- conflict with each other.
- --
- let
- all_pkgs = concat (map snd db_stack)
-
- allModules p = exposedModules p ++ hiddenModules p
-
- our_dependencies = closePackageDeps all_pkgs [pkg]
- all_dep_modules = concat (map (\p -> zip (allModules p) (repeat p))
- our_dependencies)
-
- overlaps = [ (m, map snd group)
- | group@((m,_):_) <- groupBy eqfst (sortBy cmpfst all_dep_modules),
- length group > 1 ]
- where eqfst (a,_) (b,_) = a == b
- cmpfst (a,_) (b,_) = a `compare` b
-
- when (not (null overlaps)) $
- diePrettyOrForce force $ vcat [
- text "package" <+> text (showPackageId (package pkg)) <+>
- text "has conflicting dependencies:",
- let complain_about (mod,ps) =
- text mod <+> text "is in the following packages:" <+>
- sep (map (text.showPackageId.package) ps)
- in
- nest 3 (vcat (map complain_about overlaps))
- ]
-
- --
- -- Now check whether exposing this package will result in conflicts, and
- -- Figure out which packages we need to hide to resolve the conflicts.
- --
- let
- closure_exposed_pkgs = closePackageDeps pkgs (filter exposed pkgs)
-
- new_dep_modules = concat $ map allModules $
- filter (\p -> package p `notElem`
- map package closure_exposed_pkgs) $
- our_dependencies
-
- pkgs_with_overlapping_modules =
- [ (p, overlapping_mods)
- | p <- closure_exposed_pkgs,
- let overlapping_mods =
- filter (`elem` new_dep_modules) (allModules p),
- (_:_) <- [overlapping_mods] --trick to get the non-empty ones
- ]
-
- to_hide = map package
- $ filter exposed
- $ closePackageDepsUpward pkgs
- $ map fst pkgs_with_overlapping_modules
-
- when (not update && exposed pkg && not (null pkgs_with_overlapping_modules)) $ do
- diePretty $ vcat [
- text "package" <+> text (showPackageId (package pkg)) <+>
- text "conflicts with the following packages, which are",
- text "either exposed or a dependency (direct or indirect) of an exposed package:",
- let complain_about (p, mods)
- = text (showPackageId (package p)) <+> text "contains modules" <+>
- sep (punctuate comma (map text mods)) in
- nest 3 (vcat (map complain_about pkgs_with_overlapping_modules)),
- text "Using 'update' instead of 'register' will cause the following packages",
- text "to be hidden, which will eliminate the conflict:",
- nest 3 (sep (map (text.showPackageId) to_hide))
- ]
-
- when (not (null to_hide)) $ do
- hPutStrLn stderr $ render $
- sep [text "Warning: hiding the following packages to avoid conflict: ",
- nest 2 (sep (map (text.showPackageId) to_hide))]
-
- return to_hide
-
-
-closure :: (a->[a]->Bool) -> (a -> [a]) -> [a] -> [a] -> [a]
-closure pred more [] res = res
-closure pred more (p:ps) res
- | p `pred` res = closure pred more ps res
- | otherwise = closure pred more (more p ++ ps) (p:res)
-
-closePackageDeps :: [InstalledPackageInfo] -> [InstalledPackageInfo]
- -> [InstalledPackageInfo]
-closePackageDeps db start
- = closure (\p ps -> package p `elem` map package ps) getDepends start []
- where
- getDepends p = [ pkg | dep <- depends p, pkg <- lookupPkg dep ]
- lookupPkg p = [ q | q <- db, p == package q ]
-
-closePackageDepsUpward :: [InstalledPackageInfo] -> [InstalledPackageInfo]
- -> [InstalledPackageInfo]
-closePackageDepsUpward db start
- = closure (\p ps -> package p `elem` map package ps) getUpwardDepends start []
- where
- getUpwardDepends p = [ pkg | pkg <- db, package p `elem` depends pkg ]