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 #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.

Author: Iñaki García Etxebarria

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 )
 import Distribution.Client.Types as Source
@@ -106,11 +107,12 @@ configure verbosity packageDBs repos comp platform conf
 
   installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
   sourcePkgDb       <- getSourcePackages    verbosity repos
+  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)
@@ -263,10 +265,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)
@@ -320,7 +322,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

cabal-install/Distribution/Client/Dependency.hs

@@ -68,6 +68,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(..), enableStanzas )
@@ -533,25 +534,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

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

cabal-install/Distribution/Client/Dependency/Modular/Assignment.hs

@@ -65,9 +65,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
@@ -78,6 +79,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

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)

cabal-install/Distribution/Client/Dependency/Modular/Dependency.hs

@@ -208,6 +208,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, Functor)
 
 showDep :: Dep QPN -> String
@@ -220,6 +221,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')
 --
@@ -263,6 +267,7 @@ qualifyDeps QO{..} (Q pp' pn) = go
     qBase (Dep dep _ci) = qoBaseShim && unPackageName dep == "base"
     qBase (Ext _)       = False
     qBase (Lang _)      = False
+    qBase (Pkg _ _)     = False
 
     -- Should we qualify this goal with the 'Setup' packaeg path?
     qSetup :: Component -> Bool
@@ -393,6 +398,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
@@ -431,6 +437,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
 

cabal-install/Distribution/Client/Dependency/Modular/IndexConversion.hs

@@ -149,6 +149,7 @@ convCondTree os arch cinfo pi@(PI pn _) fds p comp getInfo (CondNode info ds bra
   | p info    =  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 p comp getInfo) branches
   | otherwise = []
   where

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

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
@@ -34,11 +36,12 @@ data SolverConfig = SolverConfig {
 solve :: SolverConfig ->                      -- solver parameters
          CompilerInfo ->
          Index ->                             -- all available packages as an index
+         PkgConfigDb ->
          (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     $
   heuristicsPhase  $
   preferencesPhase $
@@ -60,7 +63,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"

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

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

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 )
 
@@ -110,6 +112,7 @@ type DependencyResolver = Platform
                        -> CompilerInfo
                        -> InstalledPackageIndex
                        ->          PackageIndex.PackageIndex SourcePackage
+                       -> PkgConfigDb
                        -> (PackageName -> PackagePreferences)
                        -> [LabeledPackageConstraint]
                        -> [PackageName]

cabal-install/Distribution/Client/Fetch.hs

@@ -24,6 +24,8 @@ import Distribution.Client.IndexUtils as IndexUtils
 import Distribution.Client.HttpUtils
          ( configureTransport, HttpTransport(..) )
 import qualified Distribution.Client.InstallPlan as InstallPlan
+import Distribution.Client.PkgConfigDb
+         ( PkgConfigDb, readPkgConfigDb )
 import Distribution.Client.Setup
          ( GlobalFlags(..), FetchFlags(..) )
 
@@ -84,6 +86,7 @@ fetch verbosity packageDBs repos comp platform conf
 
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
     sourcePkgDb       <- getSourcePackages    verbosity repos
+    pkgConfigDb       <- readPkgConfigDb      verbosity conf
 
     transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
 
@@ -94,7 +97,7 @@ fetch verbosity packageDBs repos 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'
@@ -120,18 +123,19 @@ 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
                 (fromFlag (fetchSolver fetchFlags)) (compilerInfo comp)
       notice verbosity "Resolving dependencies..."
       installPlan <- foldProgress logMsg die return $
                        resolveDependencies
-                         platform (compilerInfo comp)
+                         platform (compilerInfo comp) pkgConfigDb
                          solver
                          resolverParams