{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
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 Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Map as M
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import qualified Data.Text.Encoding.Error as T
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, getProgramInvocationLBSAndErrors)
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
$cshowsPrec :: Int -> PkgConfigDb -> ShowS
showsPrec :: Int -> PkgConfigDb -> ShowS
$cshow :: PkgConfigDb -> String
show :: PkgConfigDb -> String
$cshowList :: [PkgConfigDb] -> ShowS
showList :: [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
$cfrom :: forall x. PkgConfigDb -> Rep PkgConfigDb x
from :: forall x. PkgConfigDb -> Rep PkgConfigDb x
$cto :: forall x. Rep PkgConfigDb x -> PkgConfigDb
to :: forall x. Rep PkgConfigDb x -> PkgConfigDb
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
(ByteString
listAllOutput, String
listAllErrs, ExitCode
listAllExitcode) <-
Verbosity -> ProgramInvocation -> IO (ByteString, String, ExitCode)
getProgramInvocationLBSAndErrors Verbosity
verbosity (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig [String
"--list-all"])
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ExitCode
listAllExitcode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
/= ExitCode
ExitSuccess) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
IOException -> IO ()
forall a. IOException -> IO a
ioError (String -> IOException
userError (String
"pkg-config --list-all failed: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
listAllErrs))
let pkgList :: [ByteString]
pkgList = Word8 -> ByteString -> [ByteString]
LBS.split (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
ord Char
'\n')) ByteString
listAllOutput
let ([String]
failedPkgNames, [String]
pkgNames) =
[Either String String] -> ([String], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
([Either String String] -> ([String], [String]))
-> ([ByteString] -> [Either String String])
-> [ByteString]
-> ([String], [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Either String String -> Bool)
-> [Either String String] -> [Either String String]
forall a. (a -> Bool) -> [a] -> [a]
filter ((String -> Bool)
-> (String -> Bool) -> Either String String -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> String -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null))
([Either String String] -> [Either String String])
-> ([ByteString] -> [Either String String])
-> [ByteString]
-> [Either String String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either String String)
-> [ByteString] -> [Either String String]
forall a b. (a -> b) -> [a] -> [b]
map (\ByteString
bsname ->
let sbsname :: ByteString
sbsname = ByteString -> ByteString
LBS.toStrict ByteString
bsname
in case ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
sbsname of
Left UnicodeException
_ -> String -> Either String String
forall a b. a -> Either a b
Left (Text -> String
T.unpack (ByteString -> Text
decodeUtf8LenientCompat ByteString
sbsname))
Right Text
name -> String -> Either String String
forall a b. b -> Either a b
Right (Text -> String
T.unpack Text
name))
([ByteString] -> [Either String String])
-> ([ByteString] -> [ByteString])
-> [ByteString]
-> [Either String String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString) -> [ByteString] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map ((Word8 -> Bool) -> ByteString -> ByteString
LBS.takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isAsciiSpace))
([ByteString] -> ([String], [String]))
-> [ByteString] -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ [ByteString]
pkgList
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
failedPkgNames)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Verbosity -> String -> IO ()
info Verbosity
verbosity (String
"Some pkg-config packages have names containing invalid unicode: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
failedPkgNames)
(String
outs, String
_errs, ExitCode
exitCode) <-
Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity
(ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig (String
"--modversion" String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
pkgNames))
let pkgVersions :: [String]
pkgVersions = String -> [String]
lines String
outs
if ExitCode
exitCode ExitCode -> ExitCode -> Bool
forall a. Eq a => a -> a -> Bool
== ExitCode
ExitSuccess Bool -> Bool -> Bool
&& [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pkgVersions Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [String] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
pkgNames
then (PkgConfigDb -> IO PkgConfigDb
forall a. a -> IO a
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
else
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 ([(String, String)] -> PkgConfigDb)
-> ([Maybe (String, String)] -> [(String, String)])
-> [Maybe (String, String)]
-> PkgConfigDb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Maybe (String, String)] -> [(String, String)]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe (String, String)] -> PkgConfigDb)
-> IO [Maybe (String, String)] -> IO PkgConfigDb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO (Maybe (String, String)))
-> [String] -> IO [Maybe (String, String)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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"
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 a. a -> IO a
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)
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])
Maybe (String, String) -> IO (Maybe (String, String))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (String, String) -> IO (Maybe (String, String)))
-> Maybe (String, String) -> IO (Maybe (String, String))
forall a b. (a -> b) -> a -> b
$ case ExitCode
exitCode of
ExitCode
ExitSuccess -> (String, String) -> Maybe (String, String)
forall a. a -> Maybe a
Just (String
pkg, String
pkgVersion)
ExitCode
_ -> Maybe (String, String)
forall a. Maybe a
Nothing
isAsciiSpace :: Word8 -> Bool
isAsciiSpace :: Word8 -> Bool
isAsciiSpace Word8
c = Word8
c Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) String
" \t"
decodeUtf8LenientCompat :: ByteString -> T.Text
decodeUtf8LenientCompat :: ByteString -> Text
decodeUtf8LenientCompat = OnDecodeError -> ByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode
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 a b. IO (a -> b) -> IO a -> IO b
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 a. a -> IO a
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 a. [a] -> 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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []