{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
module Distribution.Solver.Types.PkgConfigDb
( 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 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)
import Distribution.Types.PkgconfigVersion
import Distribution.Types.PkgconfigVersionRange
import Distribution.Verbosity (Verbosity)
data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion))
| NoPkgConfigDb
deriving (Int -> PkgConfigDb -> ShowS
[PkgConfigDb] -> ShowS
PkgConfigDb -> String
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. 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
readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb :: Verbosity -> ProgramDb -> IO PkgConfigDb
readPkgConfigDb Verbosity
verbosity ProgramDb
progdb = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO PkgConfigDb
ioErrorHandler 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 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"]
let pkgNames :: [String]
pkgNames = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)) [String]
pkgList
(String
pkgVersions, String
_errs, ExitCode
exitCode) <-
Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig (String
"--modversion" forall a. a -> [a] -> [a]
: [String]
pkgNames))
case ExitCode
exitCode of
ExitCode
ExitSuccess -> (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> PkgConfigDb
pkgConfigDbFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [String]
pkgNames) (String -> [String]
lines String
pkgVersions)
ExitCode
_ -> do
Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package")
[(String, String)] -> PkgConfigDb
pkgConfigDbFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (ConfiguredProgram -> String -> IO (Maybe (String, String))
getIndividualVersion ConfiguredProgram
pkgConfig) [String]
pkgNames
where
noPkgConfig :: String -> IO PkgConfigDb
noPkgConfig String
extra = do
Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"Failed to query pkg-config, Cabal will continue"
forall a. [a] -> [a] -> [a]
++ String
" without solving for pkg-config constraints: "
forall a. [a] -> [a] -> [a]
++ String
extra)
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 (forall a. Show a => a -> String
show IOException
e)
getIndividualVersion :: ConfiguredProgram -> String -> IO (Maybe (String, String))
getIndividualVersion :: ConfiguredProgram -> String -> IO (Maybe (String, String))
getIndividualVersion ConfiguredProgram
pkgConfig String
pkg = do
(String
pkgVersion, String
_errs, ExitCode
exitCode) <-
Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig [String
"--modversion",String
pkg])
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case ExitCode
exitCode of
ExitCode
ExitSuccess -> forall a. a -> Maybe a
Just (String
pkg, String
pkgVersion)
ExitCode
_ -> forall a. Maybe a
Nothing
pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb
pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb
pkgConfigDbFromList [(String, String)]
pairs = (Map PkgconfigName (Maybe PkgconfigVersion) -> PkgConfigDb
PkgConfigDb forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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, forall a. Parsec a => String -> Maybe a
simpleParsec String
vs)
pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
pkgConfigPkgIsPresent :: PkgConfigDb -> PkgconfigName -> PkgconfigVersionRange -> Bool
pkgConfigPkgIsPresent (PkgConfigDb Map PkgconfigName (Maybe PkgconfigVersion)
db) PkgconfigName
pn PkgconfigVersionRange
vr =
case 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
Just Maybe PkgconfigVersion
Nothing -> Bool
True
Just (Just PkgconfigVersion
v) -> PkgconfigVersion -> PkgconfigVersionRange -> Bool
withinPkgconfigVersionRange PkgconfigVersion
v PkgconfigVersionRange
vr
pkgConfigPkgIsPresent PkgConfigDb
NoPkgConfigDb PkgconfigName
_ PkgconfigVersionRange
_ = Bool
False
pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion :: PkgConfigDb -> PkgconfigName -> Maybe (Maybe PkgconfigVersion)
pkgConfigDbPkgVersion (PkgConfigDb Map PkgconfigName (Maybe PkgconfigVersion)
db) PkgconfigName
pn = forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup PkgconfigName
pn Map PkgconfigName (Maybe PkgconfigVersion)
db
pkgConfigDbPkgVersion PkgConfigDb
NoPkgConfigDb PkgconfigName
_ = forall a. a -> Maybe a
Just forall a. Maybe a
Nothing
getPkgConfigDbDirs :: Verbosity -> ProgramDb -> IO [FilePath]
getPkgConfigDbDirs :: Verbosity -> ProgramDb -> IO [String]
getPkgConfigDbDirs Verbosity
verbosity ProgramDb
progdb =
forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String]
getEnvPath forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> IO [String]
getDefPath
where
getEnvPath :: IO [String]
getEnvPath = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] String -> [String]
parseSearchPath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"PKG_CONFIG_PATH"
getDefPath :: IO [String]
getDefPath = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle IOException -> IO [String]
ioErrorHandler 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (ConfiguredProgram
pkgConfig, ProgramDb
_) -> String -> [String]
parseSearchPath 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 (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 = forall (m :: * -> *) a. Monad m => a -> m a
return []