{-# 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 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)
data PkgConfigDb = PkgConfigDb (M.Map PkgconfigName (Maybe PkgconfigVersion))
| NoPkgConfigDb
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
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"]
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
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)
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)
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
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 = 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
pkgConfigDbPkgVersion PkgConfigDb
NoPkgConfigDb PkgconfigName
_ = Maybe PkgconfigVersion -> Maybe (Maybe PkgconfigVersion)
forall a. a -> Maybe a
Just Maybe PkgconfigVersion
forall a. Maybe a
Nothing
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
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"
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 []