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