diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 18427490dbc..e86ad21d96f 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -27,6 +27,7 @@ import Distribution.Client.InstallPlan (InstallPlan) import Distribution.Client.IndexUtils as IndexUtils ( getSourcePackages, getInstalledPackages ) import Distribution.Client.PackageIndex ( PackageIndex, elemByPackageName ) +import Distribution.Client.PkgConfigDb (PkgConfigDb, readPkgConfigDb) import Distribution.Client.Setup ( ConfigExFlags(..), configureCommand, filterConfigureFlags , RepoContext(..) ) @@ -110,11 +111,13 @@ configure verbosity packageDBs repoCtxt comp platform conf installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf sourcePkgDb <- getSourcePackages verbosity repoCtxt + pkgConfigDb <- readPkgConfigDb verbosity conf + checkConfigExFlags verbosity installedPkgIndex (packageIndex sourcePkgDb) configExFlags progress <- planLocalPackage verbosity comp platform configFlags configExFlags - installedPkgIndex sourcePkgDb + installedPkgIndex sourcePkgDb pkgConfigDb notice verbosity "Resolving dependencies..." maybePlan <- foldProgress logMsg (return . Left) (return . Right) @@ -269,10 +272,10 @@ planLocalPackage :: Verbosity -> Compiler -> ConfigFlags -> ConfigExFlags -> InstalledPackageIndex -> SourcePackageDb + -> PkgConfigDb -> IO (Progress String String InstallPlan) planLocalPackage verbosity comp platform configFlags configExFlags - installedPkgIndex - (SourcePackageDb _ packagePrefs) = do + installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags) (compilerInfo comp) @@ -326,7 +329,7 @@ planLocalPackage verbosity comp platform configFlags configExFlags (SourcePackageDb mempty packagePrefs) [SpecificSourcePackage localPkg] - return (resolveDependencies platform (compilerInfo comp) solver resolverParams) + return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams) -- | Call an installer for an 'SourcePackage' but override the configure diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index 98e0e7c46c0..32ce933f310 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -69,6 +69,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex) import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.InstallPlan (InstallPlan) +import Distribution.Client.PkgConfigDb (PkgConfigDb) import Distribution.Client.Types ( SourcePackageDb(SourcePackageDb), SourcePackage(..) , ConfiguredPackage(..), ConfiguredId(..) @@ -523,25 +524,26 @@ runSolver Modular = modularResolver -- resolveDependencies :: Platform -> CompilerInfo + -> PkgConfigDb -> Solver -> DepResolverParams -> Progress String String InstallPlan --TODO: is this needed here? see dontUpgradeNonUpgradeablePackages -resolveDependencies platform comp _solver params +resolveDependencies platform comp _pkgConfigDB _solver params | null (depResolverTargets params) = return (validateSolverResult platform comp indGoals []) where indGoals = depResolverIndependentGoals params -resolveDependencies platform comp solver params = +resolveDependencies platform comp pkgConfigDB solver params = Step (showDepResolverParams finalparams) $ fmap (validateSolverResult platform comp indGoals) $ runSolver solver (SolverConfig reorderGoals indGoals noReinstalls shadowing strFlags maxBkjumps) platform comp installedPkgIndex sourcePkgIndex - preferences constraints targets + pkgConfigDB preferences constraints targets where finalparams @ (DepResolverParams diff --git a/cabal-install/Distribution/Client/Dependency/Modular.hs b/cabal-install/Distribution/Client/Dependency/Modular.hs index 4f356dcf173..912ee763977 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular.hs @@ -34,10 +34,10 @@ import Distribution.System -- | Ties the two worlds together: classic cabal-install vs. the modular -- solver. Performs the necessary translations before and after. modularResolver :: SolverConfig -> DependencyResolver -modularResolver sc (Platform arch os) cinfo iidx sidx pprefs pcs pns = +modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns = fmap (uncurry postprocess) $ -- convert install plan logToProgress (maxBackjumps sc) $ -- convert log format into progress format - solve sc cinfo idx pprefs gcs pns + solve sc cinfo idx pkgConfigDB pprefs gcs pns where -- Indices have to be converted into solver-specific uniform index. idx = convPIs os arch cinfo (shadowPkgs sc) (strongFlags sc) iidx sidx diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs index a4d027fa3c8..d13762bea5d 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs @@ -27,6 +27,7 @@ import Distribution.Client.Dependency.Modular.Configured import Distribution.Client.Dependency.Modular.Dependency import Distribution.Client.Dependency.Modular.Flag import Distribution.Client.Dependency.Modular.Package +import Distribution.Client.Dependency.Modular.Version -- | A (partial) package assignment. Qualified package names -- are associated with instances. @@ -62,9 +63,10 @@ data PreAssignment = PA PPreAssignment FAssignment SAssignment -- or the successfully extended assignment. extend :: (Extension -> Bool) -- ^ is a given extension supported -> (Language -> Bool) -- ^ is a given language supported + -> (PN -> VR -> Bool) -- ^ is a given pkg-config requirement satisfiable -> Goal QPN -> PPreAssignment -> [Dep QPN] -> Either (ConflictSet QPN, [Dep QPN]) PPreAssignment -extend extSupported langSupported goal@(Goal var _) = foldM extendSingle +extend extSupported langSupported pkgPresent goal@(Goal var _) = foldM extendSingle where extendSingle :: PPreAssignment -> Dep QPN @@ -75,6 +77,9 @@ extend extSupported langSupported goal@(Goal var _) = foldM extendSingle extendSingle a (Lang lang) = if langSupported lang then Right a else Left (toConflictSet goal, [Lang lang]) + extendSingle a (Pkg pn vr) = + if pkgPresent pn vr then Right a + else Left (toConflictSet goal, [Pkg pn vr]) extendSingle a (Dep qpn ci) = let ci' = M.findWithDefault (Constrained []) qpn a in case (\ x -> M.insert qpn x a) <$> merge ci' ci of diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs index cb28f6a371c..2bea5b80afe 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Builder.hs @@ -61,6 +61,7 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs -- code above is correct; insert/adjust have different arg order go g o ( (OpenGoal (Simple (Ext _ext ) _) _gr) : ngs) = go g o ngs go g o ( (OpenGoal (Simple (Lang _lang)_) _gr) : ngs) = go g o ngs + go g o ( (OpenGoal (Simple (Pkg _pn _vr)_) _gr) : ngs)= go g o ngs cons' = P.cons . forgetCompOpenGoal @@ -121,6 +122,8 @@ build = ana go error "Distribution.Client.Dependency.Modular.Builder: build.go called with Ext goal" go (BS { index = _ , next = OneGoal (OpenGoal (Simple (Lang _ ) _) _ ) }) = error "Distribution.Client.Dependency.Modular.Builder: build.go called with Lang goal" + go (BS { index = _ , next = OneGoal (OpenGoal (Simple (Pkg _ _ ) _) _ ) }) = + error "Distribution.Client.Dependency.Modular.Builder: build.go called with Pkg goal" go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _) _) gr) }) = case M.lookup pn idx of Nothing -> FailF (toConflictSet (Goal (P qpn) gr)) (BuildFailureNotInIndex pn) diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs index 226b6a70ea3..b352d1e1a34 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs @@ -198,6 +198,7 @@ type FalseFlaggedDeps qpn = FlaggedDeps Component qpn data Dep qpn = Dep qpn (CI qpn) -- dependency on a package | Ext Extension -- dependency on a language extension | Lang Language -- dependency on a language version + | Pkg PN VR -- dependency on a pkg-config package deriving (Eq, Show) showDep :: Dep QPN -> String @@ -210,6 +211,9 @@ showDep (Dep qpn ci ) = showQPN qpn ++ showCI ci showDep (Ext ext) = "requires " ++ display ext showDep (Lang lang) = "requires " ++ display lang +showDep (Pkg pn vr) = "requires pkg-config package " + ++ display pn ++ display vr + ++ ", not found in the pkg-config database" -- | Options for goal qualification (used in 'qualifyDeps') -- @@ -253,6 +257,7 @@ qualifyDeps QO{..} (Q pp' pn) = go goD :: Dep PN -> Component -> Dep QPN goD (Ext ext) _ = Ext ext goD (Lang lang) _ = Lang lang + goD (Pkg pkn vr) _ = Pkg pkn vr goD (Dep dep ci) comp | qBase dep = Dep (Q (Base pn pp) dep) (fmap (Q pp) ci) | qSetup comp = Dep (Q (Setup pn pp) dep) (fmap (Q pp) ci) @@ -337,6 +342,7 @@ instance ResetGoal Dep where resetGoal g (Dep qpn ci) = Dep qpn (resetGoal g ci) resetGoal _ (Ext ext) = Ext ext resetGoal _ (Lang lang) = Lang lang + resetGoal _ (Pkg pn vr) = Pkg pn vr instance ResetGoal Goal where resetGoal = const @@ -376,6 +382,8 @@ close (OpenGoal (Simple (Ext _) _) _ ) = error "Distribution.Client.Dependency.Modular.Dependency.close: called on Ext goal" close (OpenGoal (Simple (Lang _) _) _ ) = error "Distribution.Client.Dependency.Modular.Dependency.close: called on Lang goal" +close (OpenGoal (Simple (Pkg _ _) _) _ ) = + error "Distribution.Client.Dependency.Modular.Dependency.close: called on Pkg goal" close (OpenGoal (Flagged qfn _ _ _ ) gr) = Goal (F qfn) gr close (OpenGoal (Stanza qsn _) gr) = Goal (S qsn) gr diff --git a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs index 1b26d7fd700..d0bb636b0d8 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs @@ -143,6 +143,7 @@ convCondTree os arch cinfo pi@(PI pn _) fds comp getInfo (CondNode info ds branc L.map (\d -> D.Simple (convDep pn d) comp) ds -- unconditional package dependencies ++ L.map (\e -> D.Simple (Ext e) comp) (PD.allExtensions bi) -- unconditional extension dependencies ++ L.map (\l -> D.Simple (Lang l) comp) (PD.allLanguages bi) -- unconditional language dependencies + ++ L.map (\(Dependency pkn vr) -> D.Simple (Pkg pkn vr) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies ++ concatMap (convBranch os arch cinfo pi fds comp getInfo) branches where bi = getInfo info diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs b/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs index 0b0a5ef6038..1bc1c7abf9e 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Linking.hs @@ -278,6 +278,8 @@ linkDeps parents pp' = mapM_ go -- No choice is involved, just checking, so there is nothing to link. go (Simple (Ext _) _) = return () go (Simple (Lang _) _) = return () + -- Similarly for pkg-config constraints + go (Simple (Pkg _ _) _) = return () go (Flagged fn _ t f) = do vs <- get case M.lookup fn (vsFlags vs) of diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs index 7696480e4a7..08b9637896d 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Solver.hs @@ -7,6 +7,8 @@ import Data.Map as M import Distribution.Compiler (CompilerInfo) +import Distribution.Client.PkgConfigDb (PkgConfigDb) + import Distribution.Client.Dependency.Types import Distribution.Client.Dependency.Modular.Assignment @@ -60,11 +62,12 @@ data SolverConfig = SolverConfig { solve :: SolverConfig -> -- ^ solver parameters CompilerInfo -> Index -> -- ^ all available packages as an index + PkgConfigDb -> -- ^ available pkg-config pkgs (PN -> PackagePreferences) -> -- ^ preferences Map PN [LabeledPackageConstraint] -> -- ^ global constraints [PN] -> -- ^ global goals Log Message (Assignment, RevDepMap) -solve sc cinfo idx userPrefs userConstraints userGoals = +solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals = explorePhase $ detectCyclesPhase$ heuristicsPhase $ @@ -86,7 +89,7 @@ solve sc cinfo idx userPrefs userConstraints userGoals = P.enforcePackageConstraints userConstraints . P.enforceSingleInstanceRestriction . validateLinking idx . - validateTree cinfo idx + validateTree cinfo idx pkgConfigDB prunePhase = (if avoidReinstalls sc then P.avoidReinstalls (const True) else id) . -- packages that can never be "upgraded": P.requireInstalled (`elem` [ PackageName "base" diff --git a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs index 8c583cd182b..3bbcbab3fd3 100644 --- a/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs +++ b/cabal-install/Distribution/Client/Dependency/Modular/Validate.hs @@ -25,8 +25,10 @@ import Distribution.Client.Dependency.Modular.Index import Distribution.Client.Dependency.Modular.Package import qualified Distribution.Client.Dependency.Modular.PSQ as P import Distribution.Client.Dependency.Modular.Tree +import Distribution.Client.Dependency.Modular.Version (VR) import Distribution.Client.ComponentDeps (Component) +import Distribution.Client.PkgConfigDb (PkgConfigDb, pkgConfigPkgIsPresent) -- In practice, most constraints are implication constraints (IF we have made -- a number of choices, THEN we also have to ensure that). We call constraints @@ -82,6 +84,7 @@ import Distribution.Client.ComponentDeps (Component) data ValidateState = VS { supportedExt :: Extension -> Bool, supportedLang :: Language -> Bool, + presentPkgs :: PN -> VR -> Bool, index :: Index, saved :: Map QPN (FlaggedDeps Component QPN), -- saved, scoped, dependencies pa :: PreAssignment, @@ -132,6 +135,7 @@ validate = cata go PA ppa pfa psa <- asks pa -- obtain current preassignment extSupported <- asks supportedExt -- obtain the supported extensions langSupported <- asks supportedLang -- obtain the supported languages + pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs idx <- asks index -- obtain the index svd <- asks saved -- obtain saved dependencies qo <- asks qualifyOptions @@ -144,7 +148,7 @@ validate = cata go let goal = Goal (P qpn) gr let newactives = Dep qpn (Fixed i goal) : L.map (resetGoal goal) (extractDeps pfa psa qdeps) -- We now try to extend the partial assignment with the new active constraints. - let mnppa = extend extSupported langSupported goal ppa newactives + let mnppa = extend extSupported langSupported pkgPresent goal ppa newactives -- In case we continue, we save the scoped dependencies let nsvd = M.insert qpn qdeps svd case mfr of @@ -162,6 +166,7 @@ validate = cata go PA ppa pfa psa <- asks pa -- obtain current preassignment extSupported <- asks supportedExt -- obtain the supported extensions langSupported <- asks supportedLang -- obtain the supported languages + pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs svd <- asks saved -- obtain saved dependencies -- Note that there should be saved dependencies for the package in question, -- because while building, we do not choose flags before we see the packages @@ -176,7 +181,7 @@ validate = cata go -- we have chosen a new flag. let newactives = extractNewDeps (F qfn) gr b npfa psa qdeps -- As in the package case, we try to extend the partial assignment. - case extend extSupported langSupported (Goal (F qfn) gr) ppa newactives of + case extend extSupported langSupported pkgPresent (Goal (F qfn) gr) ppa newactives of Left (c, d) -> return (Fail c (Conflicting d)) -- inconsistency found Right nppa -> local (\ s -> s { pa = PA nppa npfa psa }) r @@ -186,6 +191,7 @@ validate = cata go PA ppa pfa psa <- asks pa -- obtain current preassignment extSupported <- asks supportedExt -- obtain the supported extensions langSupported <- asks supportedLang -- obtain the supported languages + pkgPresent <- asks presentPkgs -- obtain the present pkg-config pkgs svd <- asks saved -- obtain saved dependencies -- Note that there should be saved dependencies for the package in question, -- because while building, we do not choose flags before we see the packages @@ -200,7 +206,7 @@ validate = cata go -- we have chosen a new flag. let newactives = extractNewDeps (S qsn) gr b pfa npsa qdeps -- As in the package case, we try to extend the partial assignment. - case extend extSupported langSupported (Goal (S qsn) gr) ppa newactives of + case extend extSupported langSupported pkgPresent (Goal (S qsn) gr) ppa newactives of Left (c, d) -> return (Fail c (Conflicting d)) -- inconsistency found Right nppa -> local (\ s -> s { pa = PA nppa pfa npsa }) r @@ -248,14 +254,15 @@ extractNewDeps v gr b fa sa = go Just False -> [] -- | Interface. -validateTree :: CompilerInfo -> Index -> Tree QGoalReasonChain -> Tree QGoalReasonChain -validateTree cinfo idx t = runReader (validate t) VS { +validateTree :: CompilerInfo -> Index -> PkgConfigDb -> Tree QGoalReasonChain -> Tree QGoalReasonChain +validateTree cinfo idx pkgConfigDb t = runReader (validate t) VS { supportedExt = maybe (const True) -- if compiler has no list of extensions, we assume everything is supported (\ es -> let s = S.fromList es in \ x -> S.member x s) (compilerInfoExtensions cinfo) , supportedLang = maybe (const True) (flip L.elem) -- use list lookup because language list is small and no Ord instance (compilerInfoLanguages cinfo) + , presentPkgs = pkgConfigPkgIsPresent pkgConfigDb , index = idx , saved = M.empty , pa = PA M.empty M.empty M.empty diff --git a/cabal-install/Distribution/Client/Dependency/TopDown.hs b/cabal-install/Distribution/Client/Dependency/TopDown.hs index 6e9c801ec22..bae47ae68d8 100644 --- a/cabal-install/Distribution/Client/Dependency/TopDown.hs +++ b/cabal-install/Distribution/Client/Dependency/TopDown.hs @@ -251,7 +251,7 @@ search configure pref constraints = -- the standard 'DependencyResolver' interface. -- topDownResolver :: DependencyResolver -topDownResolver platform cinfo installedPkgIndex sourcePkgIndex +topDownResolver platform cinfo installedPkgIndex sourcePkgIndex _pkgConfigDB preferences constraints targets = mapMessages $ topDownResolver' platform cinfo diff --git a/cabal-install/Distribution/Client/Dependency/Types.hs b/cabal-install/Distribution/Client/Dependency/Types.hs index 66066c605d3..e9e82320458 100644 --- a/cabal-install/Distribution/Client/Dependency/Types.hs +++ b/cabal-install/Distribution/Client/Dependency/Types.hs @@ -49,6 +49,8 @@ import Data.Monoid ( Monoid(..) ) #endif +import Distribution.Client.PkgConfigDb + ( PkgConfigDb ) import Distribution.Client.Types ( OptionalStanza(..), SourcePackage(..), ConfiguredPackage ) @@ -115,6 +117,7 @@ type DependencyResolver = Platform -> CompilerInfo -> InstalledPackageIndex -> PackageIndex.PackageIndex SourcePackage + -> PkgConfigDb -> (PackageName -> PackagePreferences) -> [LabeledPackageConstraint] -> [PackageName] diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index abe49561ead..fea924569ff 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -22,6 +22,8 @@ import Distribution.Client.Dependency import Distribution.Client.IndexUtils as IndexUtils ( getSourcePackages, getInstalledPackages ) import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.PkgConfigDb + ( PkgConfigDb, readPkgConfigDb ) import Distribution.Client.Setup ( GlobalFlags(..), FetchFlags(..), RepoContext(..) ) @@ -82,6 +84,7 @@ fetch verbosity packageDBs repoCtxt comp platform conf installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf sourcePkgDb <- getSourcePackages verbosity repoCtxt + pkgConfigDb <- readPkgConfigDb verbosity conf pkgSpecifiers <- resolveUserTargets verbosity repoCtxt (fromFlag $ globalWorldFile globalFlags) @@ -90,7 +93,7 @@ fetch verbosity packageDBs repoCtxt comp platform conf pkgs <- planPackages verbosity comp platform fetchFlags - installedPkgIndex sourcePkgDb pkgSpecifiers + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers pkgs' <- filterM (fmap not . isFetched . packageSource) pkgs if null pkgs' @@ -116,10 +119,11 @@ planPackages :: Verbosity -> FetchFlags -> InstalledPackageIndex -> SourcePackageDb + -> PkgConfigDb -> [PackageSpecifier SourcePackage] -> IO [SourcePackage] planPackages verbosity comp platform fetchFlags - installedPkgIndex sourcePkgDb pkgSpecifiers + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers | includeDependencies = do solver <- chooseSolver verbosity @@ -127,7 +131,7 @@ planPackages verbosity comp platform fetchFlags notice verbosity "Resolving dependencies..." installPlan <- foldProgress logMsg die return $ resolveDependencies - platform (compilerInfo comp) + platform (compilerInfo comp) pkgConfigDb solver resolverParams diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs index 5f61996fc5f..37fa4cfc9f4 100644 --- a/cabal-install/Distribution/Client/Freeze.hs +++ b/cabal-install/Distribution/Client/Freeze.hs @@ -27,6 +27,8 @@ import Distribution.Client.IndexUtils as IndexUtils import Distribution.Client.InstallPlan ( InstallPlan, PlanPackage ) import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.PkgConfigDb + ( PkgConfigDb, readPkgConfigDb ) import Distribution.Client.Setup ( GlobalFlags(..), FreezeFlags(..), ConfigExFlags(..) , RepoContext(..) ) @@ -88,6 +90,7 @@ freeze verbosity packageDBs repoCtxt comp platform conf mSandboxPkgInfo installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf sourcePkgDb <- getSourcePackages verbosity repoCtxt + pkgConfigDb <- readPkgConfigDb verbosity conf pkgSpecifiers <- resolveUserTargets verbosity repoCtxt (fromFlag $ globalWorldFile globalFlags) @@ -97,7 +100,7 @@ freeze verbosity packageDBs repoCtxt comp platform conf mSandboxPkgInfo sanityCheck pkgSpecifiers pkgs <- planPackages verbosity comp platform mSandboxPkgInfo freezeFlags - installedPkgIndex sourcePkgDb pkgSpecifiers + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers if null pkgs then notice verbosity $ "No packages to be frozen. " @@ -127,10 +130,11 @@ planPackages :: Verbosity -> FreezeFlags -> InstalledPackageIndex -> SourcePackageDb + -> PkgConfigDb -> [PackageSpecifier SourcePackage] -> IO [PlanPackage] planPackages verbosity comp platform mSandboxPkgInfo freezeFlags - installedPkgIndex sourcePkgDb pkgSpecifiers = do + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers = do solver <- chooseSolver verbosity (fromFlag (freezeSolver freezeFlags)) (compilerInfo comp) @@ -138,7 +142,7 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags installPlan <- foldProgress logMsg die return $ resolveDependencies - platform (compilerInfo comp) + platform (compilerInfo comp) pkgConfigDb solver resolverParams diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 260349b4367..11b0bcfd95c 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -149,6 +149,8 @@ import Distribution.PackageDescription , FlagName(..), FlagAssignment ) import Distribution.PackageDescription.Configuration ( finalizePackageDescription ) +import Distribution.Client.PkgConfigDb + ( PkgConfigDb, readPkgConfigDb ) import Distribution.ParseUtils ( showPWarning ) import Distribution.Version @@ -234,6 +236,7 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo -- TODO: Make InstallContext a proper data type with documented fields. -- | Common context for makeInstallPlan and processInstallPlan. type InstallContext = ( InstalledPackageIndex, SourcePackageDb + , PkgConfigDb , [UserTarget], [PackageSpecifier SourcePackage] , HttpTransport ) @@ -262,6 +265,8 @@ makeInstallContext verbosity installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf sourcePkgDb <- getSourcePackages verbosity repoCtxt + pkgConfigDb <- readPkgConfigDb verbosity conf + checkConfigExFlags verbosity installedPkgIndex (packageIndex sourcePkgDb) configExFlags transport <- repoContextGetTransport repoCtxt @@ -284,7 +289,7 @@ makeInstallContext verbosity userTargets return (userTargets, pkgSpecifiers) - return (installedPkgIndex, sourcePkgDb, userTargets + return (installedPkgIndex, sourcePkgDb, pkgConfigDb, userTargets ,pkgSpecifiers, transport) -- | Make an install plan given install context and install arguments. @@ -294,7 +299,7 @@ makeInstallPlan verbosity (_, _, comp, platform, _, _, mSandboxPkgInfo, _, configFlags, configExFlags, installFlags, _) - (installedPkgIndex, sourcePkgDb, + (installedPkgIndex, sourcePkgDb, pkgConfigDb, _, pkgSpecifiers, _) = do solver <- chooseSolver verbosity (fromFlag (configSolver configExFlags)) @@ -302,7 +307,7 @@ makeInstallPlan verbosity notice verbosity "Resolving dependencies..." return $ planPackages comp platform mSandboxPkgInfo solver configFlags configExFlags installFlags - installedPkgIndex sourcePkgDb pkgSpecifiers + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers -- | Given an install plan, perform the actual installations. processInstallPlan :: Verbosity -> InstallArgs -> InstallContext @@ -310,7 +315,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext -> IO () processInstallPlan verbosity args@(_,_, _, _, _, _, _, _, _, _, installFlags, _) - (installedPkgIndex, sourcePkgDb, + (installedPkgIndex, sourcePkgDb, _, userTargets, pkgSpecifiers, _) installPlan = do checkPrintPlan verbosity installedPkgIndex installPlan sourcePkgDb installFlags pkgSpecifiers @@ -336,14 +341,15 @@ planPackages :: Compiler -> InstallFlags -> InstalledPackageIndex -> SourcePackageDb + -> PkgConfigDb -> [PackageSpecifier SourcePackage] -> Progress String String InstallPlan planPackages comp platform mSandboxPkgInfo solver configFlags configExFlags installFlags - installedPkgIndex sourcePkgDb pkgSpecifiers = + installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers = resolveDependencies - platform (compilerInfo comp) + platform (compilerInfo comp) pkgConfigDb solver resolverParams @@ -723,7 +729,7 @@ reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String reportPlanningFailure verbosity (_, _, comp, platform, _, _, _ ,_, configFlags, _, installFlags, _) - (_, sourcePkgDb, _, pkgSpecifiers, _) + (_, sourcePkgDb, _, _, pkgSpecifiers, _) message = do when reportFailure $ do diff --git a/cabal-install/Distribution/Client/PkgConfigDb.hs b/cabal-install/Distribution/Client/PkgConfigDb.hs new file mode 100644 index 00000000000..1e510fc0b2a --- /dev/null +++ b/cabal-install/Distribution/Client/PkgConfigDb.hs @@ -0,0 +1,103 @@ +{-# LANGUAGE CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Distribution.Client.PkgConfigDb +-- Copyright : (c) Iñaki García Etxebarria 2016 +-- License : BSD-like +-- +-- Maintainer : cabal-devel@haskell.org +-- Portability : portable +-- +-- Read the list of packages available to pkg-config. +----------------------------------------------------------------------------- +module Distribution.Client.PkgConfigDb + ( + PkgConfigDb + , readPkgConfigDb + , pkgConfigDbFromList + , pkgConfigPkgIsPresent + ) where + +#if !MIN_VERSION_base(4,8,0) +import Control.Applicative ((<$>)) +#endif + +import Control.Exception (IOException, handle) +import Data.Char (isSpace) +import qualified Data.Map as M +import Data.Version (parseVersion) +import Text.ParserCombinators.ReadP (readP_to_S) + +import Distribution.Package + ( PackageName(..) ) +import Distribution.Verbosity + ( Verbosity ) +import Distribution.Version + ( Version, VersionRange, withinRange ) + +import Distribution.Simple.Program + ( ProgramConfiguration, pkgConfigProgram, getProgramOutput, + requireProgram ) +import Distribution.Simple.Utils + ( info ) + +-- | The list of packages installed in the system visible to +-- @pkg-config@. This is an opaque datatype, to be constructed with +-- `readPkgConfigDb` and queried with `pkgConfigPkgPresent`. +data PkgConfigDb = PkgConfigDb (M.Map PackageName (Maybe Version)) + -- ^ If an entry is `Nothing`, this means that the + -- package seems to be present, but we don't know the + -- exact version (because parsing of the version + -- number failed). + | NoPkgConfigDb + -- ^ For when we could not run pkg-config successfully. + deriving (Show) + +-- | Query pkg-config for the list of installed packages, together +-- with their versions. Return a `PkgConfigDb` encapsulating this +-- information. +readPkgConfigDb :: Verbosity -> ProgramConfiguration -> IO PkgConfigDb +readPkgConfigDb verbosity conf = handle ioErrorHandler $ do + (pkgConfig, _) <- requireProgram verbosity pkgConfigProgram conf + pkgList <- lines <$> getProgramOutput verbosity pkgConfig ["--list-all"] + -- The output of @pkg-config --list-all@ also includes a description + -- for each package, which we do not need. + let pkgNames = map (takeWhile (not . isSpace)) pkgList + pkgVersions <- lines <$> getProgramOutput verbosity pkgConfig + ("--modversion" : pkgNames) + (return . pkgConfigDbFromList . zip pkgNames) pkgVersions + where + -- For when pkg-config invocation fails (possibly because of a + -- too long command line). + ioErrorHandler :: IOException -> IO PkgConfigDb + ioErrorHandler e = do + info verbosity ("Failed to query pkg-config, Cabal will continue" + ++ " without solving for pkg-config constraints: " + ++ show e) + return NoPkgConfigDb + +-- | Create a `PkgConfigDb` from a list of @(packageName, version)@ pairs. +pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb +pkgConfigDbFromList pairs = (PkgConfigDb . M.fromList . map convert) pairs + where + convert :: (String, String) -> (PackageName, Maybe Version) + convert (n,vs) = (PackageName n, + case (reverse . readP_to_S parseVersion) vs of + (v, "") : _ -> Just v + _ -> Nothing -- Version not (fully) + -- understood. + ) + +-- | Check whether a given package range is satisfiable in the given +-- @pkg-config@ database. +pkgConfigPkgIsPresent :: PkgConfigDb -> PackageName -> VersionRange -> Bool +pkgConfigPkgIsPresent (PkgConfigDb db) pn vr = + case M.lookup pn db of + Nothing -> False -- Package not present in the DB. + Just Nothing -> True -- Package present, but version unknown. + Just (Just v) -> withinRange v vr +-- If we could not read the pkg-config database successfully we allow +-- the check to succeed. The plan found by the solver may fail to be +-- executed later on, but we have no grounds for rejecting the plan at +-- this stage. +pkgConfigPkgIsPresent NoPkgConfigDb _ _ = True diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 739f6a0cc0b..3f05c4819f6 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -178,6 +178,7 @@ executable cabal Distribution.Client.PackageIndex Distribution.Client.PackageUtils Distribution.Client.ParseUtils + Distribution.Client.PkgConfigDb Distribution.Client.PlanIndex Distribution.Client.Run Distribution.Client.RebuildMonad diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs index f0e0e4aa456..da3f81954ab 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs @@ -41,6 +41,7 @@ import Distribution.Client.Dependency.Types import Distribution.Client.Types import qualified Distribution.Client.InstallPlan as CI.InstallPlan import qualified Distribution.Client.PackageIndex as CI.PackageIndex +import qualified Distribution.Client.PkgConfigDb as PC import qualified Distribution.Client.ComponentDeps as CD {------------------------------------------------------------------------------- @@ -112,6 +113,9 @@ data ExampleDependency = -- | Dependency on a language version | ExLang Language + -- | Dependency on a pkg-config package + | ExPkg (ExamplePkgName, ExamplePkgVersion) + exFlag :: ExampleFlagName -> [ExampleDependency] -> [ExampleDependency] -> ExampleDependency exFlag n t e = ExFlag n (Buildable t) (Buildable e) @@ -154,7 +158,7 @@ exDbPkgs = map (either exInstName exAvName) exAvSrcPkg :: ExampleAvailable -> SourcePackage exAvSrcPkg ex = - let (libraryDeps, testSuites, exts, mlang) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) + let (libraryDeps, testSuites, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) in SourcePackage { packageInfoId = exAvPkgId ex , packageSource = LocalTarballPackage "<>" @@ -173,7 +177,7 @@ exAvSrcPkg ex = } , C.genPackageFlags = nub $ concatMap extractFlags (CD.libraryDeps (exAvDeps ex)) - , C.condLibrary = Just $ mkCondTree (extsLib exts <> langLib mlang) + , C.condLibrary = Just $ mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs) disableLib (Buildable libraryDeps) , C.condExecutables = [] @@ -191,22 +195,26 @@ exAvSrcPkg ex = , [(ExampleTestName, [ExampleDependency])] , [Extension] , Maybe Language + , [(ExamplePkgName, ExamplePkgVersion)] -- pkg-config ) splitTopLevel [] = - ([], [], [], Nothing) + ([], [], [], Nothing, []) splitTopLevel (ExTest t a:deps) = - let (other, testSuites, exts, lang) = splitTopLevel deps - in (other, (t, a):testSuites, exts, lang) + let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps + in (other, (t, a):testSuites, exts, lang, pcpkgs) splitTopLevel (ExExt ext:deps) = - let (other, testSuites, exts, lang) = splitTopLevel deps - in (other, testSuites, ext:exts, lang) + let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps + in (other, testSuites, ext:exts, lang, pcpkgs) splitTopLevel (ExLang lang:deps) = case splitTopLevel deps of - (other, testSuites, exts, Nothing) -> (other, testSuites, exts, Just lang) + (other, testSuites, exts, Nothing, pcpkgs) -> (other, testSuites, exts, Just lang, pcpkgs) _ -> error "Only 1 Language dependency is supported" + splitTopLevel (ExPkg pkg:deps) = + let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps + in (other, testSuites, exts, lang, pkg:pcpkgs) splitTopLevel (dep:deps) = - let (other, testSuites, exts, lang) = splitTopLevel deps - in (dep:other, testSuites, exts, lang) + let (other, testSuites, exts, lang, pcpkgs) = splitTopLevel deps + in (dep:other, testSuites, exts, lang, pcpkgs) -- Extract the total set of flags used extractFlags :: ExampleDependency -> [C.Flag] @@ -226,6 +234,7 @@ exAvSrcPkg ex = extractFlags (ExTest _ a) = concatMap extractFlags a extractFlags (ExExt _) = [] extractFlags (ExLang _) = [] + extractFlags (ExPkg _) = [] mkCondTree :: Monoid a => a -> (a -> a) -> Dependencies -> DependencyTree a mkCondTree x dontBuild NotBuildable = @@ -306,6 +315,10 @@ exAvSrcPkg ex = disableTest test = test { C.testBuildInfo = (C.testBuildInfo test) { C.buildable = False }} + -- A 'C.Library' with just the given pkgconfig-depends in its 'BuildInfo' + pcpkgLib :: [(ExamplePkgName, ExamplePkgVersion)] -> C.Library + pcpkgLib ds = mempty { C.libBuildInfo = mempty { C.pkgconfigDepends = [mkDirect (n, (Just v)) | (n,v) <- ds] } } + exAvPkgId :: ExampleAvailable -> C.PackageIdentifier exAvPkgId ex = C.PackageIdentifier { pkgName = C.PackageName (exAvName ex) @@ -337,13 +350,14 @@ exResolve :: ExampleDb -> Maybe [Extension] -- List of languages supported by the compiler, or Nothing if unknown. -> Maybe [Language] + -> PC.PkgConfigDb -> [ExamplePkgName] -> Bool -> [ExPreference] -> ([String], Either String CI.InstallPlan.InstallPlan) -exResolve db exts langs targets indepGoals prefs = runProgress $ +exResolve db exts langs pkgConfigDb targets indepGoals prefs = runProgress $ resolveDependencies C.buildPlatform - compiler + compiler pkgConfigDb Modular params where diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs index 870faeaecfa..c3c3f999137 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/Solver.hs @@ -18,6 +18,7 @@ import Language.Haskell.Extension ( Extension(..) , KnownExtension(..), Language(..)) -- cabal-install +import Distribution.Client.PkgConfigDb (PkgConfigDb, pkgConfigDbFromList) import UnitTests.Distribution.Client.Dependency.Modular.DSL import UnitTests.Options @@ -111,6 +112,12 @@ tests = [ , testBuildable "avoid building component with unknown language" (ExLang (UnknownLanguage "unknown")) , runTest $ mkTest dbBuildable1 "choose flags that set buildable to false" ["pkg"] (Just [("flag1-false", 1), ("flag2-true", 1), ("pkg", 1)]) , runTest $ mkTest dbBuildable2 "choose version that sets buildable to false" ["A"] (Just [("A", 1), ("B", 2)]) + ] + , testGroup "Pkg-config dependencies" [ + runTest $ mkTestPCDepends [] dbPC1 "noPkgs" ["A"] Nothing + , runTest $ mkTestPCDepends [("pkgA", "0")] dbPC1 "tooOld" ["A"] Nothing + , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "1.0.0")] dbPC1 "pruneNotFound" ["C"] (Just [("A", 1), ("B", 1), ("C", 1)]) + , runTest $ mkTestPCDepends [("pkgA", "1.0.0"), ("pkgB", "2.0.0")] dbPC1 "chooseNewest" ["C"] (Just [("A", 1), ("B", 2), ("C", 1)]) ] ] where @@ -133,6 +140,7 @@ data SolverTest = SolverTest { , testDb :: ExampleDb , testSupportedExts :: Maybe [Extension] , testSupportedLangs :: Maybe [Language] + , testPkgConfigDb :: PkgConfigDb } mkTest :: ExampleDb @@ -140,7 +148,7 @@ mkTest :: ExampleDb -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTest = mkTestExtLang Nothing Nothing +mkTest = mkTestExtLangPC Nothing Nothing [] mkTestExts :: [Extension] -> ExampleDb @@ -148,7 +156,7 @@ mkTestExts :: [Extension] -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTestExts exts = mkTestExtLang (Just exts) Nothing +mkTestExts exts = mkTestExtLangPC (Just exts) Nothing [] mkTestLangs :: [Language] -> ExampleDb @@ -156,16 +164,25 @@ mkTestLangs :: [Language] -> [String] -> Maybe [(String, Int)] -> SolverTest -mkTestLangs = mkTestExtLang Nothing . Just - -mkTestExtLang :: Maybe [Extension] - -> Maybe [Language] - -> ExampleDb - -> String - -> [String] - -> Maybe [(String, Int)] - -> SolverTest -mkTestExtLang exts langs db label targets result = SolverTest { +mkTestLangs langs = mkTestExtLangPC Nothing (Just langs) [] + +mkTestPCDepends :: [(String, String)] + -> ExampleDb + -> String + -> [String] + -> Maybe [(String, Int)] + -> SolverTest +mkTestPCDepends pkgConfigDb = mkTestExtLangPC Nothing Nothing pkgConfigDb + +mkTestExtLangPC :: Maybe [Extension] + -> Maybe [Language] + -> [(String, String)] + -> ExampleDb + -> String + -> [String] + -> Maybe [(String, Int)] + -> SolverTest +mkTestExtLangPC exts langs pkgConfigDb db label targets result = SolverTest { testLabel = label , testTargets = targets , testResult = result @@ -174,13 +191,14 @@ mkTestExtLang exts langs db label targets result = SolverTest { , testDb = db , testSupportedExts = exts , testSupportedLangs = langs + , testPkgConfigDb = pkgConfigDbFromList pkgConfigDb } runTest :: SolverTest -> TF.TestTree runTest SolverTest{..} = askOption $ \(OptionShowSolverLog showSolverLog) -> testCase testLabel $ do let (_msgs, result) = exResolve testDb testSupportedExts testSupportedLangs - testTargets testIndepGoals testSoftConstraints + testPkgConfigDb testTargets testIndepGoals testSoftConstraints when showSolverLog $ mapM_ putStrLn _msgs case result of Left err -> assertBool ("Unexpected error:\n" ++ err) (isNothing testResult) @@ -463,7 +481,7 @@ dbLangs1 = [ -- depend on "false-dep". testBuildable :: String -> ExampleDependency -> TestTree testBuildable testName unavailableDep = - runTest $ mkTestExtLang (Just []) (Just []) db testName ["pkg"] expected + runTest $ mkTestExtLangPC (Just []) (Just []) [] db testName ["pkg"] expected where expected = Just [("false-dep", 1), ("pkg", 1)] db = [ @@ -500,6 +518,15 @@ dbBuildable1 = [ , Right $ exAv "flag2-false" 1 [] ] +-- | Package databases for testing @pkg-config@ dependencies. +dbPC1 :: ExampleDb +dbPC1 = [ + Right $ exAv "A" 1 [ExPkg ("pkgA", 1)] + , Right $ exAv "B" 1 [ExPkg ("pkgB", 1), ExAny "A"] + , Right $ exAv "B" 2 [ExPkg ("pkgB", 2), ExAny "A"] + , Right $ exAv "C" 1 [ExAny "B"] + ] + -- | cabal must pick B-2 to avoid the unknown dependency. dbBuildable2 :: ExampleDb dbBuildable2 = [