diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index cf85de0783b..3dcd80dcfbe 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -147,6 +147,8 @@ import Data.Maybe ( isNothing, catMaybes, fromMaybe ) import Data.Monoid ( Monoid(..) ) +import qualified Data.Map as Map +import Data.Map (Map) import System.Directory ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory ) import System.FilePath @@ -158,7 +160,8 @@ import System.IO import Distribution.Text ( Text(disp), display, simpleParse ) import Text.PrettyPrint - ( comma, punctuate, render, nest, sep, parens, (<>), (<+>) ) + ( render, (<>), ($+$), char, text, comma + , quotes, punctuate, nest, sep, hsep ) import Distribution.Compat.Exception ( catchExit, catchIO ) import qualified Data.ByteString.Lazy.Char8 as BS.Char8 @@ -352,11 +355,10 @@ configure (pkg_descr0, pbi) cfg pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests , condBenchmarks = flaggedBenchmarks } - constraintsAndMap = getConstraintsAndMap cfg installedPackageSet - - (allConstraints, idConstraintMap) <- case constraintsAndMap of - Left err -> die err - Right ok -> return ok + (allConstraints, requiredDepsMap) <- either die return $ + combinedConstraints (configConstraints cfg) + (configDependencies cfg) + installedPackageSet (pkg_descr0', flags) <- case finalizePackageDescription @@ -391,10 +393,11 @@ configure (pkg_descr0, pbi) cfg ([FailedDependency], [ResolvedDependency]) selectDependencies = (\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ])) - . map (selectDependency internalPackageSet installedPackageSet idConstraintMap) + . map (selectDependency internalPackageSet installedPackageSet + requiredDepsMap) (failedDeps, allPkgDeps) = - selectDependencies $ buildDepends pkg_descr + selectDependencies (buildDepends pkg_descr) internalPkgDeps = [ pkgid | InternalDependency _ pkgid <- allPkgDeps ] @@ -628,12 +631,11 @@ data FailedDependency = DependencyNotExists PackageName -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageIndex -- ^ Internally defined packages -> PackageIndex -- ^ Installed packages - -> [(Dependency, InstalledPackageInfo)] - -- ^ The exact id and their equivalent constraint - -- where it is known + -> Map PackageName InstalledPackageInfo + -- ^ Packages for which we have been given specific deps to use -> Dependency -> Either FailedDependency ResolvedDependency -selectDependency internalIndex installedIndex exactIds +selectDependency internalIndex installedIndex requiredDepsMap dep@(Dependency pkgname vr) = -- If the dependency specification matches anything in the internal package -- index, then we prefer that match to anything in the second. @@ -656,14 +658,14 @@ selectDependency internalIndex installedIndex exactIds _ -> case PackageIndex.lookupDependency installedIndex dep of [] -> Left $ DependencyNotExists pkgname pkgs -> Right $ ExternalDependency dep $ - case lookup dep exactIds of + case Map.lookup pkgname requiredDepsMap of + -- if we know the exact pkg to use then use it + Just pkginstance -> pkginstance + -- otherwise we just pick an arbirary instance of the + -- latest version Nothing -> - -- by default we just pick the latest case last pkgs of - (_ver, instances) -> head instances -- the first preference - Just instPkgInfo -> - -- if we know the exact id then use it - instPkgInfo + (_ver, pkginstances) -> head pkginstances reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () @@ -754,77 +756,78 @@ newPackageDepsBehaviour :: PackageDescription -> Bool newPackageDepsBehaviour pkg = specVersion pkg >= newPackageDepsBehaviourMinVersion -getConstraintsAndMap :: ConfigFlags -> - PackageIndex -> - Either String ([Dependency], [(Dependency, InstalledPackageInfo)]) -getConstraintsAndMap cfg installedPackageSet = - - if not $ null badInstalledPackageIds - then Left $ "The following dependencies do not exist:\n" ++ - (render $ nest 4 $ sep $ punctuate comma $ map disp badInstalledPackageIds) - else if not $ null badNames - then Left $ "The following names do match their hash name:\n" ++ - (let dispPair (x, y) = parens (disp x <> comma <+> disp y) in - render $ nest 4 $ sep $ punctuate comma $ map dispPair badNames) - else Right (allConstraints, idConstraintMap) +-- We are given both --constraint="foo < 2.0" style constraints and also +-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581". +-- +-- When finalising the package we have to take into account the specific +-- installed deps we've been given, and the finalise function expects +-- constraints, so we have to translate these deps into version constraints. +-- +-- But after finalising we then have to make sure we pick the right specific +-- deps in the end. So we still need to remember which installed packages to +-- pick. +combinedConstraints :: [Dependency] -> + [(PackageName, InstalledPackageId)] -> + PackageIndex -> + Either String ([Dependency], + Map PackageName InstalledPackageInfo) +combinedConstraints constraints dependencies installedPackages = do + + when (not (null badInstalledPackageIds)) $ + Left $ render $ text "The following package dependencies were requested" + $+$ nest 4 (dispDependencies badInstalledPackageIds) + $+$ text "however the given installed package instance does not exist." + + when (not (null badNames)) $ + Left $ render $ text "The following package dependencies were requested" + $+$ nest 4 (dispDependencies badNames) + $+$ text "however the installed package's name does not match the name given." + + --TODO: we don't check that all dependencies are used! + + return (allConstraints, idConstraintMap) where - - givenDependencies :: [InstalledPackageId] - givenDependencies = map snd $ configDependencies cfg - - givenNames :: [PackageName] - givenNames = map fst $ configDependencies cfg - - mGivenPackageInfos :: [Maybe InstalledPackageInfo] - mGivenPackageInfos = - map (PackageIndex.lookupInstalledPackageId installedPackageSet) - givenDependencies - - derivedNames :: [Maybe PackageName] - derivedNames = map (fmap (pkgName . packageId)) mGivenPackageInfos - - -- If someone has written e.g. - -- dependency="foo=MyOtherLib-1.0-07...5bf30" then they have - -- probably made a mistake. - badNames :: [(PackageName, PackageName)] - badNames = filter (uncurry (/=)) $ - catMaybes $ - map f $ - zip givenNames derivedNames - where - f :: Monad m => (a, m b) -> m (a, b) - f (a, mb) = mb >>= \b -> return (a, b) - - givenPackageInfos :: [InstalledPackageInfo] - givenPackageInfos = catMaybes mGivenPackageInfos - - givenConstraints :: [Dependency] - givenConstraints = - map thisPackageVersion $ - map sourcePackageId $ - givenPackageInfos - - idConstraintMap :: [(Dependency, InstalledPackageInfo)] - idConstraintMap = zip givenConstraints givenPackageInfos + allConstraints :: [Dependency] + allConstraints = constraints + ++ [ thisPackageVersion (packageId pkg) + | (_, _, Just pkg) <- dependenciesPkgInfo ] + + idConstraintMap :: Map PackageName InstalledPackageInfo + idConstraintMap = Map.fromList + [ (packageName pkg, pkg) + | (_, _, Just pkg) <- dependenciesPkgInfo ] + + -- The dependencies along with the installed package info, if it exists + dependenciesPkgInfo :: [(PackageName, InstalledPackageId, + Maybe InstalledPackageInfo)] + dependenciesPkgInfo = + [ (pkgname, ipkgid, mpkg) + | (pkgname, ipkgid) <- dependencies + , let mpkg = PackageIndex.lookupInstalledPackageId + installedPackages ipkgid + ] -- If we looked up a package specified by an installed package id -- (i.e. someone has written a hash) and didn't find it then it's -- an error. - badInstalledPackageIds :: [InstalledPackageId] - badInstalledPackageIds = map snd $ - filter (isNothing . fst) $ - zip mGivenPackageInfos givenDependencies - - -- Note these can be from the .cabal file as well as from - -- the command line. - specifiedConstraints :: [Dependency] - specifiedConstraints = configConstraints cfg - - allConstraints :: [Dependency] - allConstraints = givenConstraints ++ - specifiedConstraints + badInstalledPackageIds = + [ (pkgname, ipkgid) + | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ] + -- If someone has written e.g. + -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have + -- probably made a mistake. + badNames = + [ (requestedPkgName, ipkgid) + | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo + , let foundPkgName = packageName pkg + , requestedPkgName /= foundPkgName ] + + dispDependencies deps = + hsep [ text "--dependency=" + <> quotes (disp pkgname <> char '=' <> disp ipkgid) + | (pkgname, ipkgid) <- deps ] -- ----------------------------------------------------------------------------- -- Configuring program dependencies