{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE LambdaCase         #-}
-----------------------------------------------------------------------------
-- |
-- 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           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)

-- | 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
$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

-- | 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
    mpkgConfig <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
pkgConfigProgram ProgramDb
progdb
    case mpkgConfig of
      Maybe (ConfiguredProgram, ProgramDb)
Nothing             -> String -> IO PkgConfigDb
noPkgConfig String
"Cannot find pkg-config program"
      Just (ConfiguredProgram
pkgConfig, ProgramDb
_) -> do
        -- To prevent malformed Unicode in the descriptions from crashing cabal,
        -- read without interpreting any encoding first. (#9608)
        (listAllOutput, listAllErrs, listAllExitcode) <-
          Verbosity -> ProgramInvocation -> IO (ByteString, String, ExitCode)
getProgramInvocationLBSAndErrors Verbosity
verbosity (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig [String
"--list-all"])
        when (listAllExitcode /= ExitSuccess) $
          ioError (userError ("pkg-config --list-all failed: " ++ listAllErrs))
        let 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
        -- Now decode the package *names* to a String. The ones where decoding
        -- failed end up in 'failedPkgNames'.
        let (failedPkgNames, pkgNames) =
              partitionEithers
              -- Drop empty package names. This will handle empty lines
              -- in pkg-config's output, including the spurious one
              -- after the last newline (because of LBS.split).
              . filter (either (const True) (not . null))
              -- Try decoding strictly; if it fails, put the lenient
              -- decoding in a Left for later reporting.
              . map (\ByteString
bsname ->
                       let sbsname :: StrictByteString
sbsname = ByteString -> StrictByteString
LBS.toStrict ByteString
bsname
                       in case StrictByteString -> Either UnicodeException Text
T.decodeUtf8' StrictByteString
sbsname of
                            Left UnicodeException
_ -> String -> Either String String
forall a b. a -> Either a b
Left (Text -> String
T.unpack (StrictByteString -> Text
decodeUtf8LenientCompat StrictByteString
sbsname))
                            Right Text
name -> String -> Either String String
forall a b. b -> Either a b
Right (Text -> String
T.unpack Text
name))
              -- The output of @pkg-config --list-all@ also includes a
              -- description for each package, which we do not need.
              -- We don't use Data.Char.isSpace because that would also
              -- include 0xA0, the non-breaking space, which can occur
              -- in multi-byte UTF-8 sequences.
              . map (LBS.takeWhile (not . isAsciiSpace))
              $ pkgList
        when (not (null failedPkgNames)) $
          info verbosity ("Some pkg-config packages have names containing invalid unicode: " ++ intercalate ", " failedPkgNames)
        (outs, _errs, exitCode) <-
                     getProgramInvocationOutputAndErrors verbosity
                       (programInvocation pkgConfig ("--modversion" : pkgNames))
        let pkgVersions = String -> [String]
lines String
outs
        if exitCode == ExitSuccess && length pkgVersions == length pkgNames
          then (return . pkgConfigDbFromList . zip pkgNames) pkgVersions
          else
          -- if there's a single broken pc file the above fails, so we fall back
          -- into calling it individually
          --
          -- Also some implementations of @pkg-config@ do not provide more than
          -- one package version, so if the returned list is shorter than the
          -- requested one, we fall back to querying one by one.
          do
            info verbosity ("call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package")
            pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames
  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 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
       (pkgVersion, _errs, exitCode) <-
               Verbosity -> ProgramInvocation -> IO (String, String, ExitCode)
getProgramInvocationOutputAndErrors Verbosity
verbosity
                 (ConfiguredProgram -> [String] -> ProgramInvocation
programInvocation ConfiguredProgram
pkgConfig [String
"--modversion", String
pkg])
       return $ case 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"

    -- The decodeUtf8Lenient function is defined starting with text-2.0.1; this
    -- function simply reimplements it. When the minimum supported GHC version
    -- is >= 9.4, switch to decodeUtf8Lenient.
    decodeUtf8LenientCompat :: ByteString -> T.Text
    decodeUtf8LenientCompat :: StrictByteString -> Text
decodeUtf8LenientCompat = OnDecodeError -> StrictByteString -> Text
T.decodeUtf8With OnDecodeError
T.lenientDecode

-- | 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 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
    -- 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
      mpkgConfig <- Verbosity
-> Program
-> ProgramDb
-> IO (Maybe (ConfiguredProgram, ProgramDb))
needProgram Verbosity
verbosity Program
pkgConfigProgram ProgramDb
progdb
      case 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 []