cabal-install/Distribution/Solver/Types/PkgConfigDb.hs

   1 {-# LANGUAGE DeriveGeneric #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Distribution.Solver.Types.PkgConfigDb
   5 -- Copyright   :  (c) Iñaki García Etxebarria 2016
   6 -- License     :  BSD-like
   7 --
   8 -- Maintainer  :  cabal-devel@haskell.org
   9 -- Portability :  portable
  10 --
  11 -- Read the list of packages available to pkg-config.
  12 -----------------------------------------------------------------------------
  13 module Distribution.Solver.Types.PkgConfigDb
  14     ( PkgConfigDb
  15     , readPkgConfigDb
  16     , pkgConfigDbFromList
  17     , pkgConfigPkgIsPresent
  18     , pkgConfigDbPkgVersion
  19     , getPkgConfigDbDirs
  20     ) where
  21
  22 import Prelude ()
  23 import Distribution.Client.Compat.Prelude
  24
  25 import Control.Exception (IOException, handle)
  26 import qualified Data.Map as M
  27 import Data.Version (parseVersion)
  28 import Text.ParserCombinators.ReadP (readP_to_S)
  29 import System.FilePath (splitSearchPath)
  30
  31 import Distribution.Package
  32     ( PkgconfigName, mkPkgconfigName )
  33 import Distribution.Verbosity
  34     ( Verbosity )
  35 import Distribution.Version
  36     ( Version, mkVersion', VersionRange, withinRange )
  37
  38 import Distribution.Compat.Environment
  39     ( lookupEnv )
  40 import Distribution.Simple.Program
  41     ( ProgramDb, pkgConfigProgram, getProgramOutput, requireProgram )
  42 import Distribution.Simple.Utils
  43     ( info )
  44
  45 -- | The list of packages installed in the system visible to
  46 -- @pkg-config@. This is an opaque datatype, to be constructed with
  47 -- `readPkgConfigDb` and queried with `pkgConfigPkgPresent`.
  48 data PkgConfigDb =  PkgConfigDb (M.Map PkgconfigName (Maybe Version))
  49                  -- ^ If an entry is `Nothing`, this means that the
  50                  -- package seems to be present, but we don't know the
  51                  -- exact version (because parsing of the version
  52                  -- number failed).
  53                  | NoPkgConfigDb
  54                  -- ^ For when we could not run pkg-config successfully.
  55      deriving (Show, Generic)
  56
  57 instance Binary PkgConfigDb
  58
  59 -- | Query pkg-config for the list of installed packages, together
  60 -- with their versions. Return a `PkgConfigDb` encapsulating this
  61 -- information.
  62 readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb
  63 readPkgConfigDb verbosity progdb = handle ioErrorHandler $ do
  64   (pkgConfig, _) <- requireProgram verbosity pkgConfigProgram progdb
  65   pkgList <- lines <$> getProgramOutput verbosity pkgConfig ["--list-all"]
  66   -- The output of @pkg-config --list-all@ also includes a description
  67   -- for each package, which we do not need.
  68   let pkgNames = map (takeWhile (not . isSpace)) pkgList
  69   pkgVersions <- lines <$> getProgramOutput verbosity pkgConfig
  70                              ("--modversion" : pkgNames)
  71   (return . pkgConfigDbFromList . zip pkgNames) pkgVersions
  72       where
  73         -- For when pkg-config invocation fails (possibly because of a
  74         -- too long command line).
  75         ioErrorHandler :: IOException -> IO PkgConfigDb
  76         ioErrorHandler e = do
  77           info verbosity ("Failed to query pkg-config, Cabal will continue"
  78                           ++ " without solving for pkg-config constraints: "
  79                           ++ show e)
  80           return NoPkgConfigDb
  81
  82 -- | Create a `PkgConfigDb` from a list of @(packageName, version)@ pairs.
  83 pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb
  84 pkgConfigDbFromList pairs = (PkgConfigDb . M.fromList . map convert) pairs
  85     where
  86       convert :: (String, String) -> (PkgconfigName, Maybe Version)
  87       convert (n,vs) = (mkPkgconfigName n,
  88                         case (reverse . readP_to_S parseVersion) vs of
  89                           (v, "") : _ -> Just (mkVersion' v)
  90                           _           -> Nothing -- Version not (fully)
  91                                                  -- understood.
  92                        )
  93
  94 -- | Check whether a given package range is satisfiable in the given
  95 -- @pkg-config@ database.
  96 pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> VersionRange -> Bool
  97 pkgConfigPkgIsPresent (PkgConfigDb db) pn vr =
  98     case M.lookup pn db of
  99       Nothing       -> False    -- Package not present in the DB.
 100       Just Nothing  -> True     -- Package present, but version unknown.
 101       Just (Just v) -> withinRange v vr
 102 -- If we could not read the pkg-config database successfully we allow
 103 -- the check to succeed. The plan found by the solver may fail to be
 104 -- executed later on, but we have no grounds for rejecting the plan at
 105 -- this stage.
 106 pkgConfigPkgIsPresent NoPkgConfigDb _ _ = True
 107
 108
 109 -- | Query the version of a package in the @pkg-config@ database.
 110 -- @Nothing@ indicates the package is not in the database, while
 111 -- @Just Nothing@ indicates that the package is in the database,
 112 -- but its version is not known.
 113 pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe Version)
 114 pkgConfigDbPkgVersion (PkgConfigDb db) pn = M.lookup pn db
 115 -- NB: Since the solver allows solving to succeed if there is
 116 -- NoPkgConfigDb, we should report that we *guess* that there
 117 -- is a matching pkg-config configuration, but that we just
 118 -- don't know about it.
 119 pkgConfigDbPkgVersion NoPkgConfigDb _ = Just Nothing
 120
 121
 122 -- | Query pkg-config for the locations of pkg-config's package files. Use this
 123 -- to monitor for changes in the pkg-config DB.
 124 --
 125 getPkgConfigDbDirs :: Verbosity -> ProgramDb -> IO [FilePath]
 126 getPkgConfigDbDirs verbosity progdb =
 127     (++) <$> getEnvPath <*> getDefPath
 128  where
 129     -- According to @man pkg-config@:
 130     --
 131     -- PKG_CONFIG_PATH
 132     -- A  colon-separated  (on Windows, semicolon-separated) list of directories
 133     -- to search for .pc files.  The default directory will always be searched
 134     -- after searching the path
 135     --
 136     getEnvPath = maybe [] parseSearchPath
 137              <$> lookupEnv "PKG_CONFIG_PATH"
 138
 139     -- Again according to @man pkg-config@:
 140     --
 141     -- pkg-config can be used to query itself for the default search path,
 142     -- version number and other information, for instance using:
 143     --
 144     -- > pkg-config --variable pc_path pkg-config
 145     --
 146     getDefPath = handle ioErrorHandler $ do
 147       (pkgConfig, _) <- requireProgram verbosity pkgConfigProgram progdb
 148       parseSearchPath <$>
 149         getProgramOutput verbosity pkgConfig
 150                          ["--variable", "pc_path", "pkg-config"]
 151
 152     parseSearchPath str =
 153       case lines str of
 154         [p] | not (null p) -> splitSearchPath p
 155         _                  -> []
 156
 157     ioErrorHandler :: IOException -> IO [FilePath]
 158     ioErrorHandler _e = return []