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.
haskell · Jul 19, 2023 · bf9de80 · bf9de80
1 parent 2564b54
commit bf9de80
Showing 1 changed file with 86 additions and 72 deletions.
diff --git 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,23 +146,22 @@ 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
     -- A  colon-separated  (on Windows, semicolon-separated) list of directories
     -- 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 []