From bf9de809860519e0462da4073d8dda0f0066acec Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 17 Jul 2023 13:33:25 +0200 Subject: [PATCH] Try each pkg-config query separatedly if returned list doesn't match query length MinGW's pkg-config returns only one version even if queried for multiple libraries. --- .../Distribution/Solver/Types/PkgConfigDb.hs | 158 ++++++++++-------- 1 file changed, 86 insertions(+), 72 deletions(-) diff --git a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs index 11e6da847f0..29a6307aafc 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/PkgConfigDb.hs @@ -1,6 +1,10 @@ {-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveGeneric #-} + +----------------------------------------------------------------------------- + ----------------------------------------------------------------------------- + -- | -- Module : Distribution.Solver.Types.PkgConfigDb -- Copyright : (c) Iñaki García Etxebarria 2016 @@ -10,46 +14,51 @@ -- Portability : portable -- -- Read the list of packages available to pkg-config. ------------------------------------------------------------------------------ module Distribution.Solver.Types.PkgConfigDb - ( PkgConfigDb (..) - , readPkgConfigDb - , pkgConfigDbFromList - , pkgConfigPkgIsPresent - , pkgConfigDbPkgVersion - , getPkgConfigDbDirs - ) where + ( PkgConfigDb (..) + , readPkgConfigDb + , pkgConfigDbFromList + , pkgConfigPkgIsPresent + , pkgConfigDbPkgVersion + , getPkgConfigDbDirs + ) where import Distribution.Solver.Compat.Prelude import Prelude () -import Control.Exception (handle) -import Control.Monad (mapM) -import qualified Data.Map as M -import System.FilePath (splitSearchPath) +import Control.Exception (handle) +import Control.Monad (mapM) +import qualified Data.Map as M +import System.FilePath (splitSearchPath) -import Distribution.Compat.Environment (lookupEnv) -import Distribution.Package (PkgconfigName, mkPkgconfigName) +import Distribution.Compat.Environment (lookupEnv) +import Distribution.Package (PkgconfigName, mkPkgconfigName) import Distribution.Parsec import Distribution.Simple.Program - (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram, ConfiguredProgram) -import Distribution.Simple.Program.Run (getProgramInvocationOutputAndErrors, programInvocation) -import Distribution.Simple.Utils (info) + ( ConfiguredProgram + , ProgramDb + , getProgramOutput + , needProgram + , pkgConfigProgram + ) +import Distribution.Simple.Program.Run (getProgramInvocationOutputAndErrors, programInvocation) +import Distribution.Simple.Utils (info) import Distribution.Types.PkgconfigVersion import Distribution.Types.PkgconfigVersionRange -import Distribution.Verbosity (Verbosity) +import Distribution.Verbosity (Verbosity) -- | 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 PkgconfigName (Maybe PkgconfigVersion)) - -- ^ 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, Generic, Typeable) +data PkgConfigDb + = -- | 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). + PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion)) + | -- | For when we could not run pkg-config successfully. + NoPkgConfigDb + deriving (Show, Generic, Typeable) instance Binary PkgConfigDb instance Structured PkgConfigDb @@ -59,67 +68,72 @@ instance Structured PkgConfigDb -- information. readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do - mpkgConfig <- needProgram verbosity pkgConfigProgram progdb - case mpkgConfig of - Nothing -> noPkgConfig "Cannot find pkg-config program" - Just (pkgConfig, _) -> do - 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, _errs, exitCode) <- - getProgramInvocationOutputAndErrors verbosity - (programInvocation pkgConfig ("--modversion" : pkgNames)) - case exitCode of - ExitSuccess -> (return . pkgConfigDbFromList . zip pkgNames) (lines pkgVersions) - -- if there's a single broken pc file the above fails, so we fall back into calling it individually - _ -> do - info verbosity ("call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package") - pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames + mpkgConfig <- needProgram verbosity pkgConfigProgram progdb + case mpkgConfig of + Nothing -> noPkgConfig "Cannot find pkg-config program" + Just (pkgConfig, _) -> do + 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, _errs, exitCode) <- + getProgramInvocationOutputAndErrors + verbosity + (programInvocation pkgConfig ("--modversion" : pkgNames)) + if exitCode == ExitSuccess && length pkgNames == length pkgList + then (return . pkgConfigDbFromList . zip pkgNames) (lines pkgVersions) + else -- if there's a single broken pc file the above fails, so we fall back into calling it individually + do + info verbosity ("call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package") + pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames + where + where -- For when pkg-config invocation fails (possibly because of a -- too long command line). noPkgConfig extra = do - info verbosity ("Failed to query pkg-config, Cabal will continue" - ++ " without solving for pkg-config constraints: " - ++ extra) - return NoPkgConfigDb + info + verbosity + ( "Failed to query pkg-config, Cabal will continue" + ++ " without solving for pkg-config constraints: " + ++ extra + ) + return NoPkgConfigDb ioErrorHandler :: IOException -> IO PkgConfigDb ioErrorHandler e = noPkgConfig (show e) getIndividualVersion :: ConfiguredProgram -> String -> IO (Maybe (String, String)) getIndividualVersion pkgConfig pkg = do - (pkgVersion, _errs, exitCode) <- - getProgramInvocationOutputAndErrors verbosity - (programInvocation pkgConfig ["--modversion",pkg]) - return $ case exitCode of - ExitSuccess -> Just (pkg, pkgVersion) - _ -> Nothing + (pkgVersion, _errs, exitCode) <- + getProgramInvocationOutputAndErrors + verbosity + (programInvocation pkgConfig ["--modversion", pkg]) + return $ case exitCode of + ExitSuccess -> Just (pkg, pkgVersion) + _ -> Nothing -- | 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) -> (PkgconfigName, Maybe PkgconfigVersion) - convert (n,vs) = (mkPkgconfigName n, simpleParsec vs) + where + convert :: (String, String) -> (PkgconfigName, Maybe PkgconfigVersion) + convert (n, vs) = (mkPkgconfigName n, simpleParsec vs) -- | Check whether a given package range is satisfiable in the given -- @pkg-config@ database. pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> 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) -> withinPkgconfigVersionRange v 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) -> withinPkgconfigVersionRange v vr -- If we could not read the pkg-config database successfully we fail. -- The plan found by the solver can't be executed later, because pkg-config itself -- is going to be called in the build phase to get the library location for linking -- so even if there is a library, it would need to be passed manual flags anyway. pkgConfigPkgIsPresent NoPkgConfigDb _ _ = False - - -- | Query the version of a package in the @pkg-config@ database. -- @Nothing@ indicates the package is not in the database, while -- @Just Nothing@ indicates that the package is in the database, @@ -132,14 +146,12 @@ pkgConfigDbPkgVersion (PkgConfigDb db) pn = M.lookup pn db -- don't know about it. pkgConfigDbPkgVersion NoPkgConfigDb _ = Just Nothing - -- | Query pkg-config for the locations of pkg-config's package files. Use this -- to monitor for changes in the pkg-config DB. --- getPkgConfigDbDirs :: Verbosity -> ProgramDb -> IO [FilePath] getPkgConfigDbDirs verbosity progdb = - (++) <$> getEnvPath <*> getDefPath - where + (++) <$> getEnvPath <*> getDefPath + where -- According to @man pkg-config@: -- -- PKG_CONFIG_PATH @@ -147,8 +159,9 @@ getPkgConfigDbDirs verbosity progdb = -- to search for .pc files. The default directory will always be searched -- after searching the path -- - getEnvPath = maybe [] parseSearchPath - <$> lookupEnv "PKG_CONFIG_PATH" + getEnvPath = + maybe [] parseSearchPath + <$> lookupEnv "PKG_CONFIG_PATH" -- Again according to @man pkg-config@: -- @@ -161,13 +174,14 @@ getPkgConfigDbDirs verbosity progdb = mpkgConfig <- needProgram verbosity pkgConfigProgram progdb case mpkgConfig of Nothing -> return [] - Just (pkgConfig, _) -> parseSearchPath <$> - getProgramOutput verbosity pkgConfig ["--variable", "pc_path", "pkg-config"] + Just (pkgConfig, _) -> + parseSearchPath + <$> getProgramOutput verbosity pkgConfig ["--variable", "pc_path", "pkg-config"] parseSearchPath str = case lines str of [p] | not (null p) -> splitSearchPath p - _ -> [] + _ -> [] ioErrorHandler :: IOException -> IO [FilePath] ioErrorHandler _e = return []