Commit c72aa8db authored by inaki's avatar inaki

Make the solver aware of pkg-config constraints

When solving, we now discard plans that would involve packages with a
pkgconfig-depends constraint which is not satisfiable with the current
set of installed packages (as listed by pkg-config --list-all).

This fixes https://github.com/haskell/cabal/issues/3016.

It is possible (in principle, although it should be basically impossible
in practice) that "pkg-config --modversion pkg1 pkg2... pkgN" fails to
execute for various reasons, in particular because N is too large, so
the command line becomes too long for the operating system limits.

If this happens, revert to the previous behavior of accepting any
install plan, regardless of any pkgconfig-depends constraints.
parent 50e7cf0f
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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]
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
{-# 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