    {-# 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 []