{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Simple.Configure
-- Copyright   :  Isaac Jones 2003-2005
-- License     :  BSD3
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This deals with the /configure/ phase. It provides the 'configure' action
-- which is given the package description and configure flags. It then tries
-- to: configure the compiler; resolves any conditionals in the package
-- description; resolve the package dependencies; check if all the extensions
-- used by this package are supported by the compiler; check that all the build
-- tools are available (including version checks if appropriate); checks for
-- any required @pkg-config@ packages (updating the 'BuildInfo' with the
-- results)
--
-- Then based on all this it saves the info in the 'LocalBuildInfo' and writes
-- it out to the @dist\/setup-config@ file. It also displays various details to
-- the user, the amount of information displayed depending on the verbosity
-- level.

module Distribution.Simple.Configure
  ( configure
  , writePersistBuildConfig
  , getConfigStateFile
  , getPersistBuildConfig
  , checkPersistBuildConfigOutdated
  , tryGetPersistBuildConfig
  , maybeGetPersistBuildConfig
  , findDistPref, findDistPrefOrDefault
  , getInternalLibraries
  , computeComponentId
  , computeCompatPackageKey
  , localBuildInfoFile
  , getInstalledPackages
  , getInstalledPackagesMonitorFiles
  , getPackageDBContents
  , configCompilerEx, configCompilerAuxEx
  , computeEffectiveProfiling
  , ccLdOptionsBuildInfo
  , checkForeignDeps
  , interpretPackageDbFlags
  , ConfigStateFileError(..)
  , tryGetConfigStateFile
  , platformDefines,
  ) where

import Prelude ()
import Distribution.Compat.Prelude

import Distribution.Compiler
import Distribution.Types.IncludeRenaming
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
import Distribution.Simple.PreProcess
import Distribution.Package
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription
import Distribution.PackageDescription.PrettyPrint
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.Program
import Distribution.Simple.Setup as Setup
import Distribution.Simple.BuildTarget
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.PackageVersionConstraint
import Distribution.Types.LocalBuildInfo
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.GivenComponent
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Stack
import Distribution.Backpack.Configure
import Distribution.Backpack.DescribeUnitId
import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.Id
import Distribution.Utils.LogProgress

import qualified Distribution.Simple.GHC   as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.UHC   as UHC
import qualified Distribution.Simple.HaskellSuite as HaskellSuite

import Control.Exception
    ( try )
import Distribution.Utils.Structured ( structuredDecodeOrFailIO, structuredEncode )
import Distribution.Compat.Directory ( listDirectory )
import Data.ByteString.Lazy          ( ByteString )
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List
    ( (\\), stripPrefix, intersect)
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map as Map
import System.Directory
    ( canonicalizePath, createDirectoryIfMissing, doesFileExist
    , getTemporaryDirectory, removeFile)
import System.FilePath
    ( (</>), isAbsolute, takeDirectory )
import Distribution.Compat.Directory
    ( doesPathExist )
import qualified System.Info
    ( compilerName, compilerVersion )
import System.IO
    ( hPutStrLn, hClose )
import Distribution.Pretty
    ( pretty, defaultStyle, prettyShow )
import Distribution.Parsec
    ( simpleParsec )
import Text.PrettyPrint
    ( Doc, ($+$), char, comma, hsep, nest
    , punctuate, quotes, render, renderStyle, sep, text )
import Distribution.Compat.Environment ( lookupEnv )

import qualified Data.Maybe as M
import qualified Data.Set as Set
import qualified Distribution.Compat.NonEmptySet as NES


type UseExternalInternalDeps = Bool

-- | The errors that can be thrown when reading the @setup-config@ file.
data ConfigStateFileError
    = ConfigStateFileNoHeader -- ^ No header found.
    | ConfigStateFileBadHeader -- ^ Incorrect header.
    | ConfigStateFileNoParse -- ^ Cannot parse file contents.
    | ConfigStateFileMissing -- ^ No file!
    | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
      (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
  deriving (Typeable)

-- | Format a 'ConfigStateFileError' as a user-facing error message.
dispConfigStateFileError :: ConfigStateFileError -> Doc
dispConfigStateFileError :: ConfigStateFileError -> Doc
dispConfigStateFileError ConfigStateFileError
ConfigStateFileNoHeader =
    ProgArg -> Doc
text ProgArg
"Saved package config file header is missing."
    Doc -> Doc -> Doc
<+> ProgArg -> Doc
text ProgArg
"Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileError
ConfigStateFileBadHeader =
    ProgArg -> Doc
text ProgArg
"Saved package config file header is corrupt."
    Doc -> Doc -> Doc
<+> ProgArg -> Doc
text ProgArg
"Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileError
ConfigStateFileNoParse =
    ProgArg -> Doc
text ProgArg
"Saved package config file is corrupt."
    Doc -> Doc -> Doc
<+> ProgArg -> Doc
text ProgArg
"Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileError
ConfigStateFileMissing =
    ProgArg -> Doc
text ProgArg
"Run the 'configure' command first."
dispConfigStateFileError (ConfigStateFileBadVersion PackageIdentifier
oldCabal PackageIdentifier
oldCompiler Either ConfigStateFileError LocalBuildInfo
_) =
    ProgArg -> Doc
text ProgArg
"Saved package config file is outdated:"
    Doc -> Doc -> Doc
$+$ Doc
badCabal Doc -> Doc -> Doc
$+$ Doc
badCompiler
    Doc -> Doc -> Doc
$+$ ProgArg -> Doc
text ProgArg
"Re-run the 'configure' command."
    where
      badCabal :: Doc
badCabal =
          ProgArg -> Doc
text ProgArg
"• the Cabal version changed from"
          Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
oldCabal Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
currentCabalId
      badCompiler :: Doc
badCompiler
        | PackageIdentifier
oldCompiler forall a. Eq a => a -> a -> Bool
== PackageIdentifier
currentCompilerId = forall a. Monoid a => a
mempty
        | Bool
otherwise =
            ProgArg -> Doc
text ProgArg
"• the compiler changed from"
            Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
oldCompiler Doc -> Doc -> Doc
<+> Doc
"to" Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty PackageIdentifier
currentCompilerId

instance Show ConfigStateFileError where
    show :: ConfigStateFileError -> ProgArg
show = Style -> Doc -> ProgArg
renderStyle Style
defaultStyle forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigStateFileError -> Doc
dispConfigStateFileError

instance Exception ConfigStateFileError

-- | Read the 'localBuildInfoFile'.  Throw an exception if the file is
-- missing, if the file cannot be read, or if the file was created by an older
-- version of Cabal.
getConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
                   -> IO LocalBuildInfo
getConfigStateFile :: ProgArg -> IO LocalBuildInfo
getConfigStateFile ProgArg
filename = do
    Bool
exists <- ProgArg -> IO Bool
doesFileExist ProgArg
filename
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ forall e a. Exception e => e -> IO a
throwIO ConfigStateFileError
ConfigStateFileMissing
    -- Read the config file into a strict ByteString to avoid problems with
    -- lazy I/O, then convert to lazy because the binary package needs that.
    ByteString
contents <- ProgArg -> IO ByteString
BS.readFile ProgArg
filename
    let (ByteString
header, ByteString
body) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BLC8.span (forall a. Eq a => a -> a -> Bool
/=Char
'\n') ([ByteString] -> ByteString
BLC8.fromChunks [ByteString
contents])

    (PackageIdentifier
cabalId, PackageIdentifier
compId) <- ByteString -> IO (PackageIdentifier, PackageIdentifier)
parseHeader ByteString
header

    let getStoredValue :: IO LocalBuildInfo
getStoredValue = do
          Either ProgArg LocalBuildInfo
result <- forall a.
(Binary a, Structured a) =>
ByteString -> IO (Either ProgArg a)
structuredDecodeOrFailIO (HasCallStack => ByteString -> ByteString
BLC8.tail ByteString
body)
          case Either ProgArg LocalBuildInfo
result of
            Left ProgArg
_ -> forall e a. Exception e => e -> IO a
throwIO ConfigStateFileError
ConfigStateFileNoParse
            Right LocalBuildInfo
x -> forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildInfo
x
        deferErrorIfBadVersion :: IO LocalBuildInfo -> IO LocalBuildInfo
deferErrorIfBadVersion IO LocalBuildInfo
act
          | PackageIdentifier
cabalId forall a. Eq a => a -> a -> Bool
/= PackageIdentifier
currentCabalId = do
              Either ConfigStateFileError LocalBuildInfo
eResult <- forall e a. Exception e => IO a -> IO (Either e a)
try IO LocalBuildInfo
act
              forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ PackageIdentifier
-> PackageIdentifier
-> Either ConfigStateFileError LocalBuildInfo
-> ConfigStateFileError
ConfigStateFileBadVersion PackageIdentifier
cabalId PackageIdentifier
compId Either ConfigStateFileError LocalBuildInfo
eResult
          | Bool
otherwise = IO LocalBuildInfo
act
    IO LocalBuildInfo -> IO LocalBuildInfo
deferErrorIfBadVersion IO LocalBuildInfo
getStoredValue
  where
    CallStack
_ = HasCallStack => CallStack
callStack -- TODO: attach call stack to exception

-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
                      -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile :: ProgArg -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> IO LocalBuildInfo
getConfigStateFile

-- | Try to read the 'localBuildInfoFile'.
tryGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                         -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig :: ProgArg -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig = forall e a. Exception e => IO a -> IO (Either e a)
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> IO LocalBuildInfo
getPersistBuildConfig

-- | Read the 'localBuildInfoFile'. Throw an exception if the file is
-- missing, if the file cannot be read, or if the file was created by an older
-- version of Cabal.
getPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                      -> IO LocalBuildInfo
getPersistBuildConfig :: ProgArg -> IO LocalBuildInfo
getPersistBuildConfig = ProgArg -> IO LocalBuildInfo
getConfigStateFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
localBuildInfoFile

-- | Try to read the 'localBuildInfoFile'.
maybeGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                           -> IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig :: ProgArg -> IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig =
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const forall a. Maybe a
Nothing) forall a. a -> Maybe a
Just) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig

-- | After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
writePersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                        -> LocalBuildInfo -- ^ The 'LocalBuildInfo' to write.
                        -> IO ()
writePersistBuildConfig :: ProgArg -> LocalBuildInfo -> IO ()
writePersistBuildConfig ProgArg
distPref LocalBuildInfo
lbi = do
    Bool -> ProgArg -> IO ()
createDirectoryIfMissing Bool
False ProgArg
distPref
    ProgArg -> ByteString -> IO ()
writeFileAtomic (ShowS
localBuildInfoFile ProgArg
distPref) forall a b. (a -> b) -> a -> b
$
      [ByteString] -> ByteString
BLC8.unlines [PackageIdentifier -> ByteString
showHeader PackageIdentifier
pkgId, forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode LocalBuildInfo
lbi]
  where
    pkgId :: PackageIdentifier
pkgId = LocalBuildInfo -> PackageIdentifier
localPackage LocalBuildInfo
lbi

-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
currentCabalId :: PackageIdentifier
currentCabalId = PackageName -> Version -> PackageIdentifier
PackageIdentifier (ProgArg -> PackageName
mkPackageName ProgArg
"Cabal") Version
cabalVersion

-- | Identifier of the current compiler package.
currentCompilerId :: PackageIdentifier
currentCompilerId :: PackageIdentifier
currentCompilerId = PackageName -> Version -> PackageIdentifier
PackageIdentifier (ProgArg -> PackageName
mkPackageName ProgArg
System.Info.compilerName)
                                      (Version -> Version
mkVersion' Version
System.Info.compilerVersion)

-- | Parse the @setup-config@ file header, returning the package identifiers
-- for Cabal and the compiler.
parseHeader :: ByteString -- ^ The file contents.
            -> IO (PackageIdentifier, PackageIdentifier)
parseHeader :: ByteString -> IO (PackageIdentifier, PackageIdentifier)
parseHeader ByteString
header = case ByteString -> [ByteString]
BLC8.words ByteString
header of
  [ByteString
"Saved", ByteString
"package", ByteString
"config", ByteString
"for", ByteString
pkgId, ByteString
"written", ByteString
"by", ByteString
cabalId,
   ByteString
"using", ByteString
compId] ->
      forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO ConfigStateFileError
ConfigStateFileBadHeader) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
          PackageIdentifier
_ <- forall a. Parsec a => ProgArg -> Maybe a
simpleParsec (ByteString -> ProgArg
fromUTF8LBS ByteString
pkgId) :: Maybe PackageIdentifier
          PackageIdentifier
cabalId' <- forall a. Parsec a => ProgArg -> Maybe a
simpleParsec (ByteString -> ProgArg
BLC8.unpack ByteString
cabalId)
          PackageIdentifier
compId' <- forall a. Parsec a => ProgArg -> Maybe a
simpleParsec (ByteString -> ProgArg
BLC8.unpack ByteString
compId)
          forall (m :: * -> *) a. Monad m => a -> m a
return (PackageIdentifier
cabalId', PackageIdentifier
compId')
  [ByteString]
_ -> forall e a. Exception e => e -> IO a
throwIO ConfigStateFileError
ConfigStateFileNoHeader

-- | Generate the @setup-config@ file header.
showHeader :: PackageIdentifier -- ^ The processed package.
            -> ByteString
showHeader :: PackageIdentifier -> ByteString
showHeader PackageIdentifier
pkgId = [ByteString] -> ByteString
BLC8.unwords
    [ ByteString
"Saved", ByteString
"package", ByteString
"config", ByteString
"for"
    , ProgArg -> ByteString
toUTF8LBS forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
pkgId
    , ByteString
"written", ByteString
"by"
    , ProgArg -> ByteString
BLC8.pack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCabalId
    , ByteString
"using"
    , ProgArg -> ByteString
BLC8.pack forall a b. (a -> b) -> a -> b
$ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCompilerId
    ]

-- | Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool
checkPersistBuildConfigOutdated :: ProgArg -> ProgArg -> IO Bool
checkPersistBuildConfigOutdated ProgArg
distPref ProgArg
pkg_descr_file =
  ProgArg
pkg_descr_file ProgArg -> ProgArg -> IO Bool
`moreRecentFile` ShowS
localBuildInfoFile ProgArg
distPref

-- | Get the path of @dist\/setup-config@.
localBuildInfoFile :: FilePath -- ^ The @dist@ directory path.
                    -> FilePath
localBuildInfoFile :: ShowS
localBuildInfoFile ProgArg
distPref = ProgArg
distPref ProgArg -> ShowS
</> ProgArg
"setup-config"

-- -----------------------------------------------------------------------------
-- * Configuration
-- -----------------------------------------------------------------------------

-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix, the
-- \"CABAL_BUILDDIR\" environment variable, or the default prefix.
findDistPref :: FilePath  -- ^ default \"dist\" prefix
             -> Setup.Flag FilePath  -- ^ override \"dist\" prefix
             -> IO FilePath
findDistPref :: ProgArg -> Flag ProgArg -> IO ProgArg
findDistPref ProgArg
defDistPref Flag ProgArg
overrideDistPref = do
    Flag ProgArg
envDistPref <- forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM forall {t :: * -> *} {a}. Foldable t => Maybe (t a) -> Flag (t a)
parseEnvDistPref (ProgArg -> IO (Maybe ProgArg)
lookupEnv ProgArg
"CABAL_BUILDDIR")
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Flag a -> a
fromFlagOrDefault ProgArg
defDistPref (forall a. Monoid a => a -> a -> a
mappend Flag ProgArg
envDistPref Flag ProgArg
overrideDistPref)
  where
    parseEnvDistPref :: Maybe (t a) -> Flag (t a)
parseEnvDistPref Maybe (t a)
env =
      case Maybe (t a)
env of
        Just t a
distPref | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
distPref) -> forall a. a -> Flag a
toFlag t a
distPref
        Maybe (t a)
_ -> forall a. Flag a
NoFlag

-- | Return the \"dist/\" prefix, or the default prefix. The prefix is taken
-- from (in order of highest to lowest preference) the override prefix, the
-- \"CABAL_BUILDDIR\" environment variable, or 'defaultDistPref' is used. Call
-- this function to resolve a @*DistPref@ flag whenever it is not known to be
-- set. (The @*DistPref@ flags are always set to a definite value before
-- invoking 'UserHooks'.)
findDistPrefOrDefault :: Setup.Flag FilePath  -- ^ override \"dist\" prefix
                      -> IO FilePath
findDistPrefOrDefault :: Flag ProgArg -> IO ProgArg
findDistPrefOrDefault = ProgArg -> Flag ProgArg -> IO ProgArg
findDistPref ProgArg
defaultDistPref

-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
configure :: (GenericPackageDescription, HookedBuildInfo)
          -> ConfigFlags -> IO LocalBuildInfo
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure (GenericPackageDescription
pkg_descr0, HookedBuildInfo
pbi) ConfigFlags
cfg = do
    -- Determine the component we are configuring, if a user specified
    -- one on the command line.  We use a fake, flattened version of
    -- the package since at this point, we're not really sure what
    -- components we *can* configure.  @Nothing@ means that we should
    -- configure everything (the old behavior).
    (Maybe ComponentName
mb_cname :: Maybe ComponentName) <- do
        let flat_pkg_descr :: PackageDescription
flat_pkg_descr = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
pkg_descr0
        [BuildTarget]
targets <- Verbosity -> PackageDescription -> [ProgArg] -> IO [BuildTarget]
readBuildTargets Verbosity
verbosity PackageDescription
flat_pkg_descr (ConfigFlags -> [ProgArg]
configArgs ConfigFlags
cfg)
        -- TODO: bleat if you use the module/file syntax
        let targets' :: [ComponentName]
targets' = [ ComponentName
cname | BuildTargetComponent ComponentName
cname <- [BuildTarget]
targets ]
        case [ComponentName]
targets' of
            [ComponentName]
_ | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ConfigFlags -> [ProgArg]
configArgs ConfigFlags
cfg) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
            [ComponentName
cname] -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just ComponentName
cname)
            [] -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
"No valid component targets found"
            [ComponentName]
_  -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity
                  ProgArg
"Can only configure either single component or all of them"

    let use_external_internal_deps :: Bool
use_external_internal_deps = forall a. Maybe a -> Bool
isJust Maybe ComponentName
mb_cname
    case Maybe ComponentName
mb_cname of
        Maybe ComponentName
Nothing -> Verbosity -> ProgArg -> PackageIdentifier -> IO ()
setupMessage Verbosity
verbosity ProgArg
"Configuring" (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
pkg_descr0)
        Just ComponentName
cname -> forall a.
Pretty a =>
Verbosity
-> ProgArg
-> PackageIdentifier
-> ComponentName
-> Maybe [(ModuleName, a)]
-> IO ()
setupMessage' Verbosity
verbosity ProgArg
"Configuring" (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
pkg_descr0)
                        ComponentName
cname (forall a. a -> Maybe a
Just (ConfigFlags -> [(ModuleName, Module)]
configInstantiateWith ConfigFlags
cfg))

    -- configCID is only valid for per-component configure
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust (forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag ComponentId
configCID ConfigFlags
cfg)) Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe ComponentName
mb_cname) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
"--cid is only supported for per-component configure"

    Verbosity -> ConfigFlags -> IO ()
checkDeprecatedFlags Verbosity
verbosity ConfigFlags
cfg
    Verbosity -> GenericPackageDescription -> ConfigFlags -> IO ()
checkExactConfiguration Verbosity
verbosity GenericPackageDescription
pkg_descr0 ConfigFlags
cfg

    -- Where to build the package
    let buildDir :: FilePath -- e.g. dist/build
        -- fromFlag OK due to Distribution.Simple calling
        -- findDistPrefOrDefault to fill it in
        buildDir :: ProgArg
buildDir = forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag ProgArg
configDistPref ConfigFlags
cfg) ProgArg -> ShowS
</> ProgArg
"build"
    Verbosity -> Bool -> ProgArg -> IO ()
createDirectoryIfMissingVerbose (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) Bool
True ProgArg
buildDir

    -- What package database(s) to use
    let packageDbs :: PackageDBStack
        packageDbs :: PackageDBStack
packageDbs
         = Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags
            (forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
cfg))
            (ConfigFlags -> [Maybe PackageDB]
configPackageDBs ConfigFlags
cfg)

    -- comp:            the compiler we're building with
    -- compPlatform:    the platform we're building for
    -- programDb:  location and args of all programs we're
    --                  building with
    (Compiler
comp         :: Compiler,
     Platform
compPlatform :: Platform,
     ProgramDb
programDb    :: ProgramDb)
        <- Maybe CompilerFlavor
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx
            (forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag CompilerFlavor
configHcFlavor ConfigFlags
cfg))
            (forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag ProgArg
configHcPath ConfigFlags
cfg))
            (forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag ProgArg
configHcPkg ConfigFlags
cfg))
            (ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb ConfigFlags
cfg (WithCallStack (ConfigFlags -> ProgramDb)
configPrograms ConfigFlags
cfg))
            (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity)

    -- The InstalledPackageIndex of all installed packages
    InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
        <- Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) Compiler
comp
                                  PackageDBStack
packageDbs ProgramDb
programDb

    -- The set of package names which are "shadowed" by internal
    -- packages, and which component they map to
    let internalPackageSet :: Set LibraryName
        internalPackageSet :: Set LibraryName
internalPackageSet = GenericPackageDescription -> Set LibraryName
getInternalLibraries GenericPackageDescription
pkg_descr0

    -- Make a data structure describing what components are enabled.
    let enabled :: ComponentRequestedSpec
        enabled :: ComponentRequestedSpec
enabled = case Maybe ComponentName
mb_cname of
                    Just ComponentName
cname -> ComponentName -> ComponentRequestedSpec
OneComponentRequestedSpec ComponentName
cname
                    Maybe ComponentName
Nothing -> ComponentRequestedSpec
                                -- The flag name (@--enable-tests@) is a
                                -- little bit of a misnomer, because
                                -- just passing this flag won't
                                -- "enable", in our internal
                                -- nomenclature; it's just a request; a
                                -- @buildable: False@ might make it
                                -- not possible to enable.
                                { testsRequested :: Bool
testsRequested = forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configTests ConfigFlags
cfg)
                                , benchmarksRequested :: Bool
benchmarksRequested =
                                  forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
cfg) }
    -- Some sanity checks related to enabling components.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe ComponentName
mb_cname
          Bool -> Bool -> Bool
&& (forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configTests ConfigFlags
cfg) Bool -> Bool -> Bool
|| forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
cfg))) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
              ProgArg
"--enable-tests/--enable-benchmarks are incompatible with" forall a. [a] -> [a] -> [a]
++
              ProgArg
" explicitly specifying a component to configure."

    -- Some sanity checks related to dynamic/static linking.
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configDynExe ConfigFlags
cfg) Bool -> Bool -> Bool
&& forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configFullyStaticExe ConfigFlags
cfg)) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
              ProgArg
"--enable-executable-dynamic and --enable-executable-static" forall a. [a] -> [a] -> [a]
++
              ProgArg
" are incompatible with each other."

    -- allConstraints:  The set of all 'Dependency's we have.  Used ONLY
    --                  to 'configureFinalizedPackage'.
    -- requiredDepsMap: A map from 'PackageName' to the specifically
    --                  required 'InstalledPackageInfo', due to --dependency
    --
    -- NB: These constraints are to be applied to ALL components of
    -- a package.  Thus, it's not an error if allConstraints contains
    -- more constraints than is necessary for a component (another
    -- component might need it.)
    --
    -- NB: The fact that we bundle all the constraints together means
    -- that is not possible to configure a test-suite to use one
    -- version of a dependency, and the executable to use another.
    ([PackageVersionConstraint]
allConstraints  :: [PackageVersionConstraint],
     Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo)
        <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity) forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
              [PackageVersionConstraint]
-> [GivenComponent]
-> InstalledPackageIndex
-> Either
     ProgArg
     ([PackageVersionConstraint],
      Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints (ConfigFlags -> [PackageVersionConstraint]
configConstraints ConfigFlags
cfg)
                                  (ConfigFlags -> [GivenComponent]
configDependencies ConfigFlags
cfg)
                                  InstalledPackageIndex
installedPackageSet

    -- pkg_descr:   The resolved package description, that does not contain any
    --              conditionals, because we have an assignment for
    --              every flag, either picking them ourselves using a
    --              simple naive algorithm, or having them be passed to
    --              us by 'configConfigurationsFlags')
    -- flags:       The 'FlagAssignment' that the conditionals were
    --              resolved with.
    --
    -- NB: Why doesn't finalizing a package also tell us what the
    -- dependencies are (e.g. when we run the naive algorithm,
    -- we are checking if dependencies are satisfiable)?  The
    -- primary reason is that we may NOT have done any solving:
    -- if the flags are all chosen for us, this step is a simple
    -- matter of flattening according to that assignment.  It's
    -- cleaner to then configure the dependencies afterwards.
    (PackageDescription
pkg_descr :: PackageDescription,
     FlagAssignment
flags     :: FlagAssignment)
        <- Verbosity
-> ConfigFlags
-> ComponentRequestedSpec
-> [PackageVersionConstraint]
-> (Dependency -> Bool)
-> Compiler
-> Platform
-> GenericPackageDescription
-> IO (PackageDescription, FlagAssignment)
configureFinalizedPackage Verbosity
verbosity ConfigFlags
cfg ComponentRequestedSpec
enabled
                [PackageVersionConstraint]
allConstraints
                (Bool
-> Bool
-> Bool
-> PackageName
-> InstalledPackageIndex
-> Set LibraryName
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Dependency
-> Bool
dependencySatisfiable
                    Bool
use_external_internal_deps
                    (forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configExactConfiguration ConfigFlags
cfg))
                    (forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configAllowDependingOnPrivateLibs ConfigFlags
cfg))
                    (forall pkg. Package pkg => pkg -> PackageName
packageName GenericPackageDescription
pkg_descr0)
                    InstalledPackageIndex
installedPackageSet
                    Set LibraryName
internalPackageSet
                    Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap)
                Compiler
comp
                Platform
compPlatform
                GenericPackageDescription
pkg_descr0

    Verbosity -> ProgArg -> IO ()
debug Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Finalized package description:\n"
                  forall a. [a] -> [a] -> [a]
++ PackageDescription -> ProgArg
showPackageDescription PackageDescription
pkg_descr

    let cabalFileDir :: ProgArg
cabalFileDir = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ProgArg
"." ShowS
takeDirectory forall a b. (a -> b) -> a -> b
$
          forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag ProgArg
configCabalFilePath ConfigFlags
cfg)
    Verbosity
-> Compiler
-> PackageDescription
-> ComponentRequestedSpec
-> IO ()
checkCompilerProblems Verbosity
verbosity Compiler
comp PackageDescription
pkg_descr ComponentRequestedSpec
enabled
    Verbosity
-> ProgArg
-> GenericPackageDescription
-> PackageDescription
-> IO ()
checkPackageProblems Verbosity
verbosity ProgArg
cabalFileDir GenericPackageDescription
pkg_descr0
        (HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription HookedBuildInfo
pbi PackageDescription
pkg_descr)

    -- The list of 'InstalledPackageInfo' recording the selected
    -- dependencies on external packages.
    --
    -- Invariant: For any package name, there is at most one package
    -- in externalPackageDeps which has that name.
    --
    -- NB: The dependency selection is global over ALL components
    -- in the package (similar to how allConstraints and
    -- requiredDepsMap are global over all components).  In particular,
    -- if *any* component (post-flag resolution) has an unsatisfiable
    -- dependency, we will fail.  This can sometimes be undesirable
    -- for users, see #1786 (benchmark conflicts with executable),
    --
    -- In the presence of Backpack, these package dependencies are
    -- NOT complete: they only ever include the INDEFINITE
    -- dependencies.  After we apply an instantiation, we'll get
    -- definite references which constitute extra dependencies.
    -- (Why not have cabal-install pass these in explicitly?
    -- For one it's deterministic; for two, we need to associate
    -- them with renamings which would require a far more complicated
    -- input scheme than what we have today.)
    [PreExistingComponent]
externalPkgDeps :: [PreExistingComponent]
        <- Verbosity
-> Bool
-> Set LibraryName
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> PackageDescription
-> ComponentRequestedSpec
-> IO [PreExistingComponent]
configureDependencies
                Verbosity
verbosity
                Bool
use_external_internal_deps
                Set LibraryName
internalPackageSet
                InstalledPackageIndex
installedPackageSet
                Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
                PackageDescription
pkg_descr
                ComponentRequestedSpec
enabled

    -- Compute installation directory templates, based on user
    -- configuration.
    --
    -- TODO: Move this into a helper function.
    InstallDirTemplates
defaultDirs :: InstallDirTemplates
        <- Bool -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates
defaultInstallDirs' Bool
use_external_internal_deps
                              (Compiler -> CompilerFlavor
compilerFlavor Compiler
comp)
                              (forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
cfg))
                              (PackageDescription -> Bool
hasLibs PackageDescription
pkg_descr)
    let installDirs :: InstallDirTemplates
        installDirs :: InstallDirTemplates
installDirs = forall a b c.
(a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
combineInstallDirs forall a. a -> Flag a -> a
fromFlagOrDefault
                        InstallDirTemplates
defaultDirs (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs ConfigFlags
cfg)

    -- Check languages and extensions
    -- TODO: Move this into a helper function.
    let langlist :: [Language]
langlist = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map BuildInfo -> Maybe Language
defaultLanguage
                   (PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled)
    let langs :: [Language]
langs = Compiler -> [Language] -> [Language]
unsupportedLanguages Compiler
comp [Language]
langlist
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Language]
langs)) forall a b. (a -> b) -> a -> b
$
      forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"The package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
pkg_descr0)
         forall a. [a] -> [a] -> [a]
++ ProgArg
" requires the following languages which are not "
         forall a. [a] -> [a] -> [a]
++ ProgArg
"supported by " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (Compiler -> CompilerId
compilerId Compiler
comp) forall a. [a] -> [a] -> [a]
++ ProgArg
": "
         forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> ProgArg
prettyShow [Language]
langs)
    let extlist :: [Extension]
extlist = forall a. Eq a => [a] -> [a]
nub forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [Extension]
allExtensions
                  (PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled)
    let exts :: [Extension]
exts = Compiler -> [Extension] -> [Extension]
unsupportedExtensions Compiler
comp [Extension]
extlist
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
exts)) forall a b. (a -> b) -> a -> b
$
      forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"The package " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
pkg_descr0)
         forall a. [a] -> [a] -> [a]
++ ProgArg
" requires the following language extensions which are not "
         forall a. [a] -> [a] -> [a]
++ ProgArg
"supported by " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (Compiler -> CompilerId
compilerId Compiler
comp) forall a. [a] -> [a] -> [a]
++ ProgArg
": "
         forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> ProgArg
prettyShow [Extension]
exts)

    -- Check foreign library build requirements
    let flibs :: [ForeignLib]
flibs = [ForeignLib
flib | CFLib ForeignLib
flib <- PackageDescription -> ComponentRequestedSpec -> [Component]
enabledComponents PackageDescription
pkg_descr ComponentRequestedSpec
enabled]
    let unsupportedFLibs :: [ProgArg]
unsupportedFLibs = Compiler -> Platform -> [ForeignLib] -> [ProgArg]
unsupportedForeignLibs Compiler
comp Platform
compPlatform [ForeignLib]
flibs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProgArg]
unsupportedFLibs)) forall a b. (a -> b) -> a -> b
$
      forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Cannot build some foreign libraries: "
         forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
"," [ProgArg]
unsupportedFLibs

    -- Configure certain external build tools, see below for which ones.
    let requiredBuildTools :: [LegacyExeDependency]
requiredBuildTools = do
          BuildInfo
bi <- PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled
          -- First, we collect any tool dep that we know is external. This is,
          -- in practice:
          --
          -- 1. `build-tools` entries on the whitelist
          --
          -- 2. `build-tool-depends` that aren't from the current package.
          let externBuildToolDeps :: [LegacyExeDependency]
externBuildToolDeps =
                [ ProgArg -> VersionRange -> LegacyExeDependency
LegacyExeDependency (UnqualComponentName -> ProgArg
unUnqualComponentName UnqualComponentName
eName) VersionRange
versionRange
                | buildTool :: ExeDependency
buildTool@(ExeDependency PackageName
_ UnqualComponentName
eName VersionRange
versionRange)
                  <- PackageDescription -> BuildInfo -> [ExeDependency]
getAllToolDependencies PackageDescription
pkg_descr BuildInfo
bi
                , Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg_descr ExeDependency
buildTool ]
          -- Second, we collect any build-tools entry we don't know how to
          -- desugar. We'll never have any idea how to build them, so we just
          -- hope they are already on the PATH.
          let unknownBuildTools :: [LegacyExeDependency]
unknownBuildTools =
                [ LegacyExeDependency
buildTool
                | LegacyExeDependency
buildTool <- BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi
                , forall a. Maybe a
Nothing forall a. Eq a => a -> a -> Bool
== PackageDescription -> LegacyExeDependency -> Maybe ExeDependency
desugarBuildTool PackageDescription
pkg_descr LegacyExeDependency
buildTool ]
          [LegacyExeDependency]
externBuildToolDeps forall a. [a] -> [a] -> [a]
++ [LegacyExeDependency]
unknownBuildTools

    ProgramDb
programDb' <-
          Verbosity -> ProgramDb -> IO ProgramDb
configureAllKnownPrograms (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) ProgramDb
programDb
      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Verbosity -> [LegacyExeDependency] -> ProgramDb -> IO ProgramDb
configureRequiredPrograms Verbosity
verbosity [LegacyExeDependency]
requiredBuildTools

    (PackageDescription
pkg_descr', ProgramDb
programDb'') <-
      Verbosity
-> PackageDescription
-> ProgramDb
-> ComponentRequestedSpec
-> IO (PackageDescription, ProgramDb)
configurePkgconfigPackages Verbosity
verbosity PackageDescription
pkg_descr ProgramDb
programDb' ComponentRequestedSpec
enabled

    -- Compute internal component graph
    --
    -- The general idea is that we take a look at all the source level
    -- components (which may build-depends on each other) and form a graph.
    -- From there, we build a ComponentLocalBuildInfo for each of the
    -- components, which lets us actually build each component.
    -- internalPackageSet
    -- use_external_internal_deps
    ([ComponentLocalBuildInfo]
buildComponents :: [ComponentLocalBuildInfo],
     InstalledPackageIndex
packageDependsIndex :: InstalledPackageIndex) <-
      forall a. Verbosity -> LogProgress a -> IO a
runLogProgress Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ Verbosity
-> Bool
-> ComponentRequestedSpec
-> Bool
-> Flag ProgArg
-> Flag ComponentId
-> PackageDescription
-> [PreExistingComponent]
-> FlagAssignment
-> [(ModuleName, Module)]
-> InstalledPackageIndex
-> Compiler
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
configureComponentLocalBuildInfos
            Verbosity
verbosity
            Bool
use_external_internal_deps
            ComponentRequestedSpec
enabled
            (forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configDeterministic ConfigFlags
cfg))
            (ConfigFlags -> Flag ProgArg
configIPID ConfigFlags
cfg)
            (ConfigFlags -> Flag ComponentId
configCID ConfigFlags
cfg)
            PackageDescription
pkg_descr
            [PreExistingComponent]
externalPkgDeps
            (ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
cfg)
            (ConfigFlags -> [(ModuleName, Module)]
configInstantiateWith ConfigFlags
cfg)
            InstalledPackageIndex
installedPackageSet
            Compiler
comp

    -- Decide if we're going to compile with split sections.
    Bool
split_sections :: Bool <-
       if Bool -> Bool
not (forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configSplitSections ConfigFlags
cfg)
            then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
                        CompilerFlavor
GHC | Compiler -> Version
compilerVersion Compiler
comp forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8,Int
0]
                          -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        CompilerFlavor
GHCJS
                          -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        CompilerFlavor
_ -> do Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
                                     (ProgArg
"this compiler does not support " forall a. [a] -> [a] -> [a]
++
                                      ProgArg
"--enable-split-sections; ignoring")
                                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    -- Decide if we're going to compile with split objects.
    Bool
split_objs :: Bool <-
       if Bool -> Bool
not (forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configSplitObjs ConfigFlags
cfg)
            then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            else case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
                        CompilerFlavor
_ | Bool
split_sections
                          -> do Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
                                     (ProgArg
"--enable-split-sections and " forall a. [a] -> [a] -> [a]
++
                                      ProgArg
"--enable-split-objs are mutually" forall a. [a] -> [a] -> [a]
++
                                      ProgArg
"exclusive; ignoring the latter")
                                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                        CompilerFlavor
GHC
                          -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        CompilerFlavor
GHCJS
                          -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
                        CompilerFlavor
_ -> do Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
                                     (ProgArg
"this compiler does not support " forall a. [a] -> [a] -> [a]
++
                                      ProgArg
"--enable-split-objs; ignoring")
                                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    let compilerSupportsGhciLibs :: Bool
        compilerSupportsGhciLibs :: Bool
compilerSupportsGhciLibs =
          case Compiler -> CompilerId
compilerId Compiler
comp of
            CompilerId CompilerFlavor
GHC Version
version
              | Version
version forall a. Ord a => a -> a -> Bool
> [Int] -> Version
mkVersion [Int
9,Int
3] Bool -> Bool -> Bool
&& Bool
windows ->
                Bool
False
            CompilerId CompilerFlavor
GHC Version
_ ->
                Bool
True
            CompilerId CompilerFlavor
GHCJS Version
_ ->
                Bool
True
            CompilerId
_ -> Bool
False
          where
            windows :: Bool
windows = case Platform
compPlatform of
              Platform Arch
_ OS
Windows -> Bool
True
              Platform Arch
_ OS
_ -> Bool
False

    let ghciLibByDefault :: Bool
ghciLibByDefault =
          case Compiler -> CompilerId
compilerId Compiler
comp of
            CompilerId CompilerFlavor
GHC Version
_ ->
              -- If ghc is non-dynamic, then ghci needs object files,
              -- so we build one by default.
              --
              -- Technically, archive files should be sufficient for ghci,
              -- but because of GHC bug #8942, it has never been safe to
              -- rely on them. By the time that bug was fixed, ghci had
              -- been changed to read shared libraries instead of archive
              -- files (see next code block).
              Bool -> Bool
not (Compiler -> Bool
GHC.isDynamic Compiler
comp)
            CompilerId CompilerFlavor
GHCJS Version
_ ->
              Bool -> Bool
not (Compiler -> Bool
GHCJS.isDynamic Compiler
comp)
            CompilerId
_ -> Bool
False

    Bool
withGHCiLib_ <-
      case forall a. a -> Flag a -> a
fromFlagOrDefault Bool
ghciLibByDefault (ConfigFlags -> Flag Bool
configGHCiLib ConfigFlags
cfg) of
        Bool
True | Bool -> Bool
not Bool
compilerSupportsGhciLibs -> do
          Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
                ProgArg
"--enable-library-for-ghci is no longer supported on Windows with"
              forall a. [a] -> [a] -> [a]
++ ProgArg
" GHC 9.4 and later; ignoring..."
          forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Bool
v -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
v

    let sharedLibsByDefault :: Bool
sharedLibsByDefault
          | forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configDynExe ConfigFlags
cfg) =
              -- build a shared library if dynamically-linked
              -- executables are requested
              Bool
True
          | Bool
otherwise = case Compiler -> CompilerId
compilerId Compiler
comp of
            CompilerId CompilerFlavor
GHC Version
_ ->
              -- if ghc is dynamic, then ghci needs a shared
              -- library, so we build one by default.
              Compiler -> Bool
GHC.isDynamic Compiler
comp
            CompilerId CompilerFlavor
GHCJS Version
_ ->
              Compiler -> Bool
GHCJS.isDynamic Compiler
comp
            CompilerId
_ -> Bool
False
        withSharedLib_ :: Bool
withSharedLib_ =
            -- build shared libraries if required by GHC or by the
            -- executable linking mode, but allow the user to force
            -- building only static library archives with
            -- --disable-shared.
            forall a. a -> Flag a -> a
fromFlagOrDefault Bool
sharedLibsByDefault forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configSharedLib ConfigFlags
cfg

        withStaticLib_ :: Bool
withStaticLib_ =
            -- build a static library (all dependent libraries rolled
            -- into a huge .a archive) via GHCs -staticlib flag.
            forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configStaticLib ConfigFlags
cfg

        withDynExe_ :: Bool
withDynExe_ = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configDynExe ConfigFlags
cfg

        withFullyStaticExe_ :: Bool
withFullyStaticExe_ = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configFullyStaticExe ConfigFlags
cfg

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
withDynExe_ Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
withSharedLib_) forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
           ProgArg
"Executables will use dynamic linking, but a shared library "
        forall a. [a] -> [a] -> [a]
++ ProgArg
"is not being built. Linking will fail if any executables "
        forall a. [a] -> [a] -> [a]
++ ProgArg
"depend on the library."

    LocalBuildInfo -> LocalBuildInfo
setProfLBI <- Verbosity
-> ConfigFlags -> Compiler -> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling Verbosity
verbosity ConfigFlags
cfg Compiler
comp

    LocalBuildInfo -> LocalBuildInfo
setCoverageLBI <- Verbosity
-> ConfigFlags -> Compiler -> IO (LocalBuildInfo -> LocalBuildInfo)
configureCoverage Verbosity
verbosity ConfigFlags
cfg Compiler
comp



    -- Turn off library and executable stripping when `debug-info` is set
    -- to anything other than zero.
    let
        strip_libexe :: ProgArg -> (ConfigFlags -> Flag Bool) -> IO Bool
strip_libexe ProgArg
s ConfigFlags -> Flag Bool
f =
          let defaultStrip :: Bool
defaultStrip = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
True (ConfigFlags -> Flag Bool
f ConfigFlags
cfg)
          in case forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag DebugInfoLevel
configDebugInfo ConfigFlags
cfg) of
                      DebugInfoLevel
NoDebugInfo -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
defaultStrip
                      DebugInfoLevel
_ -> case ConfigFlags -> Flag Bool
f ConfigFlags
cfg of
                             Flag Bool
True -> do
                              Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Setting debug-info implies "
                                                forall a. [a] -> [a] -> [a]
++ ProgArg
s forall a. [a] -> [a] -> [a]
++ ProgArg
"-stripping: False"
                              forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

                             Flag Bool
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

    Bool
strip_lib <- ProgArg -> (ConfigFlags -> Flag Bool) -> IO Bool
strip_libexe ProgArg
"library" ConfigFlags -> Flag Bool
configStripLibs
    Bool
strip_exe <- ProgArg -> (ConfigFlags -> Flag Bool) -> IO Bool
strip_libexe ProgArg
"executable" ConfigFlags -> Flag Bool
configStripExes


    let reloc :: Bool
reloc = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configRelocatable ConfigFlags
cfg

    let buildComponentsMap :: Map ComponentName [ComponentLocalBuildInfo]
buildComponentsMap =
            forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Map ComponentName [ComponentLocalBuildInfo]
m ComponentLocalBuildInfo
clbi -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. [a] -> [a] -> [a]
(++)
                               (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbi) [ComponentLocalBuildInfo
clbi] Map ComponentName [ComponentLocalBuildInfo]
m)
                   forall k a. Map k a
Map.empty [ComponentLocalBuildInfo]
buildComponents

    let lbi :: LocalBuildInfo
lbi = (LocalBuildInfo -> LocalBuildInfo
setCoverageLBI forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> LocalBuildInfo
setProfLBI)
              LocalBuildInfo {
                configFlags :: ConfigFlags
configFlags         = ConfigFlags
cfg,
                flagAssignment :: FlagAssignment
flagAssignment      = FlagAssignment
flags,
                componentEnabledSpec :: ComponentRequestedSpec
componentEnabledSpec = ComponentRequestedSpec
enabled,
                extraConfigArgs :: [ProgArg]
extraConfigArgs     = [],  -- Currently configure does not
                                           -- take extra args, but if it
                                           -- did they would go here.
                installDirTemplates :: InstallDirTemplates
installDirTemplates = InstallDirTemplates
installDirs,
                compiler :: Compiler
compiler            = Compiler
comp,
                hostPlatform :: Platform
hostPlatform        = Platform
compPlatform,
                buildDir :: ProgArg
buildDir            = ProgArg
buildDir,
                cabalFilePath :: Maybe ProgArg
cabalFilePath       = forall a. Flag a -> Maybe a
flagToMaybe (ConfigFlags -> Flag ProgArg
configCabalFilePath ConfigFlags
cfg),
                componentGraph :: Graph ComponentLocalBuildInfo
componentGraph      = forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [ComponentLocalBuildInfo]
buildComponents,
                componentNameMap :: Map ComponentName [ComponentLocalBuildInfo]
componentNameMap    = Map ComponentName [ComponentLocalBuildInfo]
buildComponentsMap,
                installedPkgs :: InstalledPackageIndex
installedPkgs       = InstalledPackageIndex
packageDependsIndex,
                pkgDescrFile :: Maybe ProgArg
pkgDescrFile        = forall a. Maybe a
Nothing,
                localPkgDescr :: PackageDescription
localPkgDescr       = PackageDescription
pkg_descr',
                withPrograms :: ProgramDb
withPrograms        = ProgramDb
programDb'',
                withVanillaLib :: Bool
withVanillaLib      = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configVanillaLib ConfigFlags
cfg,
                withSharedLib :: Bool
withSharedLib       = Bool
withSharedLib_,
                withStaticLib :: Bool
withStaticLib       = Bool
withStaticLib_,
                withDynExe :: Bool
withDynExe          = Bool
withDynExe_,
                withFullyStaticExe :: Bool
withFullyStaticExe  = Bool
withFullyStaticExe_,
                withProfLib :: Bool
withProfLib         = Bool
False,
                withProfLibDetail :: ProfDetailLevel
withProfLibDetail   = ProfDetailLevel
ProfDetailNone,
                withProfExe :: Bool
withProfExe         = Bool
False,
                withProfExeDetail :: ProfDetailLevel
withProfExeDetail   = ProfDetailLevel
ProfDetailNone,
                withOptimization :: OptimisationLevel
withOptimization    = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag OptimisationLevel
configOptimization ConfigFlags
cfg,
                withDebugInfo :: DebugInfoLevel
withDebugInfo       = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag DebugInfoLevel
configDebugInfo ConfigFlags
cfg,
                withGHCiLib :: Bool
withGHCiLib         = Bool
withGHCiLib_,
                splitSections :: Bool
splitSections       = Bool
split_sections,
                splitObjs :: Bool
splitObjs           = Bool
split_objs,
                stripExes :: Bool
stripExes           = Bool
strip_exe,
                stripLibs :: Bool
stripLibs           = Bool
strip_lib,
                exeCoverage :: Bool
exeCoverage         = Bool
False,
                libCoverage :: Bool
libCoverage         = Bool
False,
                withPackageDB :: PackageDBStack
withPackageDB       = PackageDBStack
packageDbs,
                progPrefix :: PathTemplate
progPrefix          = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag PathTemplate
configProgPrefix ConfigFlags
cfg,
                progSuffix :: PathTemplate
progSuffix          = forall a. WithCallStack (Flag a -> a)
fromFlag forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag PathTemplate
configProgSuffix ConfigFlags
cfg,
                relocatable :: Bool
relocatable         = Bool
reloc
              }

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
reloc (Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
checkRelocatable Verbosity
verbosity PackageDescription
pkg_descr LocalBuildInfo
lbi)

    -- TODO: This is not entirely correct, because the dirs may vary
    -- across libraries/executables
    let dirs :: InstallDirs ProgArg
dirs = PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs ProgArg
absoluteInstallDirs PackageDescription
pkg_descr LocalBuildInfo
lbi CopyDest
NoCopyDest
        relative :: InstallDirs (Maybe ProgArg)
relative = PackageIdentifier -> LocalBuildInfo -> InstallDirs (Maybe ProgArg)
prefixRelativeInstallDirs (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PackageDescription
pkg_descr) LocalBuildInfo
lbi

    -- PKGROOT: allowing ${pkgroot} to be passed as --prefix to
    -- cabal configure, is only a hidden option. It allows packages
    -- to be relocatable with their package database.  This however
    -- breaks when the Paths_* or other includes are used that
    -- contain hard coded paths. This is still an open TODO.
    --
    -- Allowing ${pkgroot} here, however requires less custom hooks
    -- in scripts that *really* want ${pkgroot}. See haskell/cabal/#4872
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProgArg -> Bool
isAbsolute (forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs)
           Bool -> Bool -> Bool
|| ProgArg
"${pkgroot}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs) forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
        ProgArg
"expected an absolute directory name for --prefix: " forall a. [a] -> [a] -> [a]
++ forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProgArg
"${pkgroot}" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs) forall a b. (a -> b) -> a -> b
$
      Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Using ${pkgroot} in prefix " forall a. [a] -> [a] -> [a]
++ forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" will not work if you rely on the Path_* module "
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" or other hard coded paths.  Cabal does not yet "
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" support fully  relocatable builds! "
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" See #462 #2302 #2994 #3305 #3473 #3586 #3909"
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" #4097 #4291 #4872"

    Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Using " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCabalId
                  forall a. [a] -> [a] -> [a]
++ ProgArg
" compiled by " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCompilerId
    Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Using compiler: " forall a. [a] -> [a] -> [a]
++ Compiler -> ProgArg
showCompilerId Compiler
comp
    Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Using install prefix: " forall a. [a] -> [a] -> [a]
++ forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
dirs

    let dirinfo :: ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
name ProgArg
dir Maybe a
isPrefixRelative =
          Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
name forall a. [a] -> [a] -> [a]
++ ProgArg
" installed in: " forall a. [a] -> [a] -> [a]
++ ProgArg
dir forall a. [a] -> [a] -> [a]
++ ProgArg
relNote
          where relNote :: ProgArg
relNote = case OS
buildOS of
                  OS
Windows | Bool -> Bool
not (PackageDescription -> Bool
hasLibs PackageDescription
pkg_descr)
                         Bool -> Bool -> Bool
&& forall a. Maybe a -> Bool
isNothing Maybe a
isPrefixRelative
                         -> ProgArg
"  (fixed location)"
                  OS
_      -> ProgArg
""

    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Executables"      (forall dir. InstallDirs dir -> dir
bindir InstallDirs ProgArg
dirs)     (forall dir. InstallDirs dir -> dir
bindir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Libraries"        (forall dir. InstallDirs dir -> dir
libdir InstallDirs ProgArg
dirs)     (forall dir. InstallDirs dir -> dir
libdir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Dynamic Libraries" (forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs ProgArg
dirs) (forall dir. InstallDirs dir -> dir
dynlibdir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Private executables" (forall dir. InstallDirs dir -> dir
libexecdir InstallDirs ProgArg
dirs) (forall dir. InstallDirs dir -> dir
libexecdir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Data files"       (forall dir. InstallDirs dir -> dir
datadir InstallDirs ProgArg
dirs)    (forall dir. InstallDirs dir -> dir
datadir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Documentation"    (forall dir. InstallDirs dir -> dir
docdir InstallDirs ProgArg
dirs)     (forall dir. InstallDirs dir -> dir
docdir InstallDirs (Maybe ProgArg)
relative)
    forall {a}. ProgArg -> ProgArg -> Maybe a -> IO ()
dirinfo ProgArg
"Configuration files" (forall dir. InstallDirs dir -> dir
sysconfdir InstallDirs ProgArg
dirs) (forall dir. InstallDirs dir -> dir
sysconfdir InstallDirs (Maybe ProgArg)
relative)

    forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
reportProgram Verbosity
verbosity Program
prog Maybe ConfiguredProgram
configuredProg
              | (Program
prog, Maybe ConfiguredProgram
configuredProg) <- ProgramDb -> [(Program, Maybe ConfiguredProgram)]
knownPrograms ProgramDb
programDb'' ]

    forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildInfo
lbi

    where
      verbosity :: Verbosity
verbosity = forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
cfg)

mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb ConfigFlags
cfg ProgramDb
initialProgramDb = ProgramDb
programDb
  where
    programDb :: ProgramDb
programDb  = [(ProgArg, [ProgArg])] -> ProgramDb -> ProgramDb
userSpecifyArgss (ConfigFlags -> [(ProgArg, [ProgArg])]
configProgramArgs ConfigFlags
cfg)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(ProgArg, ProgArg)] -> ProgramDb -> ProgramDb
userSpecifyPaths (ConfigFlags -> [(ProgArg, ProgArg)]
configProgramPaths ConfigFlags
cfg)
                 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgramSearchPath -> ProgramDb -> ProgramDb
setProgramSearchPath ProgramSearchPath
searchpath
                 forall a b. (a -> b) -> a -> b
$ ProgramDb
initialProgramDb
    searchpath :: ProgramSearchPath
searchpath = forall a b. (a -> b) -> [a] -> [b]
map ProgArg -> ProgramSearchPathEntry
ProgramSearchPathDir
                 (forall a. NubList a -> [a]
fromNubList forall a b. (a -> b) -> a -> b
$ ConfigFlags -> NubList ProgArg
configProgramPathExtra ConfigFlags
cfg)
                 forall a. [a] -> [a] -> [a]
++ ProgramDb -> ProgramSearchPath
getProgramSearchPath ProgramDb
initialProgramDb

-- -----------------------------------------------------------------------------
-- Helper functions for configure

-- | Check if the user used any deprecated flags.
checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()
checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()
checkDeprecatedFlags Verbosity
verbosity ConfigFlags
cfg = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
cfg forall a. Eq a => a -> a -> Bool
== forall a. Flag a
NoFlag) forall a b. (a -> b) -> a -> b
$ do
      let enable :: ProgArg
enable | forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
cfg) = ProgArg
"enable"
                 | Bool
otherwise = ProgArg
"disable"
      Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
        (ProgArg
"The flag --" forall a. [a] -> [a] -> [a]
++ ProgArg
enable forall a. [a] -> [a] -> [a]
++ ProgArg
"-executable-profiling is deprecated. "
         forall a. [a] -> [a] -> [a]
++ ProgArg
"Please use --" forall a. [a] -> [a] -> [a]
++ ProgArg
enable forall a. [a] -> [a] -> [a]
++ ProgArg
"-profiling instead.")

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConfigFlags -> Flag Bool
configLibCoverage ConfigFlags
cfg forall a. Eq a => a -> a -> Bool
== forall a. Flag a
NoFlag) forall a b. (a -> b) -> a -> b
$ do
      let enable :: ProgArg
enable | forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configLibCoverage ConfigFlags
cfg) = ProgArg
"enable"
                 | Bool
otherwise = ProgArg
"disable"
      Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
        (ProgArg
"The flag --" forall a. [a] -> [a] -> [a]
++ ProgArg
enable forall a. [a] -> [a] -> [a]
++ ProgArg
"-library-coverage is deprecated. "
         forall a. [a] -> [a] -> [a]
++ ProgArg
"Please use --" forall a. [a] -> [a] -> [a]
++ ProgArg
enable forall a. [a] -> [a] -> [a]
++ ProgArg
"-coverage instead.")

-- | Sanity check: if '--exact-configuration' was given, ensure that the
-- complete flag assignment was specified on the command line.
checkExactConfiguration
  :: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO ()
checkExactConfiguration :: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO ()
checkExactConfiguration Verbosity
verbosity GenericPackageDescription
pkg_descr0 ConfigFlags
cfg =
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configExactConfiguration ConfigFlags
cfg)) forall a b. (a -> b) -> a -> b
$ do
      let cmdlineFlags :: [FlagName]
cmdlineFlags = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment (ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
cfg))
          allFlags :: [FlagName]
allFlags     = forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
flagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> [PackageFlag]
genPackageFlags forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkg_descr0
          diffFlags :: [FlagName]
diffFlags    = [FlagName]
allFlags forall a. Eq a => [a] -> [a] -> [a]
\\ [FlagName]
cmdlineFlags
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ [FlagName]
diffFlags) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"'--exact-configuration' was given, "
        forall a. [a] -> [a] -> [a]
++ ProgArg
"but the following flags were not specified: "
        forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> ProgArg
show [FlagName]
diffFlags)

-- | Create a PackageIndex that makes *any libraries that might be*
-- defined internally to this package look like installed packages, in
-- case an executable should refer to any of them as dependencies.
--
-- It must be *any libraries that might be* defined rather than the
-- actual definitions, because these depend on conditionals in the .cabal
-- file, and we haven't resolved them yet.  finalizePD
-- does the resolution of conditionals, and it takes internalPackageSet
-- as part of its input.
getInternalLibraries :: GenericPackageDescription
                     -> Set LibraryName
getInternalLibraries :: GenericPackageDescription -> Set LibraryName
getInternalLibraries GenericPackageDescription
pkg_descr0 =
    -- TODO: some day, executables will be fair game here too!
    let pkg_descr :: PackageDescription
pkg_descr = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
pkg_descr0
    in forall a. Ord a => [a] -> Set a
Set.fromList (forall a b. (a -> b) -> [a] -> [b]
map Library -> LibraryName
libName (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr))

-- | Returns true if a dependency is satisfiable.  This function may
-- report a dependency satisfiable even when it is not, but not vice
-- versa. This is to be passed to finalize
dependencySatisfiable
    :: Bool -- ^ use external internal deps?
    -> Bool -- ^ exact configuration?
    -> Bool -- ^ allow depending on private libs?
    -> PackageName
    -> InstalledPackageIndex -- ^ installed set
    -> Set LibraryName -- ^ library components
    -> Map (PackageName, ComponentName) InstalledPackageInfo
       -- ^ required dependencies
    -> (Dependency -> Bool)
dependencySatisfiable :: Bool
-> Bool
-> Bool
-> PackageName
-> InstalledPackageIndex
-> Set LibraryName
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Dependency
-> Bool
dependencySatisfiable
  Bool
use_external_internal_deps
  Bool
exact_config
  Bool
allow_private_deps
  PackageName
pn InstalledPackageIndex
installedPackageSet Set LibraryName
packageLibraries Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
  (Dependency PackageName
depName VersionRange
vr NonEmptySet LibraryName
sublibs)
    | Bool
exact_config
    -- When we're given '--exact-configuration', we assume that all
    -- dependencies and flags are exactly specified on the command
    -- line. Thus we only consult the 'requiredDepsMap'. Note that
    -- we're not doing the version range check, so if there's some
    -- dependency that wasn't specified on the command line,
    -- 'finalizePD' will fail.
    -- TODO: mention '--exact-configuration' in the error message
    -- when this fails?
    = if Bool
isInternalDep Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
use_external_internal_deps
        -- Except for internal deps, when we're NOT per-component mode;
        -- those are just True.
        then Bool
internalDepSatisfiable
        else
          -- Backward compatibility for the old sublibrary syntax
          (NonEmptySet LibraryName
sublibs forall a. Eq a => a -> a -> Bool
== NonEmptySet LibraryName
mainLibSet
            Bool -> Bool -> Bool
&& forall k a. Ord k => k -> Map k a -> Bool
Map.member
                 (PackageName
pn, LibraryName -> ComponentName
CLibName forall a b. (a -> b) -> a -> b
$ UnqualComponentName -> LibraryName
LSubLibName forall a b. (a -> b) -> a -> b
$
                      PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
depName)
                 Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap)

          Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all LibraryName -> Bool
visible NonEmptySet LibraryName
sublibs

    | Bool
isInternalDep
    = if Bool
use_external_internal_deps
        -- When we are doing per-component configure, we now need to
        -- test if the internal dependency is in the index.  This has
        -- DIFFERENT semantics from normal dependency satisfiability.
        then Bool
internalDepSatisfiableExternally
        -- If a 'PackageName' is defined by an internal component, the dep is
        -- satisfiable (we're going to build it ourselves)
        else Bool
internalDepSatisfiable

    | Bool
otherwise
    = Bool
depSatisfiable

  where
    -- Internal dependency is when dependency is the same as package.
    isInternalDep :: Bool
isInternalDep = PackageName
pn forall a. Eq a => a -> a -> Bool
== PackageName
depName

    depSatisfiable :: Bool
depSatisfiable =
        Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> PackageName
-> VersionRange
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupDependency InstalledPackageIndex
installedPackageSet PackageName
depName VersionRange
vr

    internalDepSatisfiable :: Bool
internalDepSatisfiable =
        forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf (forall a. NonEmptySet a -> Set a
NES.toSet NonEmptySet LibraryName
sublibs) Set LibraryName
packageLibraries
    internalDepSatisfiableExternally :: Bool
internalDepSatisfiableExternally =
        forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\LibraryName
ln -> Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> PackageName
-> VersionRange
-> LibraryName
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupInternalDependency InstalledPackageIndex
installedPackageSet PackageName
pn VersionRange
vr LibraryName
ln) NonEmptySet LibraryName
sublibs

    -- Check whether a library exists and is visible.
    -- We don't disambiguate between dependency on non-existent or private
    -- library yet, so we just return a bool and later report a generic error.
    visible :: LibraryName -> Bool
visible LibraryName
lib = forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    Bool
False -- Does not even exist (wasn't in the depsMap)
                    (\InstalledPackageInfo
ipi -> InstalledPackageInfo -> LibraryVisibility
IPI.libVisibility InstalledPackageInfo
ipi forall a. Eq a => a -> a -> Bool
== LibraryVisibility
LibraryVisibilityPublic
                          -- If the override is enabled, the visibility does
                          -- not matter (it's handled externally)
                          Bool -> Bool -> Bool
|| Bool
allow_private_deps
                          -- If it's a library of the same package then it's
                          -- always visible.
                          -- This is only triggered when passing a component
                          -- of the same package as --dependency, such as in:
                          -- cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs
                          Bool -> Bool -> Bool
|| PackageIdentifier -> PackageName
pkgName (InstalledPackageInfo -> PackageIdentifier
IPI.sourcePackageId InstalledPackageInfo
ipi) forall a. Eq a => a -> a -> Bool
== PackageName
pn)
                    Maybe InstalledPackageInfo
maybeIPI
      where maybeIPI :: Maybe InstalledPackageInfo
maybeIPI = forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
depName, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap

-- | Finalize a generic package description.  The workhorse is
-- 'finalizePD' but there's a bit of other nattering
-- about necessary.
--
-- TODO: what exactly is the business with @flaggedTests@ and
-- @flaggedBenchmarks@?
configureFinalizedPackage
    :: Verbosity
    -> ConfigFlags
    -> ComponentRequestedSpec
    -> [PackageVersionConstraint]
    -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
                            -- Might say it's satisfiable even when not.
    -> Compiler
    -> Platform
    -> GenericPackageDescription
    -> IO (PackageDescription, FlagAssignment)
configureFinalizedPackage :: Verbosity
-> ConfigFlags
-> ComponentRequestedSpec
-> [PackageVersionConstraint]
-> (Dependency -> Bool)
-> Compiler
-> Platform
-> GenericPackageDescription
-> IO (PackageDescription, FlagAssignment)
configureFinalizedPackage Verbosity
verbosity ConfigFlags
cfg ComponentRequestedSpec
enabled
  [PackageVersionConstraint]
allConstraints Dependency -> Bool
satisfies Compiler
comp Platform
compPlatform GenericPackageDescription
pkg_descr0 = do

    (PackageDescription
pkg_descr0', FlagAssignment
flags) <-
            case FlagAssignment
-> ComponentRequestedSpec
-> (Dependency -> Bool)
-> Platform
-> CompilerInfo
-> [PackageVersionConstraint]
-> GenericPackageDescription
-> Either [Dependency] (PackageDescription, FlagAssignment)
finalizePD
                   (ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
cfg)
                   ComponentRequestedSpec
enabled
                   Dependency -> Bool
satisfies
                   Platform
compPlatform
                   (Compiler -> CompilerInfo
compilerInfo Compiler
comp)
                   [PackageVersionConstraint]
allConstraints
                   GenericPackageDescription
pkg_descr0
            of Right (PackageDescription, FlagAssignment)
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription, FlagAssignment)
r
               Left [Dependency]
missing ->
                   forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Encountered missing or private dependencies:\n"
                     forall a. [a] -> [a] -> [a]
++ (Doc -> ProgArg
render forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Doc -> Doc
nest Int
4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Doc] -> Doc
sep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
                                forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Dependency
simplifyDependency)
                                forall a b. (a -> b) -> a -> b
$ [Dependency]
missing)

    -- add extra include/lib dirs as specified in cfg
    -- we do it here so that those get checked too
    let pkg_descr :: PackageDescription
pkg_descr = PackageDescription -> PackageDescription
addExtraIncludeLibDirs PackageDescription
pkg_descr0'

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (FlagAssignment -> Bool
nullFlagAssignment FlagAssignment
flags) forall a b. (a -> b) -> a -> b
$
      Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Flags chosen: "
                    forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " [ FlagName -> ProgArg
unFlagName FlagName
fn forall a. [a] -> [a] -> [a]
++ ProgArg
"=" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow Bool
value
                                        | (FlagName
fn, Bool
value) <- FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment FlagAssignment
flags ]

    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
pkg_descr, FlagAssignment
flags)
  where
    addExtraIncludeLibDirs :: PackageDescription -> PackageDescription
addExtraIncludeLibDirs PackageDescription
pkg_descr =
        let extraBi :: BuildInfo
extraBi = forall a. Monoid a => a
mempty { extraLibDirs :: [ProgArg]
extraLibDirs = ConfigFlags -> [ProgArg]
configExtraLibDirs ConfigFlags
cfg
                             , extraLibDirsStatic :: [ProgArg]
extraLibDirsStatic = ConfigFlags -> [ProgArg]
configExtraLibDirsStatic ConfigFlags
cfg
                             , extraFrameworkDirs :: [ProgArg]
extraFrameworkDirs = ConfigFlags -> [ProgArg]
configExtraFrameworkDirs ConfigFlags
cfg
                             , includeDirs :: [ProgArg]
includeDirs = ConfigFlags -> [ProgArg]
configExtraIncludeDirs ConfigFlags
cfg}
            modifyLib :: Library -> Library
modifyLib Library
l        = Library
l{ libBuildInfo :: BuildInfo
libBuildInfo        = Library -> BuildInfo
libBuildInfo Library
l
                                                          forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
extraBi }
            modifyExecutable :: Executable -> Executable
modifyExecutable Executable
e = Executable
e{ buildInfo :: BuildInfo
buildInfo           = Executable -> BuildInfo
buildInfo Executable
e
                                                          forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
extraBi}
            modifyForeignLib :: ForeignLib -> ForeignLib
modifyForeignLib ForeignLib
f = ForeignLib
f{ foreignLibBuildInfo :: BuildInfo
foreignLibBuildInfo = ForeignLib -> BuildInfo
foreignLibBuildInfo ForeignLib
f
                                                          forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
extraBi}
            modifyTestsuite :: TestSuite -> TestSuite
modifyTestsuite  TestSuite
t = TestSuite
t{ testBuildInfo :: BuildInfo
testBuildInfo      = TestSuite -> BuildInfo
testBuildInfo TestSuite
t
                                                          forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
extraBi}
            modifyBenchmark :: Benchmark -> Benchmark
modifyBenchmark  Benchmark
b = Benchmark
b{ benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo  = Benchmark -> BuildInfo
benchmarkBuildInfo Benchmark
b
                                                          forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
extraBi}
        in PackageDescription
pkg_descr
             { library :: Maybe Library
library      = Library -> Library
modifyLib        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` PackageDescription -> Maybe Library
library      PackageDescription
pkg_descr
             , subLibraries :: [Library]
subLibraries = Library -> Library
modifyLib        forall a b. (a -> b) -> [a] -> [b]
`map`  PackageDescription -> [Library]
subLibraries PackageDescription
pkg_descr
             , executables :: [Executable]
executables  = Executable -> Executable
modifyExecutable forall a b. (a -> b) -> [a] -> [b]
`map`  PackageDescription -> [Executable]
executables  PackageDescription
pkg_descr
             , foreignLibs :: [ForeignLib]
foreignLibs  = ForeignLib -> ForeignLib
modifyForeignLib forall a b. (a -> b) -> [a] -> [b]
`map`  PackageDescription -> [ForeignLib]
foreignLibs  PackageDescription
pkg_descr
             , testSuites :: [TestSuite]
testSuites   = TestSuite -> TestSuite
modifyTestsuite  forall a b. (a -> b) -> [a] -> [b]
`map`  PackageDescription -> [TestSuite]
testSuites   PackageDescription
pkg_descr
             , benchmarks :: [Benchmark]
benchmarks   = Benchmark -> Benchmark
modifyBenchmark  forall a b. (a -> b) -> [a] -> [b]
`map`  PackageDescription -> [Benchmark]
benchmarks   PackageDescription
pkg_descr
             }

-- | Check for use of Cabal features which require compiler support
checkCompilerProblems
  :: Verbosity -> Compiler -> PackageDescription -> ComponentRequestedSpec -> IO ()
checkCompilerProblems :: Verbosity
-> Compiler
-> PackageDescription
-> ComponentRequestedSpec
-> IO ()
checkCompilerProblems Verbosity
verbosity Compiler
comp PackageDescription
pkg_descr ComponentRequestedSpec
enabled = do
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Compiler -> Bool
renamingPackageFlagsSupported Compiler
comp Bool -> Bool -> Bool
||
             forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IncludeRenaming -> Bool
isDefaultIncludeRenaming forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mixin -> IncludeRenaming
mixinIncludeRenaming) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [Mixin]
mixins)
                         (PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled)) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
              ProgArg
"Your compiler does not support thinning and renaming on "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"package flags.  To use this feature you must use "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"GHC 7.9 or later."

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.Library -> [ModuleReexport]
reexportedModules) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr)
          Bool -> Bool -> Bool
&& Bool -> Bool
not (Compiler -> Bool
reexportedModulesSupported Compiler
comp)) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
             ProgArg
"Your compiler does not support module re-exports. To use "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"this feature you must use GHC 7.9 or later."

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
notforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (t :: * -> *) a. Foldable t => t a -> Bool
nullforall b c a. (b -> c) -> (a -> b) -> a -> c
.Library -> [ModuleName]
signatures) (PackageDescription -> [Library]
allLibraries PackageDescription
pkg_descr)
          Bool -> Bool -> Bool
&& Bool -> Bool
not (Compiler -> Bool
backpackSupported Compiler
comp)) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$
               ProgArg
"Your compiler does not support Backpack. To use "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"this feature you must use GHC 8.1 or later."

-- | Select dependencies for the package.
configureDependencies
    :: Verbosity
    -> UseExternalInternalDeps
    -> Set LibraryName
    -> InstalledPackageIndex -- ^ installed packages
    -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required deps
    -> PackageDescription
    -> ComponentRequestedSpec
    -> IO [PreExistingComponent]
configureDependencies :: Verbosity
-> Bool
-> Set LibraryName
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> PackageDescription
-> ComponentRequestedSpec
-> IO [PreExistingComponent]
configureDependencies Verbosity
verbosity Bool
use_external_internal_deps
  Set LibraryName
packageLibraries InstalledPackageIndex
installedPackageSet Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap PackageDescription
pkg_descr ComponentRequestedSpec
enableSpec = do
    let failedDeps :: [FailedDependency]
        allPkgDeps :: [ResolvedDependency]
        ([FailedDependency]
failedDeps, [ResolvedDependency]
allPkgDeps) = forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
          [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\DependencyResolution
s -> (Dependency
dep, DependencyResolution
s)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Either FailedDependency DependencyResolution]
status
          | Dependency
dep <- PackageDescription -> ComponentRequestedSpec -> [Dependency]
enabledBuildDepends PackageDescription
pkg_descr ComponentRequestedSpec
enableSpec
          , let status :: [Either FailedDependency DependencyResolution]
status = PackageIdentifier
-> Set LibraryName
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Bool
-> Dependency
-> [Either FailedDependency DependencyResolution]
selectDependency (PackageDescription -> PackageIdentifier
package PackageDescription
pkg_descr)
                  Set LibraryName
packageLibraries InstalledPackageIndex
installedPackageSet
                  Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap Bool
use_external_internal_deps Dependency
dep ]

        internalPkgDeps :: [PackageIdentifier]
internalPkgDeps = [ PackageIdentifier
pkgid
                          | (Dependency
_, InternalDependency PackageIdentifier
pkgid) <- [ResolvedDependency]
allPkgDeps ]
        -- NB: we have to SAVE the package name, because this is the only
        -- way we can be able to resolve package names in the package
        -- description.
        externalPkgDeps :: [PreExistingComponent]
externalPkgDeps = [ PreExistingComponent
pec
                          | (Dependency
_, ExternalDependency PreExistingComponent
pec)   <- [ResolvedDependency]
allPkgDeps ]

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageIdentifier]
internalPkgDeps)
          Bool -> Bool -> Bool
&& Bool -> Bool
not (PackageDescription -> Bool
newPackageDepsBehaviour PackageDescription
pkg_descr)) forall a b. (a -> b) -> a -> b
$
        forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"The field 'build-depends: "
           forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> ProgArg
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName) [PackageIdentifier]
internalPkgDeps)
           forall a. [a] -> [a] -> [a]
++ ProgArg
"' refers to a library which is defined within the same "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"package. To use this feature the package must specify at "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"least 'cabal-version: >= 1.8'."

    Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies Verbosity
verbosity [FailedDependency]
failedDeps
    Verbosity -> [ResolvedDependency] -> IO ()
reportSelectedDependencies Verbosity
verbosity [ResolvedDependency]
allPkgDeps

    forall (m :: * -> *) a. Monad m => a -> m a
return [PreExistingComponent]
externalPkgDeps

-- | Select and apply coverage settings for the build based on the
-- 'ConfigFlags' and 'Compiler'.
configureCoverage :: Verbosity -> ConfigFlags -> Compiler
                  -> IO (LocalBuildInfo -> LocalBuildInfo)
configureCoverage :: Verbosity
-> ConfigFlags -> Compiler -> IO (LocalBuildInfo -> LocalBuildInfo)
configureCoverage Verbosity
verbosity ConfigFlags
cfg Compiler
comp = do
    let tryExeCoverage :: Bool
tryExeCoverage = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configCoverage ConfigFlags
cfg)
        tryLibCoverage :: Bool
tryLibCoverage = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
tryExeCoverage
                         (forall a. Monoid a => a -> a -> a
mappend (ConfigFlags -> Flag Bool
configCoverage ConfigFlags
cfg) (ConfigFlags -> Flag Bool
configLibCoverage ConfigFlags
cfg))
    if Compiler -> Bool
coverageSupported Compiler
comp
      then do
        let apply :: LocalBuildInfo -> LocalBuildInfo
apply LocalBuildInfo
lbi = LocalBuildInfo
lbi { libCoverage :: Bool
libCoverage = Bool
tryLibCoverage
                            , exeCoverage :: Bool
exeCoverage = Bool
tryExeCoverage
                            }
        forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildInfo -> LocalBuildInfo
apply
      else do
        let apply :: LocalBuildInfo -> LocalBuildInfo
apply LocalBuildInfo
lbi = LocalBuildInfo
lbi { libCoverage :: Bool
libCoverage = Bool
False
                            , exeCoverage :: Bool
exeCoverage = Bool
False
                            }
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
tryExeCoverage Bool -> Bool -> Bool
|| Bool
tryLibCoverage) forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
          (ProgArg
"The compiler " forall a. [a] -> [a] -> [a]
++ Compiler -> ProgArg
showCompilerId Compiler
comp forall a. [a] -> [a] -> [a]
++ ProgArg
" does not support "
           forall a. [a] -> [a] -> [a]
++ ProgArg
"program coverage. Program coverage has been disabled.")
        forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildInfo -> LocalBuildInfo
apply

-- | Compute the effective value of the profiling flags
-- @--enable-library-profiling@ and @--enable-executable-profiling@
-- from the specified 'ConfigFlags'.  This may be useful for
-- external Cabal tools which need to interact with Setup in
-- a backwards-compatible way: the most predictable mechanism
-- for enabling profiling across many legacy versions is to
-- NOT use @--enable-profiling@ and use those two flags instead.
--
-- Note that @--enable-executable-profiling@ also affects profiling
-- of benchmarks and (non-detailed) test suites.
computeEffectiveProfiling :: ConfigFlags -> (Bool {- lib -}, Bool {- exe -})
computeEffectiveProfiling :: ConfigFlags -> (Bool, Bool)
computeEffectiveProfiling ConfigFlags
cfg =
  -- The --profiling flag sets the default for both libs and exes,
  -- but can be overridden by --library-profiling, or the old deprecated
  -- --executable-profiling flag.
  --
  -- The --profiling-detail and --library-profiling-detail flags behave
  -- similarly
  let tryExeProfiling :: Bool
tryExeProfiling = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False
                        (forall a. Monoid a => a -> a -> a
mappend (ConfigFlags -> Flag Bool
configProf ConfigFlags
cfg) (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
cfg))
      tryLibProfiling :: Bool
tryLibProfiling = forall a. a -> Flag a -> a
fromFlagOrDefault Bool
tryExeProfiling
                        (forall a. Monoid a => a -> a -> a
mappend (ConfigFlags -> Flag Bool
configProf ConfigFlags
cfg) (ConfigFlags -> Flag Bool
configProfLib ConfigFlags
cfg))
  in (Bool
tryLibProfiling, Bool
tryExeProfiling)

-- | Select and apply profiling settings for the build based on the
-- 'ConfigFlags' and 'Compiler'.
configureProfiling :: Verbosity -> ConfigFlags -> Compiler
                   -> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling :: Verbosity
-> ConfigFlags -> Compiler -> IO (LocalBuildInfo -> LocalBuildInfo)
configureProfiling Verbosity
verbosity ConfigFlags
cfg Compiler
comp = do
  let (Bool
tryLibProfiling, Bool
tryExeProfiling) = ConfigFlags -> (Bool, Bool)
computeEffectiveProfiling ConfigFlags
cfg

      tryExeProfileLevel :: ProfDetailLevel
tryExeProfileLevel = forall a. a -> Flag a -> a
fromFlagOrDefault ProfDetailLevel
ProfDetailDefault
                           (ConfigFlags -> Flag ProfDetailLevel
configProfDetail ConfigFlags
cfg)
      tryLibProfileLevel :: ProfDetailLevel
tryLibProfileLevel = forall a. a -> Flag a -> a
fromFlagOrDefault ProfDetailLevel
ProfDetailDefault
                           (forall a. Monoid a => a -> a -> a
mappend
                            (ConfigFlags -> Flag ProfDetailLevel
configProfDetail ConfigFlags
cfg)
                            (ConfigFlags -> Flag ProfDetailLevel
configProfLibDetail ConfigFlags
cfg))

      checkProfileLevel :: ProfDetailLevel -> IO ProfDetailLevel
checkProfileLevel (ProfDetailOther ProgArg
other) = do
        Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
          (ProgArg
"Unknown profiling detail level '" forall a. [a] -> [a] -> [a]
++ ProgArg
other
           forall a. [a] -> [a] -> [a]
++ ProgArg
"', using default.\nThe profiling detail levels are: "
           forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", "
           [ ProgArg
name | (ProgArg
name, [ProgArg]
_, ProfDetailLevel
_) <- [(ProgArg, [ProgArg], ProfDetailLevel)]
knownProfDetailLevels ])
        forall (m :: * -> *) a. Monad m => a -> m a
return ProfDetailLevel
ProfDetailDefault
      checkProfileLevel ProfDetailLevel
other = forall (m :: * -> *) a. Monad m => a -> m a
return ProfDetailLevel
other

  (Bool
exeProfWithoutLibProf, LocalBuildInfo -> LocalBuildInfo
applyProfiling) <-
    if Compiler -> Bool
profilingSupported Compiler
comp
    then do
      ProfDetailLevel
exeLevel <- ProfDetailLevel -> IO ProfDetailLevel
checkProfileLevel ProfDetailLevel
tryExeProfileLevel
      ProfDetailLevel
libLevel <- ProfDetailLevel -> IO ProfDetailLevel
checkProfileLevel ProfDetailLevel
tryLibProfileLevel
      let apply :: LocalBuildInfo -> LocalBuildInfo
apply LocalBuildInfo
lbi = LocalBuildInfo
lbi { withProfLib :: Bool
withProfLib       = Bool
tryLibProfiling
                          , withProfLibDetail :: ProfDetailLevel
withProfLibDetail = ProfDetailLevel
libLevel
                          , withProfExe :: Bool
withProfExe       = Bool
tryExeProfiling
                          , withProfExeDetail :: ProfDetailLevel
withProfExeDetail = ProfDetailLevel
exeLevel
                          }
      forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
tryExeProfiling Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
tryLibProfiling, LocalBuildInfo -> LocalBuildInfo
apply)
    else do
      let apply :: LocalBuildInfo -> LocalBuildInfo
apply LocalBuildInfo
lbi = LocalBuildInfo
lbi { withProfLib :: Bool
withProfLib = Bool
False
                          , withProfLibDetail :: ProfDetailLevel
withProfLibDetail = ProfDetailLevel
ProfDetailNone
                          , withProfExe :: Bool
withProfExe = Bool
False
                          , withProfExeDetail :: ProfDetailLevel
withProfExeDetail = ProfDetailLevel
ProfDetailNone
                          }
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
tryExeProfiling Bool -> Bool -> Bool
|| Bool
tryLibProfiling) forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
        (ProgArg
"The compiler " forall a. [a] -> [a] -> [a]
++ Compiler -> ProgArg
showCompilerId Compiler
comp forall a. [a] -> [a] -> [a]
++ ProgArg
" does not support "
         forall a. [a] -> [a] -> [a]
++ ProgArg
"profiling. Profiling has been disabled.")
      forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, LocalBuildInfo -> LocalBuildInfo
apply)

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exeProfWithoutLibProf forall a b. (a -> b) -> a -> b
$ Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity
    (ProgArg
"Executables will be built with profiling, but library "
     forall a. [a] -> [a] -> [a]
++ ProgArg
"profiling is disabled. Linking will fail if any executables "
     forall a. [a] -> [a] -> [a]
++ ProgArg
"depend on the library.")

  forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildInfo -> LocalBuildInfo
applyProfiling

-- -----------------------------------------------------------------------------
-- Configuring package dependencies

reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
reportProgram Verbosity
verbosity Program
prog Maybe ConfiguredProgram
Nothing
    = Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"No " forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog forall a. [a] -> [a] -> [a]
++ ProgArg
" found"
reportProgram Verbosity
verbosity Program
prog (Just ConfiguredProgram
configuredProg)
    = Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Using " forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog forall a. [a] -> [a] -> [a]
++ ProgArg
version forall a. [a] -> [a] -> [a]
++ ProgArg
location
    where location :: ProgArg
location = case ConfiguredProgram -> ProgramLocation
programLocation ConfiguredProgram
configuredProg of
            FoundOnSystem ProgArg
p -> ProgArg
" found on system at: " forall a. [a] -> [a] -> [a]
++ ProgArg
p
            UserSpecified ProgArg
p -> ProgArg
" given by user at: " forall a. [a] -> [a] -> [a]
++ ProgArg
p
          version :: ProgArg
version = case ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
configuredProg of
            Maybe Version
Nothing -> ProgArg
""
            Just Version
v  -> ProgArg
" version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow Version
v

hackageUrl :: String
hackageUrl :: ProgArg
hackageUrl = ProgArg
"http://hackage.haskell.org/package/"

type ResolvedDependency = (Dependency, DependencyResolution)

data DependencyResolution
    -- | An external dependency from the package database, OR an
    -- internal dependency which we are getting from the package
    -- database.
    = ExternalDependency PreExistingComponent
    -- | An internal dependency ('PackageId' should be a library name)
    -- which we are going to have to build.  (The
    -- 'PackageId' here is a hack to get a modest amount of
    -- polymorphism out of the 'Package' typeclass.)
    | InternalDependency PackageId

data FailedDependency = DependencyNotExists PackageName
                      | DependencyMissingInternal PackageName LibraryName
                      | DependencyNoVersion Dependency

-- | Test for a package dependency and record the version we have installed.
selectDependency :: PackageId -- ^ Package id of current package
                 -> Set LibraryName -- ^ package libraries
                 -> InstalledPackageIndex  -- ^ Installed packages
                 -> Map (PackageName, ComponentName) InstalledPackageInfo
                    -- ^ Packages for which we have been given specific deps to
                    -- use
                 -> UseExternalInternalDeps -- ^ Are we configuring a
                                            -- single component?
                 -> Dependency
                 -> [Either FailedDependency DependencyResolution]
selectDependency :: PackageIdentifier
-> Set LibraryName
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Bool
-> Dependency
-> [Either FailedDependency DependencyResolution]
selectDependency PackageIdentifier
pkgid Set LibraryName
internalIndex InstalledPackageIndex
installedIndex Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
  Bool
use_external_internal_deps
  (Dependency PackageName
dep_pkgname VersionRange
vr NonEmptySet LibraryName
libs) =
  -- If the dependency specification matches anything in the internal package
  -- index, then we prefer that match to anything in the second.
  -- For example:
  --
  -- Name: MyLibrary
  -- Version: 0.1
  -- Library
  --     ..
  -- Executable my-exec
  --     build-depends: MyLibrary
  --
  -- We want "build-depends: MyLibrary" always to match the internal library
  -- even if there is a newer installed library "MyLibrary-0.2".
  if PackageName
dep_pkgname forall a. Eq a => a -> a -> Bool
== PackageName
pn
  then
      if Bool
use_external_internal_deps
      then LibraryName -> Either FailedDependency DependencyResolution
do_external_internal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
      else LibraryName -> Either FailedDependency DependencyResolution
do_internal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
  else
      LibraryName -> Either FailedDependency DependencyResolution
do_external_external forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
  where
    pn :: PackageName
pn = forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pkgid

    -- It's an internal library, and we're not per-component build
    do_internal :: LibraryName -> Either FailedDependency DependencyResolution
do_internal LibraryName
lib
        | forall a. Ord a => a -> Set a -> Bool
Set.member LibraryName
lib Set LibraryName
internalIndex
        = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> DependencyResolution
InternalDependency forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
dep_pkgname forall a b. (a -> b) -> a -> b
$ forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkgid

        | Bool
otherwise
        = forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ PackageName -> LibraryName -> FailedDependency
DependencyMissingInternal PackageName
dep_pkgname LibraryName
lib

    -- We have to look it up externally
    do_external_external :: LibraryName -> Either FailedDependency DependencyResolution
    do_external_external :: LibraryName -> Either FailedDependency DependencyResolution
do_external_external LibraryName
lib = do
      InstalledPackageInfo
ipi <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
dep_pkgname, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap of
        -- If we know the exact pkg to use, then use it.
        Just InstalledPackageInfo
pkginstance -> forall a b. b -> Either a b
Right InstalledPackageInfo
pkginstance
        -- Otherwise we just pick an arbitrary instance of the latest version.
        Maybe InstalledPackageInfo
Nothing -> case [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> PackageName
-> VersionRange
-> LibraryName
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupInternalDependency InstalledPackageIndex
installedIndex PackageName
dep_pkgname VersionRange
vr LibraryName
lib of
          Maybe InstalledPackageInfo
Nothing  -> forall a b. a -> Either a b
Left (PackageName -> FailedDependency
DependencyNotExists PackageName
dep_pkgname)
          Just InstalledPackageInfo
pkg -> forall a b. b -> Either a b
Right InstalledPackageInfo
pkg
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PreExistingComponent -> DependencyResolution
ExternalDependency forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> PreExistingComponent
ipiToPreExistingComponent InstalledPackageInfo
ipi

    do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution
    do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution
do_external_internal LibraryName
lib = do
      InstalledPackageInfo
ipi <- case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
dep_pkgname, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap of
        -- If we know the exact pkg to use, then use it.
        Just InstalledPackageInfo
pkginstance -> forall a b. b -> Either a b
Right InstalledPackageInfo
pkginstance
        Maybe InstalledPackageInfo
Nothing -> case [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI forall a b. (a -> b) -> a -> b
$ InstalledPackageIndex
-> PackageName
-> VersionRange
-> LibraryName
-> [(Version, [InstalledPackageInfo])]
PackageIndex.lookupInternalDependency InstalledPackageIndex
installedIndex PackageName
pn VersionRange
vr LibraryName
lib of
          -- It's an internal library, being looked up externally
          Maybe InstalledPackageInfo
Nothing  -> forall a b. a -> Either a b
Left (PackageName -> LibraryName -> FailedDependency
DependencyMissingInternal PackageName
dep_pkgname LibraryName
lib)
          Just InstalledPackageInfo
pkg -> forall a b. b -> Either a b
Right InstalledPackageInfo
pkg
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ PreExistingComponent -> DependencyResolution
ExternalDependency forall a b. (a -> b) -> a -> b
$ InstalledPackageInfo -> PreExistingComponent
ipiToPreExistingComponent InstalledPackageInfo
ipi

    pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
    pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI [(Version, [InstalledPackageInfo])]
pkgs = forall a. [a] -> Maybe a
safeHead forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> a
last forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. [a] -> Maybe (NonEmpty a)
nonEmpty [(Version, [InstalledPackageInfo])]
pkgs

reportSelectedDependencies :: Verbosity
                           -> [ResolvedDependency] -> IO ()
reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO ()
reportSelectedDependencies Verbosity
verbosity [ResolvedDependency]
deps =
  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [ProgArg] -> ProgArg
unlines
    [ ProgArg
"Dependency " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (Dependency -> Dependency
simplifyDependency Dependency
dep)
                    forall a. [a] -> [a] -> [a]
++ ProgArg
": using " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
pkgid
    | (Dependency
dep, DependencyResolution
resolution) <- [ResolvedDependency]
deps
    , let pkgid :: PackageIdentifier
pkgid = case DependencyResolution
resolution of
            ExternalDependency PreExistingComponent
pkg'   -> forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PreExistingComponent
pkg'
            InternalDependency PackageIdentifier
pkgid' -> PackageIdentifier
pkgid' ]

reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies Verbosity
_ []     = forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportFailedDependencies Verbosity
verbosity [FailedDependency]
failed =
    forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity (forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
"\n\n" (forall a b. (a -> b) -> [a] -> [b]
map FailedDependency -> ProgArg
reportFailedDependency [FailedDependency]
failed))

  where
    reportFailedDependency :: FailedDependency -> ProgArg
reportFailedDependency (DependencyNotExists PackageName
pkgname) =
         ProgArg
"there is no version of " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageName
pkgname forall a. [a] -> [a] -> [a]
++ ProgArg
" installed.\n"
      forall a. [a] -> [a] -> [a]
++ ProgArg
"Perhaps you need to download and install it from\n"
      forall a. [a] -> [a] -> [a]
++ ProgArg
hackageUrl forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageName
pkgname forall a. [a] -> [a] -> [a]
++ ProgArg
"?"

    reportFailedDependency (DependencyMissingInternal PackageName
pkgname LibraryName
lib) =
         ProgArg
"internal dependency " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (LibraryName -> Doc
prettyLibraryNameComponent LibraryName
lib) forall a. [a] -> [a] -> [a]
++ ProgArg
" not installed.\n"
      forall a. [a] -> [a] -> [a]
++ ProgArg
"Perhaps you need to configure and install it first?\n"
      forall a. [a] -> [a] -> [a]
++ ProgArg
"(This library was defined by " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PackageName
pkgname forall a. [a] -> [a] -> [a]
++ ProgArg
")"

    reportFailedDependency (DependencyNoVersion Dependency
dep) =
        ProgArg
"cannot satisfy dependency " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow (Dependency -> Dependency
simplifyDependency Dependency
dep) forall a. [a] -> [a] -> [a]
++ ProgArg
"\n"

-- | List all installed packages in the given package databases.
-- Non-existent package databases do not cause errors, they just get skipped
-- with a warning and treated as empty ones, since technically they do not
-- contain any package.
getInstalledPackages :: Verbosity -> Compiler
                     -> PackageDBStack -- ^ The stack of package databases.
                     -> ProgramDb
                     -> IO InstalledPackageIndex
getInstalledPackages :: Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb = do
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => t a -> Bool
null PackageDBStack
packageDBs) forall a b. (a -> b) -> a -> b
$
    forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"No package databases have been specified. If you use "
       forall a. [a] -> [a] -> [a]
++ ProgArg
"--package-db=clear, you must follow it with --package-db= "
       forall a. [a] -> [a] -> [a]
++ ProgArg
"with 'global', 'user' or a specific file."

  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity ProgArg
"Reading installed packages..."
  -- do not check empty packagedbs (ghc-pkg would error out)
  PackageDBStack
packageDBs' <- forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM PackageDB -> IO Bool
packageDBExists PackageDBStack
packageDBs
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC   -> Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
GHC.getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs' ProgramDb
progdb
    CompilerFlavor
GHCJS -> Verbosity
-> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex
GHCJS.getInstalledPackages Verbosity
verbosity PackageDBStack
packageDBs' ProgramDb
progdb
    CompilerFlavor
UHC   -> Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
UHC.getInstalledPackages Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs' ProgramDb
progdb
    HaskellSuite {} ->
      Verbosity
-> PackageDBStack -> ProgramDb -> IO InstalledPackageIndex
HaskellSuite.getInstalledPackages Verbosity
verbosity PackageDBStack
packageDBs' ProgramDb
progdb
    CompilerFlavor
flv -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"don't know how to find the installed packages for "
              forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow CompilerFlavor
flv
  where
    packageDBExists :: PackageDB -> IO Bool
packageDBExists (SpecificPackageDB ProgArg
path) = do
      Bool
exists <- ProgArg -> IO Bool
doesPathExist ProgArg
path
      forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$
        Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Package db " forall a. Semigroup a => a -> a -> a
<> ProgArg
path forall a. Semigroup a => a -> a -> a
<> ProgArg
" does not exist yet"
      forall (m :: * -> *) a. Monad m => a -> m a
return Bool
exists
    -- Checking the user and global package dbs is more complicated and needs
    -- way more data. Also ghc-pkg won't error out unless the user/global
    -- pkgdb is overridden with an empty one, so we just don't check for them.
    packageDBExists PackageDB
UserPackageDB            = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    packageDBExists PackageDB
GlobalPackageDB          = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True

-- | Like 'getInstalledPackages', but for a single package DB.
--
-- NB: Why isn't this always a fall through to 'getInstalledPackages'?
-- That is because 'getInstalledPackages' performs some sanity checks
-- on the package database stack in question.  However, when sandboxes
-- are involved these sanity checks are not desirable.
getPackageDBContents :: Verbosity -> Compiler
                     -> PackageDB -> ProgramDb
                     -> IO InstalledPackageIndex
getPackageDBContents :: Verbosity
-> Compiler -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
getPackageDBContents Verbosity
verbosity Compiler
comp PackageDB
packageDB ProgramDb
progdb = do
  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity ProgArg
"Reading installed packages..."
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
GHC.getPackageDBContents Verbosity
verbosity PackageDB
packageDB ProgramDb
progdb
    CompilerFlavor
GHCJS -> Verbosity -> PackageDB -> ProgramDb -> IO InstalledPackageIndex
GHCJS.getPackageDBContents Verbosity
verbosity PackageDB
packageDB ProgramDb
progdb
    -- For other compilers, try to fall back on 'getInstalledPackages'.
    CompilerFlavor
_   -> Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp [PackageDB
packageDB] ProgramDb
progdb


-- | A set of files (or directories) that can be monitored to detect when
-- there might have been a change in the installed packages.
--
getInstalledPackagesMonitorFiles :: Verbosity -> Compiler
                                 -> PackageDBStack
                                 -> ProgramDb -> Platform
                                 -> IO [FilePath]
getInstalledPackagesMonitorFiles :: Verbosity
-> Compiler
-> PackageDBStack
-> ProgramDb
-> Platform
-> IO [ProgArg]
getInstalledPackagesMonitorFiles Verbosity
verbosity Compiler
comp PackageDBStack
packageDBs ProgramDb
progdb Platform
platform =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC   -> Verbosity
-> Platform -> ProgramDb -> PackageDBStack -> IO [ProgArg]
GHC.getInstalledPackagesMonitorFiles
               Verbosity
verbosity Platform
platform ProgramDb
progdb PackageDBStack
packageDBs
    CompilerFlavor
other -> do
      Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"don't know how to find change monitoring files for "
                    forall a. [a] -> [a] -> [a]
++ ProgArg
"the installed package databases for " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow CompilerFlavor
other
      forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | The user interface specifies the package dbs to use with a combination of
-- @--global@, @--user@ and @--package-db=global|user|clear|$file@.
-- This function combines the global/user flag and interprets the package-db
-- flag into a single package db stack.
--
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags Bool
userInstall [Maybe PackageDB]
specificDBs =
    forall {a}. [a] -> [Maybe a] -> [a]
extra PackageDBStack
initialStack [Maybe PackageDB]
specificDBs
  where
    initialStack :: PackageDBStack
initialStack | Bool
userInstall = [PackageDB
GlobalPackageDB, PackageDB
UserPackageDB]
                 | Bool
otherwise   = [PackageDB
GlobalPackageDB]

    extra :: [a] -> [Maybe a] -> [a]
extra [a]
dbs' []            = [a]
dbs'
    extra [a]
_    (Maybe a
Nothing:[Maybe a]
dbs) = [a] -> [Maybe a] -> [a]
extra []             [Maybe a]
dbs
    extra [a]
dbs' (Just a
db:[Maybe a]
dbs) = [a] -> [Maybe a] -> [a]
extra ([a]
dbs' forall a. [a] -> [a] -> [a]
++ [a
db]) [Maybe a]
dbs

-- We are given both --constraint="foo < 2.0" style constraints and also
-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".
--
-- When finalising the package we have to take into account the specific
-- installed deps we've been given, and the finalise function expects
-- constraints, so we have to translate these deps into version constraints.
--
-- But after finalising we then have to make sure we pick the right specific
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints
  :: [PackageVersionConstraint]
  -> [GivenComponent]
  -> InstalledPackageIndex
  -> Either String ([PackageVersionConstraint],
                     Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints :: [PackageVersionConstraint]
-> [GivenComponent]
-> InstalledPackageIndex
-> Either
     ProgArg
     ([PackageVersionConstraint],
      Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints [PackageVersionConstraint]
constraints [GivenComponent]
dependencies InstalledPackageIndex
installedPackages = do

    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, ComponentName, ComponentId)]
badComponentIds)) forall a b. (a -> b) -> a -> b
$
      forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ Doc -> ProgArg
render forall a b. (a -> b) -> a -> b
$ ProgArg -> Doc
text ProgArg
"The following package dependencies were requested"
         Doc -> Doc -> Doc
$+$ Int -> Doc -> Doc
nest Int
4 (forall {a} {a}.
(Pretty a, Pretty a) =>
[(a, ComponentName, a)] -> Doc
dispDependencies [(PackageName, ComponentName, ComponentId)]
badComponentIds)
         Doc -> Doc -> Doc
$+$ ProgArg -> Doc
text ProgArg
"however the given installed package instance does not exist."

    --TODO: we don't check that all dependencies are used!

    forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageVersionConstraint]
allConstraints, Map (PackageName, ComponentName) InstalledPackageInfo
idConstraintMap)

  where
    allConstraints :: [PackageVersionConstraint]
    allConstraints :: [PackageVersionConstraint]
allConstraints = [PackageVersionConstraint]
constraints
                  forall a. [a] -> [a] -> [a]
++ [ PackageIdentifier -> PackageVersionConstraint
thisPackageVersionConstraint (forall pkg. Package pkg => pkg -> PackageIdentifier
packageId InstalledPackageInfo
pkg)
                     | (PackageName
_, ComponentName
_, ComponentId
_, Just InstalledPackageInfo
pkg) <- [(PackageName, ComponentName, ComponentId,
  Maybe InstalledPackageInfo)]
dependenciesPkgInfo ]

    idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo
    idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo
idConstraintMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                        -- NB: do NOT use the packageName from
                        -- dependenciesPkgInfo!
                        [ ((PackageName
pn, ComponentName
cname), InstalledPackageInfo
pkg)
                        | (PackageName
pn, ComponentName
cname, ComponentId
_, Just InstalledPackageInfo
pkg) <- [(PackageName, ComponentName, ComponentId,
  Maybe InstalledPackageInfo)]
dependenciesPkgInfo ]

    -- The dependencies along with the installed package info, if it exists
    dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId,
                             Maybe InstalledPackageInfo)]
    dependenciesPkgInfo :: [(PackageName, ComponentName, ComponentId,
  Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
      [ (PackageName
pkgname, LibraryName -> ComponentName
CLibName LibraryName
lname, ComponentId
cid, Maybe InstalledPackageInfo
mpkg)
      | GivenComponent PackageName
pkgname LibraryName
lname ComponentId
cid <- [GivenComponent]
dependencies
      , let mpkg :: Maybe InstalledPackageInfo
mpkg = forall a. PackageIndex a -> ComponentId -> Maybe a
PackageIndex.lookupComponentId
                     InstalledPackageIndex
installedPackages ComponentId
cid
      ]

    -- If we looked up a package specified by an installed package id
    -- (i.e. someone has written a hash) and didn't find it then it's
    -- an error.
    badComponentIds :: [(PackageName, ComponentName, ComponentId)]
badComponentIds =
      [ (PackageName
pkgname, ComponentName
cname, ComponentId
cid)
      | (PackageName
pkgname, ComponentName
cname, ComponentId
cid, Maybe InstalledPackageInfo
Nothing) <- [(PackageName, ComponentName, ComponentId,
  Maybe InstalledPackageInfo)]
dependenciesPkgInfo ]

    dispDependencies :: [(a, ComponentName, a)] -> Doc
dispDependencies [(a, ComponentName, a)]
deps =
      [Doc] -> Doc
hsep [      ProgArg -> Doc
text ProgArg
"--dependency="
             Doc -> Doc -> Doc
<<>> Doc -> Doc
quotes
                    (forall a. Pretty a => a -> Doc
pretty a
pkgname
                     Doc -> Doc -> Doc
<<>> case ComponentName
cname of
                            CLibName LibraryName
LMainLibName    -> Doc
""
                            CLibName (LSubLibName UnqualComponentName
n) -> Doc
":" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
                            ComponentName
_                        -> Doc
":" Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty ComponentName
cname
                     Doc -> Doc -> Doc
<<>> Char -> Doc
char Char
'='
                     Doc -> Doc -> Doc
<<>> forall a. Pretty a => a -> Doc
pretty a
cid)
           | (a
pkgname, ComponentName
cname, a
cid) <- [(a, ComponentName, a)]
deps ]

-- -----------------------------------------------------------------------------
-- Configuring program dependencies

configureRequiredPrograms :: Verbosity -> [LegacyExeDependency] -> ProgramDb
                             -> IO ProgramDb
configureRequiredPrograms :: Verbosity -> [LegacyExeDependency] -> ProgramDb -> IO ProgramDb
configureRequiredPrograms Verbosity
verbosity [LegacyExeDependency]
deps ProgramDb
progdb =
  forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (Verbosity -> ProgramDb -> LegacyExeDependency -> IO ProgramDb
configureRequiredProgram Verbosity
verbosity) ProgramDb
progdb [LegacyExeDependency]
deps

-- | Configure a required program, ensuring that it exists in the PATH
-- (or where the user has specified the program must live) and making it
-- available for use via the 'ProgramDb' interface.  If the program is
-- known (exists in the input 'ProgramDb'), we will make sure that the
-- program matches the required version; otherwise we will accept
-- any version of the program and assume that it is a simpleProgram.
configureRequiredProgram :: Verbosity -> ProgramDb -> LegacyExeDependency
                            -> IO ProgramDb
configureRequiredProgram :: Verbosity -> ProgramDb -> LegacyExeDependency -> IO ProgramDb
configureRequiredProgram Verbosity
verbosity ProgramDb
progdb
  (LegacyExeDependency ProgArg
progName VersionRange
verRange) =
  case ProgArg -> ProgramDb -> Maybe Program
lookupKnownProgram ProgArg
progName ProgramDb
progdb of
    Maybe Program
Nothing ->
      -- Try to configure it as a 'simpleProgram' automatically
      --
      -- There's a bit of a story behind this line.  In old versions
      -- of Cabal, there were only internal build-tools dependencies.  So the
      -- behavior in this case was:
      --
      --    - If a build-tool dependency was internal, don't do
      --      any checking.
      --
      --    - If it was external, call 'configureRequiredProgram' to
      --      "configure" the executable.  In particular, if
      --      the program was not "known" (present in 'ProgramDb'),
      --      then we would just error.  This was fine, because
      --      the only way a program could be executed from 'ProgramDb'
      --      is if some library code from Cabal actually called it,
      --      and the pre-existing Cabal code only calls known
      --      programs from 'defaultProgramDb', and so if it
      --      is calling something else, you have a Custom setup
      --      script, and in that case you are expected to register
      --      the program you want to call in the ProgramDb.
      --
      -- OK, so that was fine, until I (ezyang, in 2016) refactored
      -- Cabal to support per-component builds.  In this case, what
      -- was previously an internal build-tool dependency now became
      -- an external one, and now previously "internal" dependencies
      -- are now external.  But these are permitted to exist even
      -- when they are not previously configured (something that
      -- can only occur by a Custom script.)
      --
      -- So, I decided, "Fine, let's just accept these in any
      -- case."  Thus this line.  The alternative would have been to
      -- somehow detect when a build-tools dependency was "internal" (by
      -- looking at the unflattened package description) but this
      -- would also be incompatible with future work to support
      -- external executable dependencies: we definitely cannot
      -- assume they will be preinitialized in the 'ProgramDb'.
      Verbosity -> Program -> ProgramDb -> IO ProgramDb
configureProgram Verbosity
verbosity (ProgArg -> Program
simpleProgram ProgArg
progName) ProgramDb
progdb
    Just Program
prog
      -- requireProgramVersion always requires the program have a version
      -- but if the user says "build-depends: foo" ie no version constraint
      -- then we should not fail if we cannot discover the program version.
      | VersionRange
verRange forall a. Eq a => a -> a -> Bool
== VersionRange
anyVersion -> do
          (ConfiguredProgram
_, ProgramDb
progdb') <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
progdb
          forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb'
      | Bool
otherwise -> do
          (ConfiguredProgram
_, Version
_, ProgramDb
progdb') <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
prog VersionRange
verRange ProgramDb
progdb
          forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb'

-- -----------------------------------------------------------------------------
-- Configuring pkg-config package dependencies

configurePkgconfigPackages :: Verbosity -> PackageDescription
                           -> ProgramDb -> ComponentRequestedSpec
                           -> IO (PackageDescription, ProgramDb)
configurePkgconfigPackages :: Verbosity
-> PackageDescription
-> ProgramDb
-> ComponentRequestedSpec
-> IO (PackageDescription, ProgramDb)
configurePkgconfigPackages Verbosity
verbosity PackageDescription
pkg_descr ProgramDb
progdb ComponentRequestedSpec
enabled
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PkgconfigDependency]
allpkgs = forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
pkg_descr, ProgramDb
progdb)
  | Bool
otherwise    = do
    (ConfiguredProgram
_, Version
_, ProgramDb
progdb') <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
                       (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity) Program
pkgConfigProgram
                       (Version -> VersionRange
orLaterVersion forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
0,Int
9,Int
0]) ProgramDb
progdb
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ PkgconfigDependency -> IO ()
requirePkg [PkgconfigDependency]
allpkgs
    Maybe Library
mlib' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Library -> IO Library
addPkgConfigBILib (PackageDescription -> Maybe Library
library PackageDescription
pkg_descr)
    [Library]
libs' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Library -> IO Library
addPkgConfigBILib (PackageDescription -> [Library]
subLibraries PackageDescription
pkg_descr)
    [Executable]
exes' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Executable -> IO Executable
addPkgConfigBIExe (PackageDescription -> [Executable]
executables PackageDescription
pkg_descr)
    [TestSuite]
tests' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse TestSuite -> IO TestSuite
addPkgConfigBITest (PackageDescription -> [TestSuite]
testSuites PackageDescription
pkg_descr)
    [Benchmark]
benches' <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Benchmark -> IO Benchmark
addPkgConfigBIBench (PackageDescription -> [Benchmark]
benchmarks PackageDescription
pkg_descr)
    let pkg_descr' :: PackageDescription
pkg_descr' = PackageDescription
pkg_descr { library :: Maybe Library
library = Maybe Library
mlib',
                                 subLibraries :: [Library]
subLibraries = [Library]
libs', executables :: [Executable]
executables = [Executable]
exes',
                                 testSuites :: [TestSuite]
testSuites = [TestSuite]
tests', benchmarks :: [Benchmark]
benchmarks = [Benchmark]
benches' }
    forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
pkg_descr', ProgramDb
progdb')

  where
    allpkgs :: [PkgconfigDependency]
allpkgs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [PkgconfigDependency]
pkgconfigDepends (PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled)
    pkgconfig :: [ProgArg] -> IO ProgArg
pkgconfig = Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO ProgArg
getDbProgramOutput (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity)
                  Program
pkgConfigProgram ProgramDb
progdb

    requirePkg :: PkgconfigDependency -> IO ()
requirePkg dep :: PkgconfigDependency
dep@(PkgconfigDependency PkgconfigName
pkgn PkgconfigVersionRange
range) = do
      ProgArg
version <- [ProgArg] -> IO ProgArg
pkgconfig [ProgArg
"--modversion", ProgArg
pkg]
                 forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`   (\IOException
_ -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
notFound)
                 forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
notFound)
      let trim :: ShowS
trim = forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
      let v :: PkgconfigVersion
v = ByteString -> PkgconfigVersion
PkgconfigVersion (ProgArg -> ByteString
toUTF8BS forall a b. (a -> b) -> a -> b
$ ShowS
trim ProgArg
version)
      if Bool -> Bool
not (PkgconfigVersion -> PkgconfigVersionRange -> Bool
withinPkgconfigVersionRange PkgconfigVersion
v PkgconfigVersionRange
range)
      then forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity (forall a. Pretty a => a -> ProgArg
badVersion PkgconfigVersion
v)
      else Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity (forall a. Pretty a => a -> ProgArg
depSatisfied PkgconfigVersion
v)
      where
        notFound :: ProgArg
notFound     = ProgArg
"The pkg-config package '" forall a. [a] -> [a] -> [a]
++ ProgArg
pkg forall a. [a] -> [a] -> [a]
++ ProgArg
"'"
                    forall a. [a] -> [a] -> [a]
++ ProgArg
versionRequirement
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" is required but it could not be found."
        badVersion :: a -> ProgArg
badVersion a
v = ProgArg
"The pkg-config package '" forall a. [a] -> [a] -> [a]
++ ProgArg
pkg forall a. [a] -> [a] -> [a]
++ ProgArg
"'"
                    forall a. [a] -> [a] -> [a]
++ ProgArg
versionRequirement
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" is required but the version installed on the"
                    forall a. [a] -> [a] -> [a]
++ ProgArg
" system is version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow a
v
        depSatisfied :: a -> ProgArg
depSatisfied a
v = ProgArg
"Dependency " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PkgconfigDependency
dep
                      forall a. [a] -> [a] -> [a]
++ ProgArg
": using version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow a
v

        versionRequirement :: ProgArg
versionRequirement
          | PkgconfigVersionRange -> Bool
isAnyPkgconfigVersion PkgconfigVersionRange
range = ProgArg
""
          | Bool
otherwise                   = ProgArg
" version " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow PkgconfigVersionRange
range

        pkg :: ProgArg
pkg = PkgconfigName -> ProgArg
unPkgconfigName PkgconfigName
pkgn

    -- Adds pkgconfig dependencies to the build info for a component
    addPkgConfigBI :: (t -> BuildInfo) -> (t -> BuildInfo -> b) -> t -> IO b
addPkgConfigBI t -> BuildInfo
compBI t -> BuildInfo -> b
setCompBI t
comp = do
      BuildInfo
bi <- [PkgconfigDependency] -> IO BuildInfo
pkgconfigBuildInfo (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends (t -> BuildInfo
compBI t
comp))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ t -> BuildInfo -> b
setCompBI t
comp (t -> BuildInfo
compBI t
comp forall a. Monoid a => a -> a -> a
`mappend` BuildInfo
bi)

    -- Adds pkgconfig dependencies to the build info for a library
    addPkgConfigBILib :: Library -> IO Library
addPkgConfigBILib = forall {t} {b}.
(t -> BuildInfo) -> (t -> BuildInfo -> b) -> t -> IO b
addPkgConfigBI Library -> BuildInfo
libBuildInfo forall a b. (a -> b) -> a -> b
$
                          \Library
lib BuildInfo
bi -> Library
lib { libBuildInfo :: BuildInfo
libBuildInfo = BuildInfo
bi }

    -- Adds pkgconfig dependencies to the build info for an executable
    addPkgConfigBIExe :: Executable -> IO Executable
addPkgConfigBIExe = forall {t} {b}.
(t -> BuildInfo) -> (t -> BuildInfo -> b) -> t -> IO b
addPkgConfigBI Executable -> BuildInfo
buildInfo forall a b. (a -> b) -> a -> b
$
                          \Executable
exe BuildInfo
bi -> Executable
exe { buildInfo :: BuildInfo
buildInfo = BuildInfo
bi }

    -- Adds pkgconfig dependencies to the build info for a test suite
    addPkgConfigBITest :: TestSuite -> IO TestSuite
addPkgConfigBITest = forall {t} {b}.
(t -> BuildInfo) -> (t -> BuildInfo -> b) -> t -> IO b
addPkgConfigBI TestSuite -> BuildInfo
testBuildInfo forall a b. (a -> b) -> a -> b
$
                          \TestSuite
test BuildInfo
bi -> TestSuite
test { testBuildInfo :: BuildInfo
testBuildInfo = BuildInfo
bi }

    -- Adds pkgconfig dependencies to the build info for a benchmark
    addPkgConfigBIBench :: Benchmark -> IO Benchmark
addPkgConfigBIBench = forall {t} {b}.
(t -> BuildInfo) -> (t -> BuildInfo -> b) -> t -> IO b
addPkgConfigBI Benchmark -> BuildInfo
benchmarkBuildInfo forall a b. (a -> b) -> a -> b
$
                          \Benchmark
bench BuildInfo
bi -> Benchmark
bench { benchmarkBuildInfo :: BuildInfo
benchmarkBuildInfo = BuildInfo
bi }

    pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo
    pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo
pkgconfigBuildInfo []      = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
    pkgconfigBuildInfo [PkgconfigDependency]
pkgdeps = do
      let pkgs :: [ProgArg]
pkgs = forall a. Eq a => [a] -> [a]
nub [ forall a. Pretty a => a -> ProgArg
prettyShow PkgconfigName
pkg | PkgconfigDependency PkgconfigName
pkg PkgconfigVersionRange
_ <- [PkgconfigDependency]
pkgdeps ]
      ProgArg
ccflags <- [ProgArg] -> IO ProgArg
pkgconfig (ProgArg
"--cflags" forall a. a -> [a] -> [a]
: [ProgArg]
pkgs)
      ProgArg
ldflags <- [ProgArg] -> IO ProgArg
pkgconfig (ProgArg
"--libs"   forall a. a -> [a] -> [a]
: [ProgArg]
pkgs)
      ProgArg
ldflags_static <- [ProgArg] -> IO ProgArg
pkgconfig (ProgArg
"--libs"   forall a. a -> [a] -> [a]
: ProgArg
"--static" forall a. a -> [a] -> [a]
: [ProgArg]
pkgs)
      forall (m :: * -> *) a. Monad m => a -> m a
return ([ProgArg] -> [ProgArg] -> [ProgArg] -> BuildInfo
ccLdOptionsBuildInfo (ProgArg -> [ProgArg]
words ProgArg
ccflags) (ProgArg -> [ProgArg]
words ProgArg
ldflags) (ProgArg -> [ProgArg]
words ProgArg
ldflags_static))

-- | Makes a 'BuildInfo' from C compiler and linker flags.
--
-- This can be used with the output from configuration programs like pkg-config
-- and similar package-specific programs like mysql-config, freealut-config etc.
-- For example:
--
-- > ccflags <- getDbProgramOutput verbosity prog progdb ["--cflags"]
-- > ldflags <- getDbProgramOutput verbosity prog progdb ["--libs"]
-- > ldflags_static <- getDbProgramOutput verbosity prog progdb ["--libs", "--static"]
-- > return (ccldOptionsBuildInfo (words ccflags) (words ldflags) (words ldflags_static))
--
ccLdOptionsBuildInfo :: [String] -> [String] -> [String] -> BuildInfo
ccLdOptionsBuildInfo :: [ProgArg] -> [ProgArg] -> [ProgArg] -> BuildInfo
ccLdOptionsBuildInfo [ProgArg]
cflags [ProgArg]
ldflags [ProgArg]
ldflags_static =
  let ([ProgArg]
includeDirs',  [ProgArg]
cflags')   = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-I" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
cflags
      ([ProgArg]
extraLibs',    [ProgArg]
ldflags')  = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-l" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags
      ([ProgArg]
extraLibDirs', [ProgArg]
ldflags'') = forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-L" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags'
      ([ProgArg]
extraLibsStatic')         = forall a. (a -> Bool) -> [a] -> [a]
filter (ProgArg
"-l" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags_static
      ([ProgArg]
extraLibDirsStatic')      = forall a. (a -> Bool) -> [a] -> [a]
filter (ProgArg
"-L" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags_static
  in forall a. Monoid a => a
mempty {
       includeDirs :: [ProgArg]
includeDirs  = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
2) [ProgArg]
includeDirs',
       extraLibs :: [ProgArg]
extraLibs    = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
2) [ProgArg]
extraLibs',
       extraLibDirs :: [ProgArg]
extraLibDirs = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
2) [ProgArg]
extraLibDirs',
       extraLibsStatic :: [ProgArg]
extraLibsStatic = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
2) [ProgArg]
extraLibsStatic',
       extraLibDirsStatic :: [ProgArg]
extraLibDirsStatic = forall a b. (a -> b) -> [a] -> [b]
map (forall a. Int -> [a] -> [a]
drop Int
2) [ProgArg]
extraLibDirsStatic',
       ccOptions :: [ProgArg]
ccOptions    = [ProgArg]
cflags',
       ldOptions :: [ProgArg]
ldOptions    = [ProgArg]
ldflags''
     }

-- -----------------------------------------------------------------------------
-- Determining the compiler details

configCompilerAuxEx :: ConfigFlags
                    -> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx ConfigFlags
cfg = Maybe CompilerFlavor
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx (forall a. Flag a -> Maybe a
flagToMaybe forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag CompilerFlavor
configHcFlavor ConfigFlags
cfg)
                                           (forall a. Flag a -> Maybe a
flagToMaybe forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag ProgArg
configHcPath ConfigFlags
cfg)
                                           (forall a. Flag a -> Maybe a
flagToMaybe forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag ProgArg
configHcPkg ConfigFlags
cfg)
                                           ProgramDb
programDb
                                           (forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
cfg))
  where
    programDb :: ProgramDb
programDb = ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb ConfigFlags
cfg ProgramDb
defaultProgramDb

configCompilerEx :: Maybe CompilerFlavor -> Maybe FilePath -> Maybe FilePath
                 -> ProgramDb -> Verbosity
                 -> IO (Compiler, Platform, ProgramDb)
configCompilerEx :: Maybe CompilerFlavor
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> Verbosity
-> IO (Compiler, Platform, ProgramDb)
configCompilerEx Maybe CompilerFlavor
Nothing Maybe ProgArg
_ Maybe ProgArg
_ ProgramDb
_ Verbosity
verbosity = forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
"Unknown compiler"
configCompilerEx (Just CompilerFlavor
hcFlavor) Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb Verbosity
verbosity = do
  (Compiler
comp, Maybe Platform
maybePlatform, ProgramDb
programDb) <- case CompilerFlavor
hcFlavor of
    CompilerFlavor
GHC   -> Verbosity
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
GHC.configure  Verbosity
verbosity Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb
    CompilerFlavor
GHCJS -> Verbosity
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
GHCJS.configure Verbosity
verbosity Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb
    CompilerFlavor
UHC   -> Verbosity
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
UHC.configure  Verbosity
verbosity Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb
    HaskellSuite {} -> Verbosity
-> Maybe ProgArg
-> Maybe ProgArg
-> ProgramDb
-> IO (Compiler, Maybe Platform, ProgramDb)
HaskellSuite.configure Verbosity
verbosity Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb
    CompilerFlavor
_    -> forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity ProgArg
"Unknown compiler"
  forall (m :: * -> *) a. Monad m => a -> m a
return (Compiler
comp, forall a. a -> Maybe a -> a
fromMaybe Platform
buildPlatform Maybe Platform
maybePlatform, ProgramDb
programDb)

-- -----------------------------------------------------------------------------
-- Testing C lib and header dependencies

-- Try to build a test C program which includes every header and links every
-- lib. If that fails, try to narrow it down by preprocessing (only) and linking
-- with individual headers and libs.  If none is the obvious culprit then give a
-- generic error message.
-- TODO: produce a log file from the compiler errors, if any.
checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
checkForeignDeps :: PackageDescription -> LocalBuildInfo -> Verbosity -> IO ()
checkForeignDeps PackageDescription
pkg LocalBuildInfo
lbi Verbosity
verbosity =
  forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [ProgArg]
allHeaders ([ProgArg]
commonCcArgs forall a. [a] -> [a] -> [a]
++ [ProgArg] -> [ProgArg]
makeLdArgs [ProgArg]
allLibs) -- I'm feeling
                                                               -- lucky
           (forall (m :: * -> *) a. Monad m => a -> m a
return ())
           (do [ProgArg]
missingLibs <- IO [ProgArg]
findMissingLibs
               Maybe (Either ProgArg ProgArg)
missingHdr  <- IO (Maybe (Either ProgArg ProgArg))
findOffendingHdr
               Maybe (Either ProgArg ProgArg) -> [ProgArg] -> IO ()
explainErrors Maybe (Either ProgArg ProgArg)
missingHdr [ProgArg]
missingLibs)
      where
        allHeaders :: [ProgArg]
allHeaders = forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
includes
        allLibs :: [ProgArg]
allLibs    = forall {b}. (BuildInfo -> [b]) -> [b]
collectField forall a b. (a -> b) -> a -> b
$
          if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
          then BuildInfo -> [ProgArg]
extraLibsStatic
          else BuildInfo -> [ProgArg]
extraLibs

        ifBuildsWith :: [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [ProgArg]
headers [ProgArg]
args IO b
success IO b
failure = do
            IO ()
checkDuplicateHeaders
            Bool
ok <- ProgArg -> [ProgArg] -> IO Bool
builds ([ProgArg] -> ProgArg
makeProgram [ProgArg]
headers) [ProgArg]
args
            if Bool
ok then IO b
success else IO b
failure

        -- Ensure that there is only one header with a given name
        -- in either the generated (most likely by `configure`)
        -- build directory (e.g. `dist/build`) or in the source directory.
        --
        -- If it exists in both, we'll remove the one in the source
        -- directory, as the generated should take precedence.
        --
        -- C compilers like to prefer source local relative includes,
        -- so the search paths provided to the compiler via -I are
        -- ignored if the included file can be found relative to the
        -- including file.  As such we need to take drastic measures
        -- and delete the offending file in the source directory.
        checkDuplicateHeaders :: IO ()
checkDuplicateHeaders = do
          let relIncDirs :: [ProgArg]
relIncDirs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> Bool
isAbsolute) (forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
includeDirs)
              isHeader :: ProgArg -> Bool
isHeader   = forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf ProgArg
".h"
          [[ProgArg]]
genHeaders <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ProgArg]
relIncDirs forall a b. (a -> b) -> a -> b
$ \ProgArg
dir ->
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProgArg
dir ProgArg -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ProgArg -> Bool
isHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ProgArg -> IO [ProgArg]
listDirectory (LocalBuildInfo -> ProgArg
buildDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
dir) forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
          [[ProgArg]]
srcHeaders <- forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ProgArg]
relIncDirs forall a b. (a -> b) -> a -> b
$ \ProgArg
dir ->
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProgArg
dir ProgArg -> ShowS
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter ProgArg -> Bool
isHeader forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ProgArg -> IO [ProgArg]
listDirectory (LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
dir) forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return [])
          let commonHeaders :: [ProgArg]
commonHeaders = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProgArg]]
genHeaders forall a. Eq a => [a] -> [a] -> [a]
`intersect` forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProgArg]]
srcHeaders
          forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [ProgArg]
commonHeaders forall a b. (a -> b) -> a -> b
$ \ProgArg
hdr -> do
            Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Duplicate header found in "
                          forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ProgArg
buildDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
hdr)
                          forall a. [a] -> [a] -> [a]
++ ProgArg
" and "
                          forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
hdr)
                          forall a. [a] -> [a] -> [a]
++ ProgArg
"; removing "
                          forall a. [a] -> [a] -> [a]
++ (LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
hdr)
            ProgArg -> IO ()
removeFile (LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
hdr)

        findOffendingHdr :: IO (Maybe (Either ProgArg ProgArg))
findOffendingHdr =
            forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [ProgArg]
allHeaders [ProgArg]
ccArgs
                         (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing)
                         ([[ProgArg]] -> IO (Maybe (Either ProgArg ProgArg))
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Foldable f => f a -> NonEmpty [a]
NEL.inits forall a b. (a -> b) -> a -> b
$ [ProgArg]
allHeaders)
            where
              go :: [[ProgArg]] -> IO (Maybe (Either ProgArg ProgArg))
go [] = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing       -- cannot happen
              go ([ProgArg]
hdrs:[[ProgArg]]
hdrsInits) =
                    -- Try just preprocessing first
                    forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [ProgArg]
hdrs [ProgArg]
cppArgs
                      -- If that works, try compiling too
                      (forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [ProgArg]
hdrs [ProgArg]
ccArgs
                        ([[ProgArg]] -> IO (Maybe (Either ProgArg ProgArg))
go [[ProgArg]]
hdrsInits)
                        (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
safeLast forall a b. (a -> b) -> a -> b
$ [ProgArg]
hdrs))
                      (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> Maybe a
safeLast forall a b. (a -> b) -> a -> b
$ [ProgArg]
hdrs)


              cppArgs :: [ProgArg]
cppArgs = ProgArg
"-E"forall a. a -> [a] -> [a]
:[ProgArg]
commonCppArgs -- preprocess only
              ccArgs :: [ProgArg]
ccArgs  = ProgArg
"-c"forall a. a -> [a] -> [a]
:[ProgArg]
commonCcArgs  -- don't try to link

        findMissingLibs :: IO [ProgArg]
findMissingLibs = forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith [] ([ProgArg] -> [ProgArg]
makeLdArgs [ProgArg]
allLibs)
                                       (forall (m :: * -> *) a. Monad m => a -> m a
return [])
                                       (forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> IO Bool
libExists) [ProgArg]
allLibs)

        libExists :: ProgArg -> IO Bool
libExists ProgArg
lib = ProgArg -> [ProgArg] -> IO Bool
builds ([ProgArg] -> ProgArg
makeProgram []) ([ProgArg] -> [ProgArg]
makeLdArgs [ProgArg
lib])

        baseDir :: LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi' = forall a. a -> Maybe a -> a
fromMaybe ProgArg
"." (ShowS
takeDirectory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LocalBuildInfo -> Maybe ProgArg
cabalFilePath LocalBuildInfo
lbi')

        commonCppArgs :: [ProgArg]
commonCppArgs = LocalBuildInfo -> [ProgArg]
platformDefines LocalBuildInfo
lbi
                     -- TODO: This is a massive hack, to work around the
                     -- fact that the test performed here should be
                     -- PER-component (c.f. the "I'm Feeling Lucky"; we
                     -- should NOT be glomming everything together.)
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ProgArg
buildDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
"autogen" ]
                     -- `configure' may generate headers in the build directory
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ProgArg
buildDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
dir
                        | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub (forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
includeDirs)
                        , Bool -> Bool
not (ProgArg -> Bool
isAbsolute ProgArg
dir)]
                     -- we might also reference headers from the
                     -- packages directory.
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi ProgArg -> ShowS
</> ProgArg
dir
                        | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub (forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
includeDirs)
                        , Bool -> Bool
not (ProgArg -> Bool
isAbsolute ProgArg
dir)]
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ ProgArg
dir | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub (forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
includeDirs)
                                      , ProgArg -> Bool
isAbsolute ProgArg
dir]
                     forall a. [a] -> [a] -> [a]
++ [ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ LocalBuildInfo -> ProgArg
baseDir LocalBuildInfo
lbi]
                     forall a. [a] -> [a] -> [a]
++ forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
cppOptions
                     forall a. [a] -> [a] -> [a]
++ forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
ccOptions
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" forall a. [a] -> [a] -> [a]
++ ProgArg
dir
                        | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub [ ProgArg
dir
                                        | InstalledPackageInfo
dep <- [InstalledPackageInfo]
deps
                                        , ProgArg
dir <- InstalledPackageInfo -> [ProgArg]
IPI.includeDirs InstalledPackageInfo
dep ]
                                 -- dedupe include dirs of dependencies
                                 -- to prevent quadratic blow-up
                        ]
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
opt
                        | InstalledPackageInfo
dep <- [InstalledPackageInfo]
deps
                        , ProgArg
opt <- InstalledPackageInfo -> [ProgArg]
IPI.ccOptions InstalledPackageInfo
dep ]

        commonCcArgs :: [ProgArg]
commonCcArgs  = [ProgArg]
commonCppArgs
                     forall a. [a] -> [a] -> [a]
++ forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
ccOptions
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
opt
                        | InstalledPackageInfo
dep <- [InstalledPackageInfo]
deps
                        , ProgArg
opt <- InstalledPackageInfo -> [ProgArg]
IPI.ccOptions InstalledPackageInfo
dep ]

        commonLdArgs :: [ProgArg]
commonLdArgs  = [ ProgArg
"-L" forall a. [a] -> [a] -> [a]
++ ProgArg
dir
                        | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub forall a b. (a -> b) -> a -> b
$ forall {b}. (BuildInfo -> [b]) -> [b]
collectField (if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                         then BuildInfo -> [ProgArg]
extraLibDirsStatic
                                                         else BuildInfo -> [ProgArg]
extraLibDirs
                                                       ) ]
                     forall a. [a] -> [a] -> [a]
++ forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
ldOptions
                     forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-L" forall a. [a] -> [a] -> [a]
++ ProgArg
dir
                        | ProgArg
dir <- forall a. Ord a => [a] -> [a]
ordNub [ ProgArg
dir
                                        | InstalledPackageInfo
dep <- [InstalledPackageInfo]
deps
                                        , ProgArg
dir <- if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                                                 then InstalledPackageInfo -> [ProgArg]
IPI.libraryDirsStatic InstalledPackageInfo
dep
                                                 else InstalledPackageInfo -> [ProgArg]
IPI.libraryDirs InstalledPackageInfo
dep ]
                        ]
                     --TODO: do we also need dependent packages' ld options?
        makeLdArgs :: [ProgArg] -> [ProgArg]
makeLdArgs [ProgArg]
libs = [ ProgArg
"-l"forall a. [a] -> [a] -> [a]
++ProgArg
lib | ProgArg
lib <- [ProgArg]
libs ] forall a. [a] -> [a] -> [a]
++ [ProgArg]
commonLdArgs

        makeProgram :: [ProgArg] -> ProgArg
makeProgram [ProgArg]
hdrs = [ProgArg] -> ProgArg
unlines forall a b. (a -> b) -> a -> b
$
                           [ ProgArg
"#include \""  forall a. [a] -> [a] -> [a]
++ ProgArg
hdr forall a. [a] -> [a] -> [a]
++ ProgArg
"\"" | ProgArg
hdr <- [ProgArg]
hdrs ] forall a. [a] -> [a] -> [a]
++
                           [ProgArg
"int main(int argc, char** argv) { return 0; }"]

        collectField :: (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [b]
f = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap BuildInfo -> [b]
f [BuildInfo]
allBi
        allBi :: [BuildInfo]
allBi = PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg (LocalBuildInfo -> ComponentRequestedSpec
componentEnabledSpec LocalBuildInfo
lbi)
        deps :: [InstalledPackageInfo]
deps = forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)

        builds :: ProgArg -> [ProgArg] -> IO Bool
builds ProgArg
program [ProgArg]
args = do
            ProgArg
tempDir <- IO ProgArg
getTemporaryDirectory
            forall a. ProgArg -> ProgArg -> (ProgArg -> Handle -> IO a) -> IO a
withTempFile ProgArg
tempDir ProgArg
".c" forall a b. (a -> b) -> a -> b
$ \ProgArg
cName Handle
cHnd ->
              forall a. ProgArg -> ProgArg -> (ProgArg -> Handle -> IO a) -> IO a
withTempFile ProgArg
tempDir ProgArg
"" forall a b. (a -> b) -> a -> b
$ \ProgArg
oNname Handle
oHnd -> do
                Handle -> ProgArg -> IO ()
hPutStrLn Handle
cHnd ProgArg
program
                Handle -> IO ()
hClose Handle
cHnd
                Handle -> IO ()
hClose Handle
oHnd
                ProgArg
_ <- Verbosity -> Program -> ProgramDb -> [ProgArg] -> IO ProgArg
getDbProgramOutput Verbosity
verbosity
                  Program
gccProgram (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi) (ProgArg
cNameforall a. a -> [a] -> [a]
:ProgArg
"-o"forall a. a -> [a] -> [a]
:ProgArg
oNnameforall a. a -> [a] -> [a]
:[ProgArg]
args)
                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
           forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO`   (\IOException
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
           forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

        explainErrors :: Maybe (Either ProgArg ProgArg) -> [ProgArg] -> IO ()
explainErrors Maybe (Either ProgArg ProgArg)
Nothing [] = forall (m :: * -> *) a. Monad m => a -> m a
return () -- should be impossible!
        explainErrors Maybe (Either ProgArg ProgArg)
_ [ProgArg]
_
           | forall a. Maybe a -> Bool
isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
gccProgram forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> ProgramDb
withPrograms forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi

                              = forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [ProgArg] -> ProgArg
unlines
              [ ProgArg
"No working gcc",
                  ProgArg
"This package depends on foreign library but we cannot "
               forall a. [a] -> [a] -> [a]
++ ProgArg
"find a working C compiler. If you have it in a "
               forall a. [a] -> [a] -> [a]
++ ProgArg
"non-standard location you can use the --with-gcc "
               forall a. [a] -> [a] -> [a]
++ ProgArg
"flag to specify it." ]

        explainErrors Maybe (Either ProgArg ProgArg)
hdr [ProgArg]
libs = forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ [ProgArg] -> ProgArg
unlines forall a b. (a -> b) -> a -> b
$
             [ if Bool
plural
                 then ProgArg
"Missing dependencies on foreign libraries:"
                 else ProgArg
"Missing dependency on a foreign library:"
             | Bool
missing ]
          forall a. [a] -> [a] -> [a]
++ case Maybe (Either ProgArg ProgArg)
hdr of
               Just (Left ProgArg
h) -> [ProgArg
"* Missing (or bad) header file: " forall a. [a] -> [a] -> [a]
++ ProgArg
h ]
               Maybe (Either ProgArg ProgArg)
_             -> []
          forall a. [a] -> [a] -> [a]
++ case [ProgArg]
libs of
               []    -> []
               [ProgArg
lib] -> [ProgArg
"* Missing (or bad) C library: " forall a. [a] -> [a] -> [a]
++ ProgArg
lib]
               [ProgArg]
_     -> [ProgArg
"* Missing (or bad) C libraries: " forall a. [a] -> [a] -> [a]
++
                         forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
", " [ProgArg]
libs]
          forall a. [a] -> [a] -> [a]
++ [if Bool
plural then ProgArg
messagePlural else ProgArg
messageSingular | Bool
missing]
          forall a. [a] -> [a] -> [a]
++ case Maybe (Either ProgArg ProgArg)
hdr of
               Just (Left  ProgArg
_) -> [ ProgArg
headerCppMessage ]
               Just (Right ProgArg
h) -> [ (if Bool
missing then ProgArg
"* " else ProgArg
"")
                                   forall a. [a] -> [a] -> [a]
++ ProgArg
"Bad header file: " forall a. [a] -> [a] -> [a]
++ ProgArg
h
                                 , ProgArg
headerCcMessage ]
               Maybe (Either ProgArg ProgArg)
_              -> []

          where
            plural :: Bool
plural  = forall (t :: * -> *) a. Foldable t => t a -> Int
length [ProgArg]
libs forall a. Ord a => a -> a -> Bool
>= Int
2
            -- Is there something missing? (as opposed to broken)
            missing :: Bool
missing = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProgArg]
libs)
                   Bool -> Bool -> Bool
|| case Maybe (Either ProgArg ProgArg)
hdr of Just (Left ProgArg
_) -> Bool
True; Maybe (Either ProgArg ProgArg)
_ -> Bool
False

        messageSingular :: ProgArg
messageSingular =
             ProgArg
"This problem can usually be solved by installing the system "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"package that provides this library (you may need the "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"\"-dev\" version). If the library is already installed "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"but in a non-standard location then you can use the flags "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"--extra-include-dirs= and --extra-lib-dirs= to specify "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"where it is."
          forall a. [a] -> [a] -> [a]
++ ProgArg
"If the library file does exist, it may contain errors that "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"are caught by the C compiler at the preprocessing stage. "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"In this case you can re-run configure with the verbosity "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"flag -v3 to see the error messages."
        messagePlural :: ProgArg
messagePlural =
             ProgArg
"This problem can usually be solved by installing the system "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"packages that provide these libraries (you may need the "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"\"-dev\" versions). If the libraries are already installed "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"but in a non-standard location then you can use the flags "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"--extra-include-dirs= and --extra-lib-dirs= to specify "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"where they are."
          forall a. [a] -> [a] -> [a]
++ ProgArg
"If the library files do exist, it may contain errors that "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"are caught by the C compiler at the preprocessing stage. "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"In this case you can re-run configure with the verbosity "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"flag -v3 to see the error messages."
        headerCppMessage :: ProgArg
headerCppMessage =
             ProgArg
"If the header file does exist, it may contain errors that "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"are caught by the C compiler at the preprocessing stage. "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"In this case you can re-run configure with the verbosity "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"flag -v3 to see the error messages."
        headerCcMessage :: ProgArg
headerCcMessage =
             ProgArg
"The header file contains a compile error. "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"You can re-run configure with the verbosity flag "
          forall a. [a] -> [a] -> [a]
++ ProgArg
"-v3 to see the error messages from the C compiler."

-- | Output package check warnings and errors. Exit if any errors.
checkPackageProblems :: Verbosity
                     -> FilePath
                        -- ^ Path to the @.cabal@ file's directory
                     -> GenericPackageDescription
                     -> PackageDescription
                     -> IO ()
checkPackageProblems :: Verbosity
-> ProgArg
-> GenericPackageDescription
-> PackageDescription
-> IO ()
checkPackageProblems Verbosity
verbosity ProgArg
dir GenericPackageDescription
gpkg PackageDescription
pkg = do
  [PackageCheck]
ioChecks      <- Verbosity -> PackageDescription -> ProgArg -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg ProgArg
dir
  let pureChecks :: [PackageCheck]
pureChecks = GenericPackageDescription
-> Maybe PackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
gpkg (forall a. a -> Maybe a
Just PackageDescription
pkg)
      ([PackageCheck]
errors, [PackageCheck]
warnings) =
        forall a b. [Either a b] -> ([a], [b])
partitionEithers (forall a b. (a -> Maybe b) -> [a] -> [b]
M.mapMaybe PackageCheck -> Maybe (Either PackageCheck PackageCheck)
classEW forall a b. (a -> b) -> a -> b
$ [PackageCheck]
pureChecks forall a. [a] -> [a] -> [a]
++ [PackageCheck]
ioChecks)
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageCheck]
errors
    then forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity) (forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> ProgArg
ppPackageCheck [PackageCheck]
warnings)
    else forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity (forall a. [a] -> [[a]] -> [a]
intercalate ProgArg
"\n\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map PackageCheck -> ProgArg
ppPackageCheck [PackageCheck]
errors)
  where
    -- Classify error/warnings. Left: error, Right: warning.
    classEW :: PackageCheck -> Maybe (Either PackageCheck PackageCheck)
    classEW :: PackageCheck -> Maybe (Either PackageCheck PackageCheck)
classEW e :: PackageCheck
e@(PackageBuildImpossible CheckExplanation
_) = forall a. a -> Maybe a
Just (forall a b. a -> Either a b
Left PackageCheck
e)
    classEW w :: PackageCheck
w@(PackageBuildWarning CheckExplanation
_) = forall a. a -> Maybe a
Just (forall a b. b -> Either a b
Right PackageCheck
w)
    classEW (PackageDistSuspicious CheckExplanation
_) = forall a. Maybe a
Nothing
    classEW (PackageDistSuspiciousWarn CheckExplanation
_) = forall a. Maybe a
Nothing
    classEW (PackageDistInexcusable CheckExplanation
_) = forall a. Maybe a
Nothing

-- | Preform checks if a relocatable build is allowed
checkRelocatable :: Verbosity
                 -> PackageDescription
                 -> LocalBuildInfo
                 -> IO ()
checkRelocatable :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
checkRelocatable Verbosity
verbosity PackageDescription
pkg LocalBuildInfo
lbi
    = forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ [ IO ()
checkOS
                , IO ()
checkCompiler
                , IO ()
packagePrefixRelative
                , IO ()
depsPrefixRelative
                ]
  where
    -- Check if the OS support relocatable builds.
    --
    -- If you add new OS' to this list, and your OS supports dynamic libraries
    -- and RPATH, make sure you add your OS to RPATH-support list of:
    -- Distribution.Simple.GHC.getRPaths
    checkOS :: IO ()
checkOS
        = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (OS
os forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ OS
OSX, OS
Linux ])
        forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Operating system: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> ProgArg
prettyShow OS
os forall a. [a] -> [a] -> [a]
++
                ProgArg
", does not support relocatable builds"
      where
        (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi

    -- Check if the Compiler support relocatable builds
    checkCompiler :: IO ()
checkCompiler
        = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Compiler -> CompilerFlavor
compilerFlavor Compiler
comp forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ CompilerFlavor
GHC ])
        forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Compiler: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ProgArg
show Compiler
comp forall a. [a] -> [a] -> [a]
++
                ProgArg
", does not support relocatable builds"
      where
        comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi

    -- Check if all the install dirs are relative to same prefix
    packagePrefixRelative :: IO ()
packagePrefixRelative
        = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InstallDirs ProgArg -> Bool
relativeInstallDirs InstallDirs ProgArg
installDirs)
        forall a b. (a -> b) -> a -> b
$ forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ ProgArg
"Installation directories are not prefix_relative:\n" forall a. [a] -> [a] -> [a]
++
                forall a. Show a => a -> ProgArg
show InstallDirs ProgArg
installDirs
      where
        -- NB: should be good enough to check this against the default
        -- component ID, but if we wanted to be strictly correct we'd
        -- check for each ComponentId.
        installDirs :: InstallDirs ProgArg
installDirs = PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs ProgArg
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi CopyDest
NoCopyDest
        p :: ProgArg
p           = forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
installDirs
        relativeInstallDirs :: InstallDirs ProgArg -> Bool
relativeInstallDirs (InstallDirs {ProgArg
haddockdir :: forall dir. InstallDirs dir -> dir
htmldir :: forall dir. InstallDirs dir -> dir
mandir :: forall dir. InstallDirs dir -> dir
datasubdir :: forall dir. InstallDirs dir -> dir
includedir :: forall dir. InstallDirs dir -> dir
libexecsubdir :: forall dir. InstallDirs dir -> dir
flibdir :: forall dir. InstallDirs dir -> dir
libsubdir :: forall dir. InstallDirs dir -> dir
sysconfdir :: ProgArg
haddockdir :: ProgArg
htmldir :: ProgArg
mandir :: ProgArg
docdir :: ProgArg
datasubdir :: ProgArg
datadir :: ProgArg
includedir :: ProgArg
libexecsubdir :: ProgArg
libexecdir :: ProgArg
flibdir :: ProgArg
dynlibdir :: ProgArg
libsubdir :: ProgArg
libdir :: ProgArg
bindir :: ProgArg
prefix :: ProgArg
sysconfdir :: forall dir. InstallDirs dir -> dir
docdir :: forall dir. InstallDirs dir -> dir
datadir :: forall dir. InstallDirs dir -> dir
libexecdir :: forall dir. InstallDirs dir -> dir
dynlibdir :: forall dir. InstallDirs dir -> dir
libdir :: forall dir. InstallDirs dir -> dir
bindir :: forall dir. InstallDirs dir -> dir
prefix :: forall dir. InstallDirs dir -> dir
..}) =
          forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall a. Maybe a -> Bool
isJust
              (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ProgArg
p)
                    [ ProgArg
bindir, ProgArg
libdir, ProgArg
dynlibdir, ProgArg
libexecdir, ProgArg
includedir, ProgArg
datadir
                    , ProgArg
docdir, ProgArg
mandir, ProgArg
htmldir, ProgArg
haddockdir, ProgArg
sysconfdir] )

    -- Check if the library dirs of the dependencies that are in the package
    -- database to which the package is installed are relative to the
    -- prefix of the package
    depsPrefixRelative :: IO ()
depsPrefixRelative = do
        ProgArg
pkgr <- Verbosity -> LocalBuildInfo -> PackageDB -> IO ProgArg
GHC.pkgRoot Verbosity
verbosity LocalBuildInfo
lbi (PackageDBStack -> PackageDB
registrationPackageDB (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi))
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (ProgArg -> InstalledPackageInfo -> IO ()
doCheck ProgArg
pkgr) [InstalledPackageInfo]
ipkgs
      where
        doCheck :: ProgArg -> InstalledPackageInfo -> IO ()
doCheck ProgArg
pkgr InstalledPackageInfo
ipkg
          | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. Eq a => a -> a -> Bool
== ProgArg
pkgr) (InstalledPackageInfo -> Maybe ProgArg
IPI.pkgRoot InstalledPackageInfo
ipkg)
          = forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InstalledPackageInfo -> [ProgArg]
IPI.libraryDirs InstalledPackageInfo
ipkg) forall a b. (a -> b) -> a -> b
$ \ProgArg
libdir -> do
              -- When @prefix@ is not under @pkgroot@,
              -- @shortRelativePath prefix pkgroot@ will return a path with
              -- @..@s and following check will fail without @canonicalizePath@.
              ProgArg
canonicalized <- ProgArg -> IO ProgArg
canonicalizePath ProgArg
libdir
              forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ProgArg
p forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ProgArg
canonicalized) forall a b. (a -> b) -> a -> b
$
                forall a. Verbosity -> ProgArg -> IO a
die' Verbosity
verbosity forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> ProgArg
msg ProgArg
libdir
          | Bool
otherwise
          = forall (m :: * -> *) a. Monad m => a -> m a
return ()
        -- NB: should be good enough to check this against the default
        -- component ID, but if we wanted to be strictly correct we'd
        -- check for each ComponentId.
        installDirs :: InstallDirs ProgArg
installDirs   = PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs ProgArg
absoluteInstallDirs PackageDescription
pkg LocalBuildInfo
lbi CopyDest
NoCopyDest
        p :: ProgArg
p             = forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
installDirs
        ipkgs :: [InstalledPackageInfo]
ipkgs         = forall a. PackageIndex a -> [a]
PackageIndex.allPackages (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)
        msg :: a -> ProgArg
msg a
l         = ProgArg
"Library directory of a dependency: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> ProgArg
show a
l forall a. [a] -> [a] -> [a]
++
                        ProgArg
"\nis not relative to the installation prefix:\n" forall a. [a] -> [a] -> [a]
++
                        forall a. Show a => a -> ProgArg
show ProgArg
p

-- -----------------------------------------------------------------------------
-- Testing foreign library requirements

unsupportedForeignLibs :: Compiler -> Platform -> [ForeignLib] -> [String]
unsupportedForeignLibs :: Compiler -> Platform -> [ForeignLib] -> [ProgArg]
unsupportedForeignLibs Compiler
comp Platform
platform =
    forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Compiler -> Platform -> ForeignLib -> Maybe ProgArg
checkForeignLibSupported Compiler
comp Platform
platform)

checkForeignLibSupported :: Compiler -> Platform -> ForeignLib -> Maybe String
checkForeignLibSupported :: Compiler -> Platform -> ForeignLib -> Maybe ProgArg
checkForeignLibSupported Compiler
comp Platform
platform ForeignLib
flib = CompilerFlavor -> Maybe ProgArg
go (Compiler -> CompilerFlavor
compilerFlavor Compiler
comp)
  where
    go :: CompilerFlavor -> Maybe String
    go :: CompilerFlavor -> Maybe ProgArg
go CompilerFlavor
GHC
      | Compiler -> Version
compilerVersion Compiler
comp forall a. Ord a => a -> a -> Bool
< [Int] -> Version
mkVersion [Int
7,Int
8] = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"Building foreign libraries is only supported with GHC >= 7.8"
      ]
      | Bool
otherwise = Platform -> Maybe ProgArg
goGhcPlatform Platform
platform
    go CompilerFlavor
_   = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"Building foreign libraries is currently only supported with ghc"
      ]

    goGhcPlatform :: Platform -> Maybe String
    goGhcPlatform :: Platform -> Maybe ProgArg
goGhcPlatform (Platform Arch
_      OS
OSX    ) = ForeignLibType -> Maybe ProgArg
goGhcOsx     (ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib)
    goGhcPlatform (Platform Arch
_      OS
Linux  ) = ForeignLibType -> Maybe ProgArg
goGhcLinux   (ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib)
    goGhcPlatform (Platform Arch
I386   OS
Windows) = ForeignLibType -> Maybe ProgArg
goGhcWindows (ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib)
    goGhcPlatform (Platform Arch
X86_64 OS
Windows) = ForeignLibType -> Maybe ProgArg
goGhcWindows (ForeignLib -> ForeignLibType
foreignLibType ForeignLib
flib)
    goGhcPlatform Platform
_ = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"Building foreign libraries is currently only supported on Mac OS, "
      , ProgArg
"Linux and Windows"
      ]

    goGhcOsx :: ForeignLibType -> Maybe String
    goGhcOsx :: ForeignLibType -> Maybe ProgArg
goGhcOsx ForeignLibType
ForeignLibNativeShared
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> [ProgArg]
foreignLibModDefFile ForeignLib
flib)) = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"Module definition file not supported on OSX"
          ]
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo ForeignLib
flib)) = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"Foreign library versioning not currently supported on OSX"
          ]
      | Bool
otherwise =
          forall a. Maybe a
Nothing
    goGhcOsx ForeignLibType
_ = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"We can currently only build shared foreign libraries on OSX"
      ]

    goGhcLinux :: ForeignLibType -> Maybe String
    goGhcLinux :: ForeignLibType -> Maybe ProgArg
goGhcLinux ForeignLibType
ForeignLibNativeShared
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> [ProgArg]
foreignLibModDefFile ForeignLib
flib)) = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"Module definition file not supported on Linux"
          ]
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo ForeignLib
flib))
          Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> Maybe Version
foreignLibVersionLinux ForeignLib
flib)) = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"You must not specify both lib-version-info and lib-version-linux"
          ]
      | Bool
otherwise =
          forall a. Maybe a
Nothing
    goGhcLinux ForeignLibType
_ = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"We can currently only build shared foreign libraries on Linux"
      ]

    goGhcWindows :: ForeignLibType -> Maybe String
    goGhcWindows :: ForeignLibType -> Maybe ProgArg
goGhcWindows ForeignLibType
ForeignLibNativeShared
      | Bool -> Bool
not Bool
standalone = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"We can currently only build standalone libraries on Windows. Use\n"
          , ProgArg
"  if os(Windows)\n"
          , ProgArg
"    options: standalone\n"
          , ProgArg
"in your foreign-library stanza."
          ]
      | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo ForeignLib
flib)) = [ProgArg] -> Maybe ProgArg
unsupported [
            ProgArg
"Foreign library versioning not currently supported on Windows.\n"
          , ProgArg
"You can specify module definition files in the mod-def-file field."
          ]
      | Bool
otherwise =
         forall a. Maybe a
Nothing
    goGhcWindows ForeignLibType
_ = [ProgArg] -> Maybe ProgArg
unsupported [
        ProgArg
"We can currently only build shared foreign libraries on Windows"
      ]

    standalone :: Bool
    standalone :: Bool
standalone = ForeignLibOption
ForeignLibStandalone forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ForeignLib -> [ForeignLibOption]
foreignLibOptions ForeignLib
flib

    unsupported :: [String] -> Maybe String
    unsupported :: [ProgArg] -> Maybe ProgArg
unsupported = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat