{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Solver.Types.PkgConfigDb
-- Copyright   :  (c) Iñaki García Etxebarria 2016
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Read the list of packages available to pkg-config.
-----------------------------------------------------------------------------
module Distribution.Solver.Types.PkgConfigDb
    ( PkgConfigDb (..)
    , readPkgConfigDb
    , pkgConfigDbFromList
    , pkgConfigPkgIsPresent
    , pkgConfigDbPkgVersion
    , getPkgConfigDbDirs
    ) where

import Distribution.Solver.Compat.Prelude
import Prelude ()

import           Control.Exception (handle)
import qualified Data.Map          as M
import           System.FilePath   (splitSearchPath)

import Distribution.Compat.Environment          (lookupEnv)
import Distribution.Package                     (PkgconfigName, mkPkgconfigName)
import Distribution.Parsec
import Distribution.Simple.Program
       (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram)
import Distribution.Simple.Utils                (info)
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigVersionRange
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 (Int -> PkgConfigDb -> ShowS
[PkgConfigDb] -> ShowS
PkgConfigDb -> String
(Int -> PkgConfigDb -> ShowS)
-> (PkgConfigDb -> String)
-> ([PkgConfigDb] -> ShowS)
-> Show PkgConfigDb
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgConfigDb] -> ShowS
$cshowList :: [PkgConfigDb] -> ShowS
show :: PkgConfigDb -> String
$cshow :: PkgConfigDb -> String
showsPrec :: Int -> PkgConfigDb -> ShowS
$cshowsPrec :: Int -> PkgConfigDb -> ShowS
Show, (forall x. PkgConfigDb -> Rep PkgConfigDb x)
-> (forall x. Rep PkgConfigDb x -> PkgConfigDb)
-> Generic PkgConfigDb
forall x. Rep PkgConfigDb x -> PkgConfigDb
forall x. PkgConfigDb -> Rep PkgConfigDb x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgConfigDb x -> PkgConfigDb
$cfrom :: forall x. PkgConfigDb -> Rep PkgConfigDb x
Generic, Typeable)

instance Binary PkgConfigDb
instance Structured PkgConfigDb

-- | Query pkg-config for the list of installed packages, together
-- with their versions. Return a `PkgConfigDb` encapsulating this
-- information.
readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb Verbosity
verbosity ProgramDb
progdb = (IOException -> IO PkgConfigDb) -> IO PkgConfigDb -> IO PkgConfigDb
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO PkgConfigDb
ioErrorHandler (IO PkgConfigDb -> IO PkgConfigDb)
-> IO PkgConfigDb -> IO PkgConfigDb
forall a b. (a -> b) -> a -> b
$ do
    Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
pkgConfigProgram ProgramDb
progdb
    case Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig of
      Maybe (ConfiguredProgram, ProgramDb)
Nothing             -> String -> IO PkgConfigDb
noPkgConfig String
"Cannot find pkg-config program"
      Just (ConfiguredProgram
pkgConfig, ProgramDb
_) -> do
        [String]
pkgList <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
pkgConfig [String
"--list-all"]
        -- The output of @pkg-config --list-all@ also includes a description
        -- for each package, which we do not need.
        let pkgNames :: [String]
pkgNames = ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) [String]
pkgList
        [String]
pkgVersions <- String -> [String]
lines (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
pkgConfig
                                   (String
"--modversion" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
pkgNames)
        (PkgConfigDb -> IO PkgConfigDb
forall (m :: * -> *) a. Monad m => a -> m a
return (PkgConfigDb -> IO PkgConfigDb)
-> ([String] -> PkgConfigDb) -> [String] -> IO PkgConfigDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> PkgConfigDb
pkgConfigDbFromList ([(String, String)] -> PkgConfigDb)
-> ([String] -> [(String, String)]) -> [String] -> PkgConfigDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [String]
pkgNames) [String]
pkgVersions
  where
    -- For when pkg-config invocation fails (possibly because of a
    -- too long command line).
    noPkgConfig :: String -> IO PkgConfigDb
noPkgConfig String
extra = do
        Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"Failed to query pkg-config, Cabal will continue"
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" without solving for pkg-config constraints: "
                        String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
extra)
        PkgConfigDb -> IO PkgConfigDb
forall (m :: * -> *) a. Monad m => a -> m a
return PkgConfigDb
NoPkgConfigDb

    ioErrorHandler :: IOException -> IO PkgConfigDb
    ioErrorHandler :: IOException -> IO PkgConfigDb
ioErrorHandler IOException
e = String -> IO PkgConfigDb
noPkgConfig (IOException -> String
forall a. Show a => a -> String
show IOException
e)

-- | Create a `PkgConfigDb` from a list of @(packageName, version)@ pairs.
pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb
pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb
pkgConfigDbFromList [(String, String)]
pairs = (Map PkgconfigName (Maybe PkgconfigVersion) -> PkgConfigDb
PkgConfigDb (Map PkgconfigName (Maybe PkgconfigVersion) -> PkgConfigDb)
-> ([(String, String)]
    -> Map PkgconfigName (Maybe PkgconfigVersion))
-> [(String, String)]
-> PkgConfigDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(PkgconfigName, Maybe PkgconfigVersion)]
-> Map PkgconfigName (Maybe PkgconfigVersion)
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(PkgconfigName, Maybe PkgconfigVersion)]
 -> Map PkgconfigName (Maybe PkgconfigVersion))
-> ([(String, String)]
    -> [(PkgconfigName, Maybe PkgconfigVersion)])
-> [(String, String)]
-> Map PkgconfigName (Maybe PkgconfigVersion)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String) -> (PkgconfigName, Maybe PkgconfigVersion))
-> [(String, String)] -> [(PkgconfigName, Maybe PkgconfigVersion)]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> (PkgconfigName, Maybe PkgconfigVersion)
convert) [(String, String)]
pairs
    where
      convert :: (String, String) -> (PkgconfigName, Maybe PkgconfigVersion)
      convert :: (String, String) -> (PkgconfigName, Maybe PkgconfigVersion)
convert (String
n,String
vs) = (String -> PkgconfigName
mkPkgconfigName String
n, String -> Maybe PkgconfigVersion
forall a. Parsec a => String -> Maybe a
simpleParsec String
vs)

-- | Check whether a given package range is satisfiable in the given
-- @pkg-config@ database.
pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
pkgConfigPkgIsPresent (PkgConfigDb Map PkgconfigName (Maybe PkgconfigVersion)
db) PkgconfigName
pn PkgconfigVersionRange
vr =
    case PkgconfigName
-> Map PkgconfigName (Maybe PkgconfigVersion)
-> Maybe (Maybe PkgconfigVersion)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgconfigName
pn Map PkgconfigName (Maybe PkgconfigVersion)
db of
      Maybe (Maybe PkgconfigVersion)
Nothing       -> Bool
False    -- Package not present in the DB.
      Just Maybe PkgconfigVersion
Nothing  -> Bool
True     -- Package present, but version unknown.
      Just (Just PkgconfigVersion
v) -> PkgconfigVersion -> PkgconfigVersionRange -> Bool
withinPkgconfigVersionRange PkgconfigVersion
v PkgconfigVersionRange
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 PkgConfigDb
NoPkgConfigDb PkgconfigName
_ PkgconfigVersionRange
_ = Bool
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,
-- but its version is not known.
pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion (PkgConfigDb Map PkgconfigName (Maybe PkgconfigVersion)
db) PkgconfigName
pn = PkgconfigName
-> Map PkgconfigName (Maybe PkgconfigVersion)
-> Maybe (Maybe PkgconfigVersion)
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgconfigName
pn Map PkgconfigName (Maybe PkgconfigVersion)
db
-- NB: Since the solver allows solving to succeed if there is
-- NoPkgConfigDb, we should report that we *guess* that there
-- is a matching pkg-config configuration, but that we just
-- don't know about it.
pkgConfigDbPkgVersion PkgConfigDb
NoPkgConfigDb PkgconfigName
_ = Maybe PkgconfigVersion -> Maybe (Maybe PkgconfigVersion)
forall a. a -> Maybe a
Just Maybe PkgconfigVersion
forall a. Maybe a
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 -> ProgramDb -> IO [String]
getPkgConfigDbDirs Verbosity
verbosity ProgramDb
progdb =
    [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) ([String] -> [String] -> [String])
-> IO [String] -> IO ([String] -> [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getEnvPath IO ([String] -> [String]) -> IO [String] -> IO [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [String]
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 :: IO [String]
getEnvPath = [String] -> (String -> [String]) -> Maybe String -> [String]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
parseSearchPath
             (Maybe String -> [String]) -> IO (Maybe String) -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PKG_CONFIG_PATH"

    -- Again according to @man pkg-config@:
    --
    -- pkg-config can be used to query itself for the default search path,
    -- version number and other information, for instance using:
    --
    -- > pkg-config --variable pc_path pkg-config
    --
    getDefPath :: IO [String]
getDefPath = (IOException -> IO [String]) -> IO [String] -> IO [String]
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO [String]
ioErrorHandler (IO [String] -> IO [String]) -> IO [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ do
      Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
pkgConfigProgram ProgramDb
progdb
      case Maybe (ConfiguredProgram, ProgramDb)
mpkgConfig of
        Maybe (ConfiguredProgram, ProgramDb)
Nothing -> [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Just (ConfiguredProgram
pkgConfig, ProgramDb
_) -> String -> [String]
parseSearchPath (String -> [String]) -> IO String -> IO [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
          Verbosity -> ConfiguredProgram -> [String] -> IO String
getProgramOutput Verbosity
verbosity ConfiguredProgram
pkgConfig [String
"--variable", String
"pc_path", String
"pkg-config"]

    parseSearchPath :: String -> [String]
parseSearchPath String
str =
      case String -> [String]
lines String
str of
        [String
p] | Bool -> Bool
not (String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
p) -> String -> [String]
splitSearchPath String
p
        [String]
_                  -> []

    ioErrorHandler :: IOException -> IO [FilePath]
    ioErrorHandler :: IOException -> IO [String]
ioErrorHandler IOException
_e = [String] -> IO [String]
forall (m :: * -> *) a. Monad m => a -> m a
return []