Commit b93ff3a3 authored by Simon Marlow's avatar Simon Marlow
Browse files

Remove most of the conflict checking and auto-hiding

Now that the module restriction has been lifted, the auto-hiding is
mostly not required.  GHC itself automatically hides old versions of a
package.
parent 61d2625a
......@@ -52,7 +52,7 @@ import System.IO.Error (try)
#else
import System.IO (try)
#endif
import Data.List ( isPrefixOf, isSuffixOf, intersperse, groupBy, sortBy )
import Data.List ( isPrefixOf, isSuffixOf, intersperse, sortBy )
#ifdef mingw32_HOST_OS
import Foreign
......@@ -400,8 +400,8 @@ registerPackage input defines flags auto_ghci_libs update force = do
putStrLn "done."
let pkg = resolveDeps db_stack pkg0
overlaps <- validatePackageConfig pkg db_stack auto_ghci_libs update force
new_details <- updatePackageDB db_stack overlaps (snd db_to_operate_on) pkg
validatePackageConfig pkg db_stack auto_ghci_libs update force
let new_details = snd db_to_operate_on ++ [pkg]
savePackageConfig db_filename
maybeRestoreOldConfig db_filename $
writeNewConfig db_filename new_details
......@@ -618,16 +618,15 @@ validatePackageConfig :: InstalledPackageInfo
-> Bool -- auto-ghc-libs
-> Bool -- update
-> Bool -- force
-> IO [PackageIdentifier]
-> IO ()
validatePackageConfig pkg db_stack auto_ghci_libs update force = do
checkPackageId pkg
overlaps <- checkDuplicates db_stack pkg update force
checkDuplicates db_stack pkg update force
mapM_ (checkDep db_stack force) (depends pkg)
mapM_ (checkDir force) (importDirs pkg)
mapM_ (checkDir force) (libraryDirs pkg)
mapM_ (checkDir force) (includeDirs pkg)
mapM_ (checkHSLib (libraryDirs pkg) auto_ghci_libs force) (hsLibraries pkg)
return overlaps
-- ToDo: check these somehow?
-- extra_libraries :: [String],
-- c_includes :: [String],
......@@ -671,7 +670,7 @@ resolveDeps db_stack p = updateDeps p
-- the version-less one
checkDuplicates :: PackageDBStack -> InstalledPackageInfo -> Bool -> Bool
-> IO [PackageIdentifier]
-> IO ()
checkDuplicates db_stack pkg update force = do
let
pkgid = package pkg
......@@ -682,103 +681,6 @@ checkDuplicates db_stack pkg update force = do
when (not update && (pkgid `elem` map package pkgs)) $
die ("package " ++ showPackageId pkgid ++ " is already installed")
--
-- 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 ]
checkDir :: Bool -> String -> IO ()
......@@ -850,30 +752,6 @@ autoBuildGHCiLib dir batch_file ghci_file = do
when (r /= ExitSuccess) $ exitWith r
hPutStrLn stderr (" done.")
-- -----------------------------------------------------------------------------
-- Updating the DB with the new package.
updatePackageDB
:: PackageDBStack -- the full stack
-> [PackageIdentifier] -- packages to hide
-> [InstalledPackageInfo] -- packages in *this* DB
-> InstalledPackageInfo -- the new package
-> IO [InstalledPackageInfo]
updatePackageDB db_stack to_hide pkgs new_pkg = do
let
pkgid = package new_pkg
pkgs' = [ maybe_hide p | p <- pkgs, package p /= pkgid ]
-- When update is on, and we're exposing the new package,
-- we hide any packages which conflict (see checkDuplicates)
-- in the current DB.
maybe_hide p
| exposed new_pkg && package p `elem` to_hide = p{ exposed = False }
| otherwise = p
--
return (pkgs'++ [new_pkg])
-- -----------------------------------------------------------------------------
-- Searching for modules
......@@ -1062,18 +940,6 @@ dieOrForce force s
| force = do hFlush stdout; hPutStrLn stderr (s ++ " (ignoring)")
| otherwise = die (s ++ " (use --force to override)")
diePretty :: Doc -> IO ()
diePretty doc = do
hFlush stdout
prog <- getProgramName
hPutStrLn stderr $ render $ (text prog <> colon $$ nest 2 doc)
exitWith (ExitFailure 1)
diePrettyOrForce :: Bool -> Doc -> IO ()
diePrettyOrForce force doc
| force = do hFlush stdout; hPutStrLn stderr (render (doc $$ text "(ignoring)"))
| otherwise = diePretty (doc $$ text "(use --force to override)")
-----------------------------------------
-- Cut and pasted from ghc/compiler/SysTools
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment