{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# 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
  , configure_setupHooks
  , writePersistBuildConfig
  , getConfigStateFile
  , getPersistBuildConfig
  , checkPersistBuildConfigOutdated
  , tryGetPersistBuildConfig
  , maybeGetPersistBuildConfig
  , findDistPref
  , findDistPrefOrDefault
  , getInternalLibraries
  , computeComponentId
  , computeCompatPackageKey
  , localBuildInfoFile
  , getInstalledPackages
  , getInstalledPackagesMonitorFiles
  , getInstalledPackagesById
  , getPackageDBContents
  , configCompilerEx
  , configCompilerAuxEx
  , computeEffectiveProfiling
  , ccLdOptionsBuildInfo
  , checkForeignDeps
  , interpretPackageDbFlags
  , ConfigStateFileError (..)
  , tryGetConfigStateFile
  , platformDefines
  ) where

import Control.Monad
import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Backpack.Configure
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.DescribeUnitId
import Distribution.Backpack.Id
import Distribution.Backpack.PreExistingComponent
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Stack
import Distribution.Compiler
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Package
import Distribution.PackageDescription
import Distribution.PackageDescription.Check hiding (doesFileExist)
import Distribution.PackageDescription.Configuration
import Distribution.PackageDescription.PrettyPrint
import Distribution.Simple.BuildTarget
import Distribution.Simple.BuildToolDepends
import Distribution.Simple.BuildWay
import Distribution.Simple.Compiler
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex (InstalledPackageIndex, lookupUnitId)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PreProcess
import Distribution.Simple.Program
import Distribution.Simple.Program.Db
  ( ProgramDb (..)
  , lookupProgramByName
  , modifyProgramSearchPath
  , prependProgramSearchPath
  , updateConfiguredProgs
  )
import Distribution.Simple.Setup.Common as Setup
import Distribution.Simple.Setup.Config as Setup
import Distribution.Simple.SetupHooks.Internal
  ( ConfigureHooks (..)
  , applyComponentDiffs
  , noConfigureHooks
  )
import qualified Distribution.Simple.SetupHooks.Internal as SetupHooks
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.GivenComponent
import qualified Distribution.Types.LocalBuildConfig as LBC
import Distribution.Types.LocalBuildInfo
import Distribution.Types.PackageVersionConstraint
import Distribution.Utils.LogProgress
import Distribution.Utils.NubList
import Distribution.Verbosity
import Distribution.Version

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

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

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
  = -- | No header found.
    ConfigStateFileNoHeader
  | -- | Incorrect header.
    ConfigStateFileBadHeader
  | -- | Cannot parse file contents.
    ConfigStateFileNoParse
  | -- | No file!
    ConfigStateFileMissing
      { ConfigStateFileError -> Maybe (SymbolicPath CWD ('Dir Pkg))
cfgStateFileErrorCwd :: Maybe (SymbolicPath CWD (Dir Pkg))
      , ConfigStateFileError -> SymbolicPath Pkg 'File
cfgStateFileErrorFile :: SymbolicPath Pkg File
      }
  | -- | Mismatched version.
    ConfigStateFileBadVersion
      PackageIdentifier
      PackageIdentifier
      (Either ConfigStateFileError LocalBuildInfo)
  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 'Setup 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 'Setup 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 'Setup configure' command."
dispConfigStateFileError ConfigStateFileMissing{} =
  ProgArg -> Doc
text ProgArg
"Run the 'Setup 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 'Setup configure' command."
  where
    badCabal :: Doc
badCabal =
      ProgArg -> Doc
text ProgArg
"• the Cabal version changed from"
        Doc -> Doc -> Doc
<+> PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty PackageIdentifier
oldCabal
        Doc -> Doc -> Doc
<+> Doc
"to"
        Doc -> Doc -> Doc
<+> PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty PackageIdentifier
currentCabalId
    badCompiler :: Doc
badCompiler
      | PackageIdentifier
oldCompiler PackageIdentifier -> PackageIdentifier -> Bool
forall a. Eq a => a -> a -> Bool
== PackageIdentifier
currentCompilerId = Doc
forall a. Monoid a => a
mempty
      | Bool
otherwise =
          ProgArg -> Doc
text ProgArg
"• the compiler changed from"
            Doc -> Doc -> Doc
<+> PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty PackageIdentifier
oldCompiler
            Doc -> Doc -> Doc
<+> Doc
"to"
            Doc -> Doc -> Doc
<+> PackageIdentifier -> Doc
forall a. Pretty a => a -> Doc
pretty PackageIdentifier
currentCompilerId

instance Show ConfigStateFileError where
  show :: ConfigStateFileError -> ProgArg
show = Style -> Doc -> ProgArg
renderStyle Style
defaultStyle (Doc -> ProgArg)
-> (ConfigStateFileError -> Doc) -> ConfigStateFileError -> ProgArg
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
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg File
  -- ^ The file path of the @setup-config@ file.
  -> IO LocalBuildInfo
getConfigStateFile :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> IO LocalBuildInfo
getConfigStateFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
setupConfigFile = do
  let filename :: ProgArg
filename = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> ProgArg
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> ProgArg
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg 'File
setupConfigFile
  exists <- ProgArg -> IO Bool
doesFileExist ProgArg
filename
  unless exists $ throwIO $ ConfigStateFileMissing mbWorkDir setupConfigFile
  -- 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.
  contents <- BS.readFile filename
  let (header, body) = BLC8.span (/= '\n') (BLC8.fromChunks [contents])

  (cabalId, compId) <- parseHeader header

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

-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
tryGetConfigStateFile
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Working directory.
  -> SymbolicPath Pkg File
  -- ^ The file path of the @setup-config@ file.
  -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = IO LocalBuildInfo
-> IO (Either ConfigStateFileError LocalBuildInfo)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO LocalBuildInfo
 -> IO (Either ConfigStateFileError LocalBuildInfo))
-> (SymbolicPath Pkg 'File -> IO LocalBuildInfo)
-> SymbolicPath Pkg 'File
-> IO (Either ConfigStateFileError LocalBuildInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> IO LocalBuildInfo
getConfigStateFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir

-- | Try to read the 'localBuildInfoFile'.
tryGetPersistBuildConfig
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Working directory.
  -> SymbolicPath Pkg (Dir Dist)
  -- ^ The @dist@ directory path.
  -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = IO LocalBuildInfo
-> IO (Either ConfigStateFileError LocalBuildInfo)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO LocalBuildInfo
 -> IO (Either ConfigStateFileError LocalBuildInfo))
-> (SymbolicPath Pkg ('Dir Dist) -> IO LocalBuildInfo)
-> SymbolicPath Pkg ('Dir Dist)
-> IO (Either ConfigStateFileError LocalBuildInfo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> IO LocalBuildInfo
getPersistBuildConfig Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir

-- | 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
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Working directory.
  -> SymbolicPath Pkg (Dir Dist)
  -- ^ The @dist@ directory path.
  -> IO LocalBuildInfo
getPersistBuildConfig :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> IO LocalBuildInfo
getPersistBuildConfig Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
distPref =
  Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg 'File -> IO LocalBuildInfo
getConfigStateFile Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir (SymbolicPath Pkg 'File -> IO LocalBuildInfo)
-> SymbolicPath Pkg 'File -> IO LocalBuildInfo
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg 'File
localBuildInfoFile SymbolicPath Pkg ('Dir Dist)
distPref

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

-- | After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
writePersistBuildConfig
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -- ^ Working directory
  -> SymbolicPath Pkg (Dir Dist)
  -- ^ The @dist@ directory path.
  -> LocalBuildInfo
  -- ^ The 'LocalBuildInfo' to write.
  -> IO ()
writePersistBuildConfig :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist) -> LocalBuildInfo -> IO ()
writePersistBuildConfig Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
distPref LocalBuildInfo
lbi = do
  Bool -> ProgArg -> IO ()
createDirectoryIfMissing Bool
False (SymbolicPath Pkg ('Dir Dist) -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i SymbolicPath Pkg ('Dir Dist)
distPref)
  ProgArg -> ByteString -> IO ()
writeFileAtomic (SymbolicPath Pkg 'File -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i (SymbolicPath Pkg 'File -> ProgArg)
-> SymbolicPath Pkg 'File -> ProgArg
forall a b. (a -> b) -> a -> b
$ SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg 'File
localBuildInfoFile SymbolicPath Pkg ('Dir Dist)
distPref) (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ByteString] -> ByteString
BLC8.unlines [PackageIdentifier -> ByteString
showHeader PackageIdentifier
pkgId, LocalBuildInfo -> ByteString
forall a. (Binary a, Structured a) => a -> ByteString
structuredEncode LocalBuildInfo
lbi]
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> ProgArg
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> ProgArg
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> ProgArg
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path
    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
    ] ->
      IO (PackageIdentifier, PackageIdentifier)
-> ((PackageIdentifier, PackageIdentifier)
    -> IO (PackageIdentifier, PackageIdentifier))
-> Maybe (PackageIdentifier, PackageIdentifier)
-> IO (PackageIdentifier, PackageIdentifier)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ConfigStateFileError -> IO (PackageIdentifier, PackageIdentifier)
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO ConfigStateFileError
ConfigStateFileBadHeader) (PackageIdentifier, PackageIdentifier)
-> IO (PackageIdentifier, PackageIdentifier)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (PackageIdentifier, PackageIdentifier)
 -> IO (PackageIdentifier, PackageIdentifier))
-> Maybe (PackageIdentifier, PackageIdentifier)
-> IO (PackageIdentifier, PackageIdentifier)
forall a b. (a -> b) -> a -> b
$ do
        _ <- ProgArg -> Maybe PackageIdentifier
forall a. Parsec a => ProgArg -> Maybe a
simpleParsec (ByteString -> ProgArg
fromUTF8LBS ByteString
pkgId) :: Maybe PackageIdentifier
        cabalId' <- simpleParsec (BLC8.unpack cabalId)
        compId' <- simpleParsec (BLC8.unpack compId)
        return (cabalId', compId')
  [ByteString]
_ -> ConfigStateFileError -> IO (PackageIdentifier, PackageIdentifier)
forall e a. (HasCallStack, 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 (ProgArg -> ByteString) -> ProgArg -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
pkgId
    , ByteString
"written"
    , ByteString
"by"
    , ProgArg -> ByteString
BLC8.pack (ProgArg -> ByteString) -> ProgArg -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCabalId
    , ByteString
"using"
    , ProgArg -> ByteString
BLC8.pack (ProgArg -> ByteString) -> ProgArg -> ByteString
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow PackageIdentifier
currentCompilerId
    ]

-- | Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
checkPersistBuildConfigOutdated
  :: Maybe (SymbolicPath CWD (Dir Pkg))
  -> SymbolicPath Pkg (Dir Dist)
  -> SymbolicPath Pkg File
  -> IO Bool
checkPersistBuildConfigOutdated :: Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir Dist)
-> SymbolicPath Pkg 'File
-> IO Bool
checkPersistBuildConfigOutdated Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir Dist)
distPref SymbolicPath Pkg 'File
pkg_descr_file =
  SymbolicPath Pkg 'File -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i SymbolicPath Pkg 'File
pkg_descr_file ProgArg -> ProgArg -> IO Bool
`moreRecentFile` SymbolicPath Pkg 'File -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i (SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg 'File
localBuildInfoFile SymbolicPath Pkg ('Dir Dist)
distPref)
  where
    i :: SymbolicPathX allowAbsolute Pkg to -> ProgArg
i = Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPathX allowAbsolute Pkg to -> ProgArg
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> ProgArg
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir -- See Note [Symbolic paths] in Distribution.Utils.Path

-- | Get the path of @dist\/setup-config@.
localBuildInfoFile
  :: SymbolicPath Pkg (Dir Dist)
  -- ^ The @dist@ directory path.
  -> SymbolicPath Pkg File
localBuildInfoFile :: SymbolicPath Pkg ('Dir Dist) -> SymbolicPath Pkg 'File
localBuildInfoFile SymbolicPath Pkg ('Dir Dist)
distPref = SymbolicPath Pkg ('Dir Dist)
distPref SymbolicPath Pkg ('Dir Dist)
-> RelativePath Dist 'File -> SymbolicPath Pkg 'File
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg -> RelativePath Dist 'File
forall from (to :: FileOrDir).
HasCallStack =>
ProgArg -> RelativePath from to
makeRelativePathEx 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
  :: SymbolicPath Pkg (Dir Dist)
  -- ^ default \"dist\" prefix
  -> Setup.Flag (SymbolicPath Pkg (Dir Dist))
  -- ^ override \"dist\" prefix
  -> IO (SymbolicPath Pkg (Dir Dist))
findDistPref :: SymbolicPath Pkg ('Dir Dist)
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> IO (SymbolicPath Pkg ('Dir Dist))
findDistPref SymbolicPath Pkg ('Dir Dist)
defDistPref Flag (SymbolicPath Pkg ('Dir Dist))
overrideDistPref = do
  envDistPref <- (Maybe ProgArg -> Flag (SymbolicPath Pkg ('Dir Dist)))
-> IO (Maybe ProgArg) -> IO (Flag (SymbolicPath Pkg ('Dir Dist)))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Maybe ProgArg -> Flag (SymbolicPath Pkg ('Dir Dist))
forall {from} {to :: FileOrDir}.
Maybe ProgArg -> Flag (SymbolicPath from to)
parseEnvDistPref (ProgArg -> IO (Maybe ProgArg)
lookupEnv ProgArg
"CABAL_BUILDDIR")
  return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)
  where
    parseEnvDistPref :: Maybe ProgArg -> Flag (SymbolicPath from to)
parseEnvDistPref Maybe ProgArg
env =
      case Maybe ProgArg
env of
        Just ProgArg
distPref | Bool -> Bool
not (ProgArg -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ProgArg
distPref) -> SymbolicPath from to -> Flag (SymbolicPath from to)
forall a. a -> Flag a
toFlag (SymbolicPath from to -> Flag (SymbolicPath from to))
-> SymbolicPath from to -> Flag (SymbolicPath from to)
forall a b. (a -> b) -> a -> b
$ ProgArg -> SymbolicPath from to
forall from (to :: FileOrDir). ProgArg -> SymbolicPath from to
makeSymbolicPath ProgArg
distPref
        Maybe ProgArg
_ -> Flag (SymbolicPath from to)
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 (SymbolicPath Pkg (Dir Dist))
  -- ^ override \"dist\" prefix
  -> IO (SymbolicPath Pkg (Dir Dist))
findDistPrefOrDefault :: Flag (SymbolicPath Pkg ('Dir Dist))
-> IO (SymbolicPath Pkg ('Dir Dist))
findDistPrefOrDefault = SymbolicPath Pkg ('Dir Dist)
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> IO (SymbolicPath Pkg ('Dir Dist))
findDistPref SymbolicPath Pkg ('Dir Dist)
defaultDistPref

-- | Perform the \"@.\/setup configure@\" action.
--  Returns the @.setup-config@ file.
configure
  :: (GenericPackageDescription, HookedBuildInfo)
  -> ConfigFlags
  -> IO LocalBuildInfo
configure :: (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags -> IO LocalBuildInfo
configure = ConfigureHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
configure_setupHooks ConfigureHooks
noConfigureHooks

configure_setupHooks
  :: ConfigureHooks
  -> (GenericPackageDescription, HookedBuildInfo)
  -> ConfigFlags
  -> IO LocalBuildInfo
configure_setupHooks :: ConfigureHooks
-> (GenericPackageDescription, HookedBuildInfo)
-> ConfigFlags
-> IO LocalBuildInfo
configure_setupHooks
  (ConfigureHooks{Maybe PreConfPackageHook
preConfPackageHook :: Maybe PreConfPackageHook
preConfPackageHook :: ConfigureHooks -> Maybe PreConfPackageHook
preConfPackageHook, Maybe PostConfPackageHook
postConfPackageHook :: Maybe PostConfPackageHook
postConfPackageHook :: ConfigureHooks -> Maybe PostConfPackageHook
postConfPackageHook, Maybe PreConfComponentHook
preConfComponentHook :: Maybe PreConfComponentHook
preConfComponentHook :: ConfigureHooks -> Maybe PreConfComponentHook
preConfComponentHook})
  (GenericPackageDescription
g_pkg_descr, HookedBuildInfo
hookedBuildInfo)
  ConfigFlags
cfg = do
    -- Cabal pre-configure
    let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
cfg)
        distPref :: SymbolicPath Pkg ('Dir Dist)
distPref = Flag (SymbolicPath Pkg ('Dir Dist)) -> SymbolicPath Pkg ('Dir Dist)
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag (SymbolicPath Pkg ('Dir Dist))
 -> SymbolicPath Pkg ('Dir Dist))
-> Flag (SymbolicPath Pkg ('Dir Dist))
-> SymbolicPath Pkg ('Dir Dist)
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag (SymbolicPath Pkg ('Dir Dist))
configDistPref ConfigFlags
cfg
        mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
configWorkingDir ConfigFlags
cfg
    (lbc0, comp, platform, enabledComps) <- ConfigFlags
-> GenericPackageDescription
-> IO
     (LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec)
preConfigurePackage ConfigFlags
cfg GenericPackageDescription
g_pkg_descr

    -- Package-wide pre-configure hook
    lbc1 <-
      case preConfPackageHook of
        Maybe PreConfPackageHook
Nothing -> LocalBuildConfig -> IO LocalBuildConfig
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return LocalBuildConfig
lbc0
        Just PreConfPackageHook
pre_conf -> do
          let programDb0 :: ProgramDb
programDb0 = LocalBuildConfig -> ProgramDb
LBC.withPrograms LocalBuildConfig
lbc0
              programDb0' :: ProgramDb
programDb0' = ProgramDb
programDb0{unconfiguredProgs = Map.empty}
              input :: PreConfPackageInputs
input =
                SetupHooks.PreConfPackageInputs
                  { configFlags :: ConfigFlags
SetupHooks.configFlags = ConfigFlags
cfg
                  , localBuildConfig :: LocalBuildConfig
SetupHooks.localBuildConfig = LocalBuildConfig
lbc0{LBC.withPrograms = programDb0'}
                  , -- Unconfigured programs are not supplied to the hook,
                    -- as these cannot be passed over a serialisation boundary
                    -- (see the "Binary ProgramDb" instance).
                    compiler :: Compiler
SetupHooks.compiler = Compiler
comp
                  , platform :: Platform
SetupHooks.platform = Platform
platform
                  }
          SetupHooks.PreConfPackageOutputs
            { SetupHooks.buildOptions = opts1
            , SetupHooks.extraConfiguredProgs = progs1
            } <-
            PreConfPackageHook
pre_conf PreConfPackageInputs
input
          -- The package-wide pre-configure hook returns BuildOptions that
          -- overrides the one it was passed in, as well as an update to
          -- the ProgramDb in the form of new configured programs to add
          -- to the program database.
          return $
            lbc0
              { LBC.withBuildOptions = opts1
              , LBC.withPrograms =
                  updateConfiguredProgs
                    (`Map.union` progs1)
                    programDb0
              }

    -- Cabal package-wide configure
    (lbc2, pbd2, pkg_info) <-
      finalizeAndConfigurePackage cfg lbc1 g_pkg_descr comp platform enabledComps

    -- Package-wide post-configure hook
    for_ postConfPackageHook $ \PostConfPackageHook
postConfPkg -> do
      let input :: PostConfPackageInputs
input =
            SetupHooks.PostConfPackageInputs
              { localBuildConfig :: LocalBuildConfig
SetupHooks.localBuildConfig = LocalBuildConfig
lbc2
              , packageBuildDescr :: PackageBuildDescr
SetupHooks.packageBuildDescr = PackageBuildDescr
pbd2
              }
      PostConfPackageHook
postConfPkg PostConfPackageInputs
input

    -- Per-component pre-configure hook
    pkg_descr <- do
      let pkg_descr2 = PackageBuildDescr -> PackageDescription
LBC.localPkgDescr PackageBuildDescr
pbd2
      applyComponentDiffs
        verbosity
        ( \Component
c -> Maybe PreConfComponentHook
-> (PreConfComponentHook -> IO ComponentDiff)
-> IO (Maybe ComponentDiff)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for Maybe PreConfComponentHook
preConfComponentHook ((PreConfComponentHook -> IO ComponentDiff)
 -> IO (Maybe ComponentDiff))
-> (PreConfComponentHook -> IO ComponentDiff)
-> IO (Maybe ComponentDiff)
forall a b. (a -> b) -> a -> b
$ \PreConfComponentHook
computeDiff -> do
            let input :: PreConfComponentInputs
input =
                  SetupHooks.PreConfComponentInputs
                    { localBuildConfig :: LocalBuildConfig
SetupHooks.localBuildConfig = LocalBuildConfig
lbc2
                    , packageBuildDescr :: PackageBuildDescr
SetupHooks.packageBuildDescr = PackageBuildDescr
pbd2
                    , component :: Component
SetupHooks.component = Component
c
                    }
            SetupHooks.PreConfComponentOutputs
              { SetupHooks.componentDiff = diff
              } <-
              PreConfComponentHook
computeDiff PreConfComponentInputs
input
            return diff
        )
        pkg_descr2
    let pbd3 = PackageBuildDescr
pbd2{LBC.localPkgDescr = pkg_descr}

    -- Cabal per-component configure
    externalPkgDeps <- finalCheckPackage g_pkg_descr pbd3 hookedBuildInfo pkg_info
    lbi <- configureComponents lbc2 pbd3 pkg_info externalPkgDeps

    writePersistBuildConfig mbWorkDir distPref lbi

    return lbi

preConfigurePackage
  :: ConfigFlags
  -> GenericPackageDescription
  -> IO (LBC.LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec)
preConfigurePackage :: ConfigFlags
-> GenericPackageDescription
-> IO
     (LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec)
preConfigurePackage ConfigFlags
cfg GenericPackageDescription
g_pkg_descr = do
  let verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
cfg

  -- 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).
  (mb_cname :: Maybe ComponentName) <- do
    let flat_pkg_descr :: PackageDescription
flat_pkg_descr = GenericPackageDescription -> PackageDescription
flattenPackageDescription GenericPackageDescription
g_pkg_descr
        targets0 :: [ProgArg]
targets0 = ConfigFlags -> [ProgArg]
configTargets ConfigFlags
cfg
    targets <- Verbosity -> PackageDescription -> [ProgArg] -> IO [BuildTarget]
readBuildTargets Verbosity
verbosity PackageDescription
flat_pkg_descr [ProgArg]
targets0
    -- TODO: bleat if you use the module/file syntax
    let targets' = [ComponentName
cname | BuildTargetComponent ComponentName
cname <- [BuildTarget]
targets]
    case targets' of
      [ComponentName]
_ | [ProgArg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProgArg]
targets0 -> Maybe ComponentName -> IO (Maybe ComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ComponentName
forall a. Maybe a
Nothing
      [ComponentName
cname] -> Maybe ComponentName -> IO (Maybe ComponentName)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ComponentName -> Maybe ComponentName
forall a. a -> Maybe a
Just ComponentName
cname)
      [] -> Verbosity -> CabalException -> IO (Maybe ComponentName)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
NoValidComponent
      [ComponentName]
_ -> Verbosity -> CabalException -> IO (Maybe ComponentName)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
ConfigureEitherSingleOrAll

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

  -- configCID is only valid for per-component configure
  when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
    dieWithException verbosity ConfigCIDValidForPreComponent

  -- Make a data structure describing what components are enabled.
  let 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 = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configTests ConfigFlags
cfg)
            , benchmarksRequested :: Bool
benchmarksRequested =
                Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configBenchmarks ConfigFlags
cfg)
            }
  -- Some sanity checks related to enabling components.
  when
    ( isJust mb_cname
        && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))
    )
    $ dieWithException verbosity SanityCheckForEnableComponents

  checkDeprecatedFlags verbosity cfg
  checkExactConfiguration verbosity g_pkg_descr cfg

  programDbPre <- mkProgramDb cfg (configPrograms 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
  ( comp :: Compiler
    , compPlatform :: Platform
    , programDb00 :: ProgramDb
    ) <-
    configCompilerEx
      (flagToMaybe (configHcFlavor cfg))
      (flagToMaybe (configHcPath cfg))
      (flagToMaybe (configHcPkg cfg))
      programDbPre
      (lessVerbose verbosity)

  -- Where to build the package
  let builddir :: SymbolicPath Pkg (Dir Build) -- e.g. dist/build
      builddir = CommonSetupFlags -> SymbolicPath Pkg ('Dir Build)
setupFlagsBuildDir (CommonSetupFlags -> SymbolicPath Pkg ('Dir Build))
-> CommonSetupFlags -> SymbolicPath Pkg ('Dir Build)
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
      mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
configWorkingDir ConfigFlags
cfg
  -- NB: create this directory now so that all configure hooks get
  -- to see it. (In practice, the Configure build-type needs it before
  -- the postConfPackageHook runs.)
  createDirectoryIfMissingVerbose (lessVerbose verbosity) True $
    interpretSymbolicPath mbWorkDir builddir

  lbc <- computeLocalBuildConfig cfg comp programDb00
  return (lbc, comp, compPlatform, enabled)

computeLocalBuildConfig
  :: ConfigFlags
  -> Compiler
  -> ProgramDb
  -> IO LBC.LocalBuildConfig
computeLocalBuildConfig :: ConfigFlags -> Compiler -> ProgramDb -> IO LocalBuildConfig
computeLocalBuildConfig ConfigFlags
cfg Compiler
comp ProgramDb
programDb = do
  let common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
  -- Decide if we're going to compile with split sections.
  split_sections :: Bool <-
    if Bool -> Bool
not (Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configSplitSections ConfigFlags
cfg)
      then Bool -> IO Bool
forall a. a -> IO a
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 Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
8, Int
0] ->
              Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        CompilerFlavor
GHCJS ->
          Bool -> IO Bool
forall a. a -> IO a
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 "
                ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"--enable-split-sections; ignoring"
            )
          Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

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

  -- Basically yes/no/unknown.
  let linkerSupportsRelocations :: Maybe Bool
      linkerSupportsRelocations =
        case ProgArg -> ProgramDb -> Maybe ConfiguredProgram
lookupProgramByName ProgArg
"ld" ProgramDb
programDb of
          Maybe ConfiguredProgram
Nothing -> Maybe Bool
forall a. Maybe a
Nothing
          Just ConfiguredProgram
ld ->
            case ProgArg -> Map ProgArg ProgArg -> Maybe ProgArg
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ProgArg
"Supports relocatable output" (Map ProgArg ProgArg -> Maybe ProgArg)
-> Map ProgArg ProgArg -> Maybe ProgArg
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Map ProgArg ProgArg
programProperties ConfiguredProgram
ld of
              Just ProgArg
"YES" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
              Just ProgArg
"NO" -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
              Maybe ProgArg
_other -> Maybe Bool
forall a. Maybe a
Nothing
  let 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 -> BuildWay
GHC.compilerBuildWay Compiler
comp BuildWay -> [BuildWay] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [BuildWay
DynWay, BuildWay
ProfDynWay])
          CompilerId CompilerFlavor
GHCJS Version
_ ->
            Bool -> Bool
not (Compiler -> Bool
GHCJS.isDynamic Compiler
comp)
          CompilerId
_ -> Bool
False

  withGHCiLib_ <-
    case fromFlagOrDefault ghciLibByDefault (configGHCiLib cfg) of
      -- NOTE: If linkerSupportsRelocations is Nothing this may still fail if the
      -- linker does not support -r.
      Bool
True | Bool -> Bool
not (Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
linkerSupportsRelocations) -> do
        Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$
          ProgArg
"--enable-library-for-ghci is not supported with the current"
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"  linker; ignoring..."
        Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Bool
v -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
v

  let sharedLibsByDefault
        | Flag Bool -> Bool
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 -> BuildWay
GHC.compilerBuildWay Compiler
comp BuildWay -> BuildWay -> Bool
forall a. Eq a => a -> a -> Bool
== BuildWay
DynWay
            CompilerId CompilerFlavor
GHCJS Version
_ ->
              Compiler -> Bool
GHCJS.isDynamic Compiler
comp
            CompilerId
_ -> Bool
False
      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.
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
sharedLibsByDefault (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configSharedLib ConfigFlags
cfg

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

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

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

  setProfiling <- configureProfiling verbosity cfg comp

  setCoverage <- configureCoverage verbosity cfg comp

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

  strip_lib <- strip_libexe "library" configStripLibs
  strip_exe <- strip_libexe "executable" configStripExes

  let buildOptions =
        BuildOptions -> BuildOptions
setCoverage (BuildOptions -> BuildOptions)
-> (BuildOptions -> BuildOptions) -> BuildOptions -> BuildOptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildOptions -> BuildOptions
setProfiling (BuildOptions -> BuildOptions) -> BuildOptions -> BuildOptions
forall a b. (a -> b) -> a -> b
$
          LBC.BuildOptions
            { withVanillaLib :: Bool
withVanillaLib = Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Bool -> Bool) -> Flag Bool -> Bool
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
            , withProfLibShared :: Bool
withProfLibShared = Bool
False
            , withProfLibDetail :: ProfDetailLevel
withProfLibDetail = ProfDetailLevel
ProfDetailNone
            , withProfExe :: Bool
withProfExe = Bool
False
            , withProfExeDetail :: ProfDetailLevel
withProfExeDetail = ProfDetailLevel
ProfDetailNone
            , withOptimization :: OptimisationLevel
withOptimization = Flag OptimisationLevel -> OptimisationLevel
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag OptimisationLevel -> OptimisationLevel)
-> Flag OptimisationLevel -> OptimisationLevel
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag OptimisationLevel
configOptimization ConfigFlags
cfg
            , withDebugInfo :: DebugInfoLevel
withDebugInfo = Flag DebugInfoLevel -> DebugInfoLevel
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag DebugInfoLevel -> DebugInfoLevel)
-> Flag DebugInfoLevel -> DebugInfoLevel
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
            , relocatable :: Bool
relocatable = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configRelocatable ConfigFlags
cfg
            }

  -- Dynamic executable, but no shared vanilla libraries
  when (LBC.withDynExe buildOptions && not (LBC.withProfExe buildOptions) && not (LBC.withSharedLib buildOptions)) $
    warn verbosity $
      "Executables will use dynamic linking, but a shared library "
        ++ "is not being built. Linking will fail if any executables "
        ++ "depend on the library."

  -- Profiled dynamic executable, but no shared profiling libraries
  when (LBC.withDynExe buildOptions && LBC.withProfExe buildOptions && not (LBC.withProfLibShared buildOptions)) $
    warn verbosity $
      "Executables will use profiled dynamic linking, but a profiled shared library "
        ++ "is not being built. Linking will fail if any executables "
        ++ "depend on the library."

  return $
    LBC.LocalBuildConfig
      { extraConfigArgs = [] -- Currently configure does not
      -- take extra args, but if it
      -- did they would go here.
      , withPrograms = programDb
      , withBuildOptions = buildOptions
      }

data PackageInfo = PackageInfo
  { PackageInfo -> Set LibraryName
internalPackageSet :: Set LibraryName
  , PackageInfo -> Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
  , PackageInfo -> InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
  , PackageInfo
-> Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
  }

configurePackage
  :: ConfigFlags
  -> LBC.LocalBuildConfig
  -> PackageDescription
  -> FlagAssignment
  -> ComponentRequestedSpec
  -> Compiler
  -> Platform
  -> ProgramDb
  -> PackageDBStack
  -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr)
configurePackage :: ConfigFlags
-> LocalBuildConfig
-> PackageDescription
-> FlagAssignment
-> ComponentRequestedSpec
-> Compiler
-> Platform
-> ProgramDb
-> PackageDBStack
-> IO (LocalBuildConfig, PackageBuildDescr)
configurePackage ConfigFlags
cfg LocalBuildConfig
lbc0 PackageDescription
pkg_descr00 FlagAssignment
flags ComponentRequestedSpec
enabled Compiler
comp Platform
platform ProgramDb
programDb0 PackageDBStack
packageDbs = do
  let common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common

      -- add extra include/lib dirs as specified in cfg
      pkg_descr0 :: PackageDescription
pkg_descr0 = PackageDescription -> ConfigFlags -> PackageDescription
addExtraIncludeLibDirsFromConfigFlags PackageDescription
pkg_descr00 ConfigFlags
cfg
  -- TODO: it is not clear whether this adding these dirs is necessary
  -- when we are directly stating from a PackageDescription (e.g. when
  -- cabal-install has determined a PackageDescription, instead of rediscovering
  -- when working with a GenericPackageDescription).
  -- Could this function call be moved to the end of finalizeAndConfigurePackage
  -- right before calling configurePackage?

  -- Configure certain external build tools, see below for which ones.
  let requiredBuildTools :: [LegacyExeDependency]
requiredBuildTools
        -- If --ignore-build-tools is set, no build tool is required:
        | Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (Flag Bool -> Bool) -> Flag Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ConfigFlags -> Flag Bool
configIgnoreBuildTools ConfigFlags
cfg =
            []
        | Bool
otherwise = do
            bi <- PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr0 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 =
                  [ 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_descr0 BuildInfo
bi
                  , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ PackageDescription -> ExeDependency -> Bool
isInternal PackageDescription
pkg_descr0 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
buildTool
                  | LegacyExeDependency
buildTool <- BuildInfo -> [LegacyExeDependency]
buildTools BuildInfo
bi
                  , Maybe ExeDependency
forall a. Maybe a
Nothing Maybe ExeDependency -> Maybe ExeDependency -> Bool
forall a. Eq a => a -> a -> Bool
== PackageDescription -> LegacyExeDependency -> Maybe ExeDependency
desugarBuildTool PackageDescription
pkg_descr0 LegacyExeDependency
buildTool
                  ]
            externBuildToolDeps ++ unknownBuildTools

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

  (pkg_descr2, programDb2) <-
    configurePkgconfigPackages verbosity pkg_descr0 programDb1 enabled

  let use_external_internal_deps =
        case ComponentRequestedSpec
enabled of
          OneComponentRequestedSpec{} -> Bool
True
          ComponentRequestedSpec{} -> Bool
False

  -- Compute installation directory templates, based on user
  -- configuration.
  --
  -- TODO: Move this into a helper function.
  defaultDirs :: InstallDirTemplates <-
    defaultInstallDirs'
      use_external_internal_deps
      (compilerFlavor comp)
      (fromFlag (configUserInstall cfg))
      (hasLibs pkg_descr2)
  let
    installDirs =
      (PathTemplate -> Flag PathTemplate -> PathTemplate)
-> InstallDirTemplates
-> InstallDirs (Flag PathTemplate)
-> InstallDirTemplates
forall a b c.
(a -> b -> c) -> InstallDirs a -> InstallDirs b -> InstallDirs c
combineInstallDirs
        PathTemplate -> Flag PathTemplate -> PathTemplate
forall a. a -> Flag a -> a
fromFlagOrDefault
        InstallDirTemplates
defaultDirs
        (ConfigFlags -> InstallDirs (Flag PathTemplate)
configInstallDirs ConfigFlags
cfg)
    lbc = LocalBuildConfig
lbc0{LBC.withPrograms = programDb2}
    pbd =
      LBC.PackageBuildDescr
        { configFlags :: ConfigFlags
configFlags = ConfigFlags
cfg
        , flagAssignment :: FlagAssignment
flagAssignment = FlagAssignment
flags
        , componentEnabledSpec :: ComponentRequestedSpec
componentEnabledSpec = ComponentRequestedSpec
enabled
        , compiler :: Compiler
compiler = Compiler
comp
        , hostPlatform :: Platform
hostPlatform = Platform
platform
        , localPkgDescr :: PackageDescription
localPkgDescr = PackageDescription
pkg_descr2
        , installDirTemplates :: InstallDirTemplates
installDirTemplates = InstallDirTemplates
installDirs
        , withPackageDB :: PackageDBStack
withPackageDB = PackageDBStack
packageDbs
        , pkgDescrFile :: Maybe (SymbolicPath Pkg 'File)
pkgDescrFile = Maybe (SymbolicPath Pkg 'File)
forall a. Maybe a
Nothing
        , extraCoverageFor :: [UnitId]
extraCoverageFor = []
        }

  debug verbosity $
    "Finalized package description:\n"
      ++ showPackageDescription pkg_descr2

  return (lbc, pbd)

finalizeAndConfigurePackage
  :: ConfigFlags
  -> LBC.LocalBuildConfig
  -> GenericPackageDescription
  -> Compiler
  -> Platform
  -> ComponentRequestedSpec
  -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr, PackageInfo)
finalizeAndConfigurePackage :: ConfigFlags
-> LocalBuildConfig
-> GenericPackageDescription
-> Compiler
-> Platform
-> ComponentRequestedSpec
-> IO (LocalBuildConfig, PackageBuildDescr, PackageInfo)
finalizeAndConfigurePackage ConfigFlags
cfg LocalBuildConfig
lbc0 GenericPackageDescription
g_pkg_descr Compiler
comp Platform
platform ComponentRequestedSpec
enabled = do
  let common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
      verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
      mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a. Flag a -> Maybe a
flagToMaybe (Flag (SymbolicPath CWD ('Dir Pkg))
 -> Maybe (SymbolicPath CWD ('Dir Pkg)))
-> Flag (SymbolicPath CWD ('Dir Pkg))
-> Maybe (SymbolicPath CWD ('Dir Pkg))
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag (SymbolicPath CWD ('Dir Pkg))
setupWorkingDir CommonSetupFlags
common

  let programDb0 :: ProgramDb
programDb0 = LocalBuildConfig -> ProgramDb
LBC.withPrograms LocalBuildConfig
lbc0
      -- What package database(s) to use
      packageDbs :: PackageDBStack
      packageDbs :: PackageDBStack
packageDbs =
        Bool
-> [Maybe (PackageDBX (SymbolicPath Pkg ('Dir PkgDB)))]
-> PackageDBStack
forall fp. Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp
interpretPackageDbFlags
          (Flag Bool -> Bool
forall a. WithCallStack (Flag a -> a)
fromFlag (ConfigFlags -> Flag Bool
configUserInstall ConfigFlags
cfg))
          (ConfigFlags -> [Maybe (PackageDBX (SymbolicPath Pkg ('Dir PkgDB)))]
configPackageDBs ConfigFlags
cfg)

  -- The InstalledPackageIndex of all installed packages
  installedPackageSet :: InstalledPackageIndex <-
    Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages
      (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity)
      Compiler
comp
      Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
      PackageDBStack
packageDbs
      ProgramDb
programDb0

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

  -- Some sanity checks related to dynamic/static linking.
  when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $
    dieWithException verbosity SanityCheckForDynamicStaticLinking

  -- 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.
  ( allConstraints :: [PackageVersionConstraint]
    , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
    ) <-
    either (dieWithException verbosity) return $
      combinedConstraints
        (configConstraints cfg)
        (configDependencies cfg)
        installedPackageSet

  let
    promisedDepsSet = [PromisedComponent]
-> Map (PackageName, ComponentName) PromisedComponent
mkPromisedDepsSet (ConfigFlags -> [PromisedComponent]
configPromisedDependencies ConfigFlags
cfg)
    pkg_info =
      PackageInfo
        { Set LibraryName
internalPackageSet :: Set LibraryName
internalPackageSet :: Set LibraryName
internalPackageSet
        , Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet
        , InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
installedPackageSet
        , Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
        }

  -- 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.
  let use_external_internal_deps = case ComponentRequestedSpec
enabled of
        OneComponentRequestedSpec{} -> Bool
True
        ComponentRequestedSpec{} -> Bool
False
  ( pkg_descr0 :: PackageDescription
    , flags :: FlagAssignment
    ) <-
    configureFinalizedPackage
      verbosity
      cfg
      enabled
      allConstraints
      ( dependencySatisfiable
          use_external_internal_deps
          (fromFlagOrDefault False (configExactConfiguration cfg))
          (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg))
          (packageName g_pkg_descr)
          installedPackageSet
          internalPackageSet
          promisedDepsSet
          requiredDepsMap
      )
      comp
      platform
      g_pkg_descr

  (lbc, pbd) <-
    configurePackage
      cfg
      lbc0
      pkg_descr0
      flags
      enabled
      comp
      platform
      programDb0
      packageDbs
  return (lbc, pbd, pkg_info)

addExtraIncludeLibDirsFromConfigFlags
  :: PackageDescription -> ConfigFlags -> PackageDescription
addExtraIncludeLibDirsFromConfigFlags :: PackageDescription -> ConfigFlags -> PackageDescription
addExtraIncludeLibDirsFromConfigFlags PackageDescription
pkg_descr ConfigFlags
cfg =
  let extraBi :: BuildInfo
extraBi =
        BuildInfo
forall a. Monoid a => a
mempty
          { extraLibDirs = configExtraLibDirs cfg
          , extraLibDirsStatic = configExtraLibDirsStatic cfg
          , extraFrameworkDirs = configExtraFrameworkDirs cfg
          , includeDirs = configExtraIncludeDirs cfg
          }
      modifyLib :: Library -> Library
modifyLib Library
l =
        Library
l
          { libBuildInfo =
              libBuildInfo l
                `mappend` extraBi
          }
      modifyExecutable :: Executable -> Executable
modifyExecutable Executable
e =
        Executable
e
          { buildInfo =
              buildInfo e
                `mappend` extraBi
          }
      modifyForeignLib :: ForeignLib -> ForeignLib
modifyForeignLib ForeignLib
f =
        ForeignLib
f
          { foreignLibBuildInfo =
              foreignLibBuildInfo f
                `mappend` extraBi
          }
      modifyTestsuite :: TestSuite -> TestSuite
modifyTestsuite TestSuite
t =
        TestSuite
t
          { testBuildInfo =
              testBuildInfo t
                `mappend` extraBi
          }
      modifyBenchmark :: Benchmark -> Benchmark
modifyBenchmark Benchmark
b =
        Benchmark
b
          { benchmarkBuildInfo =
              benchmarkBuildInfo b
                `mappend` extraBi
          }
   in PackageDescription
pkg_descr
        { library = modifyLib `fmap` library pkg_descr
        , subLibraries = modifyLib `map` subLibraries pkg_descr
        , executables = modifyExecutable `map` executables pkg_descr
        , foreignLibs = modifyForeignLib `map` foreignLibs pkg_descr
        , testSuites = modifyTestsuite `map` testSuites pkg_descr
        , benchmarks = modifyBenchmark `map` benchmarks pkg_descr
        }

finalCheckPackage
  :: GenericPackageDescription
  -> LBC.PackageBuildDescr
  -> HookedBuildInfo
  -> PackageInfo
  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
finalCheckPackage :: GenericPackageDescription
-> PackageBuildDescr
-> HookedBuildInfo
-> PackageInfo
-> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
finalCheckPackage
  GenericPackageDescription
g_pkg_descr
  ( LBC.PackageBuildDescr
      { configFlags :: PackageBuildDescr -> ConfigFlags
configFlags = ConfigFlags
cfg
      , localPkgDescr :: PackageBuildDescr -> PackageDescription
localPkgDescr = PackageDescription
pkg_descr
      , compiler :: PackageBuildDescr -> Compiler
compiler = Compiler
comp
      , hostPlatform :: PackageBuildDescr -> Platform
hostPlatform = Platform
compPlatform
      , componentEnabledSpec :: PackageBuildDescr -> ComponentRequestedSpec
componentEnabledSpec = ComponentRequestedSpec
enabled
      }
    )
  HookedBuildInfo
hookedBuildInfo
  (PackageInfo{Set LibraryName
internalPackageSet :: PackageInfo -> Set LibraryName
internalPackageSet :: Set LibraryName
internalPackageSet, Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: PackageInfo -> Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet, InstalledPackageIndex
installedPackageSet :: PackageInfo -> InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
installedPackageSet, Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: PackageInfo
-> Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap}) =
    do
      let common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
          verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
          cabalFileDir :: ProgArg
cabalFileDir = CommonSetupFlags -> ProgArg
packageRoot CommonSetupFlags
common
          use_external_internal_deps :: Bool
use_external_internal_deps =
            case ComponentRequestedSpec
enabled of
              OneComponentRequestedSpec{} -> Bool
True
              ComponentRequestedSpec{} -> Bool
False

      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
g_pkg_descr
        (HookedBuildInfo -> PackageDescription -> PackageDescription
updatePackageDescription HookedBuildInfo
hookedBuildInfo PackageDescription
pkg_descr)
      -- NB: we apply the HookedBuildInfo to check it is valid,
      -- but we don't propagate it.
      -- Other UserHooks must separately return it again, and we
      -- will re-apply it each time.

      -- Check languages and extensions
      -- TODO: Move this into a helper function.
      let langlist :: [Language]
langlist =
            [Language] -> [Language]
forall a. Eq a => [a] -> [a]
nub ([Language] -> [Language]) -> [Language] -> [Language]
forall a b. (a -> b) -> a -> b
$
              [Maybe Language] -> [Language]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe Language] -> [Language]) -> [Maybe Language] -> [Language]
forall a b. (a -> b) -> a -> b
$
                (BuildInfo -> Maybe Language) -> [BuildInfo] -> [Maybe Language]
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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Language] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Language]
langs)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          PackageIdentifier -> CompilerId -> [ProgArg] -> CabalException
UnsupportedLanguages (GenericPackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
g_pkg_descr) (Compiler -> CompilerId
compilerId Compiler
comp) ((Language -> ProgArg) -> [Language] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
map Language -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow [Language]
langs)
      let extlist :: [Extension]
extlist =
            [Extension] -> [Extension]
forall a. Eq a => [a] -> [a]
nub ([Extension] -> [Extension]) -> [Extension] -> [Extension]
forall a b. (a -> b) -> a -> b
$
              (BuildInfo -> [Extension]) -> [BuildInfo] -> [Extension]
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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([Extension] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Extension]
exts)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          PackageIdentifier -> CompilerId -> [ProgArg] -> CabalException
UnsupportedLanguageExtension (GenericPackageDescription -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId GenericPackageDescription
g_pkg_descr) (Compiler -> CompilerId
compilerId Compiler
comp) ((Extension -> ProgArg) -> [Extension] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
map Extension -> ProgArg
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
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([ProgArg] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [ProgArg]
unsupportedFLibs)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          [ProgArg] -> CabalException
CantFindForeignLibraries [ProgArg]
unsupportedFLibs

      -- 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.)
      Verbosity
-> Bool
-> Set LibraryName
-> Map (PackageName, ComponentName) PromisedComponent
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> PackageDescription
-> ComponentRequestedSpec
-> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
configureDependencies
        Verbosity
verbosity
        Bool
use_external_internal_deps
        Set LibraryName
internalPackageSet
        Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet
        InstalledPackageIndex
installedPackageSet
        Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
        PackageDescription
pkg_descr
        ComponentRequestedSpec
enabled

configureComponents
  :: LBC.LocalBuildConfig
  -> LBC.PackageBuildDescr
  -> PackageInfo
  -> ([PreExistingComponent], [ConfiguredPromisedComponent])
  -> IO LocalBuildInfo
configureComponents :: LocalBuildConfig
-> PackageBuildDescr
-> PackageInfo
-> ([PreExistingComponent], [ConfiguredPromisedComponent])
-> IO LocalBuildInfo
configureComponents
  lbc :: LocalBuildConfig
lbc@(LBC.LocalBuildConfig{withPrograms :: LocalBuildConfig -> ProgramDb
withPrograms = ProgramDb
programDb})
  pbd0 :: PackageBuildDescr
pbd0@( LBC.PackageBuildDescr
          { configFlags :: PackageBuildDescr -> ConfigFlags
configFlags = ConfigFlags
cfg
          , localPkgDescr :: PackageBuildDescr -> PackageDescription
localPkgDescr = PackageDescription
pkg_descr
          , compiler :: PackageBuildDescr -> Compiler
compiler = Compiler
comp
          , componentEnabledSpec :: PackageBuildDescr -> ComponentRequestedSpec
componentEnabledSpec = ComponentRequestedSpec
enabled
          }
        )
  (PackageInfo{Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: PackageInfo -> Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet, InstalledPackageIndex
installedPackageSet :: PackageInfo -> InstalledPackageIndex
installedPackageSet :: InstalledPackageIndex
installedPackageSet})
  ([PreExistingComponent], [ConfiguredPromisedComponent])
externalPkgDeps =
    do
      let common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
          verbosity :: Verbosity
verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
          use_external_internal_deps :: Bool
use_external_internal_deps =
            case ComponentRequestedSpec
enabled of
              OneComponentRequestedSpec{} -> Bool
True
              ComponentRequestedSpec{} -> Bool
False

      -- 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.
      ( buildComponents :: [ComponentLocalBuildInfo]
        , packageDependsIndex :: InstalledPackageIndex
        ) <-
        Verbosity
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
-> IO ([ComponentLocalBuildInfo], InstalledPackageIndex)
forall a. Verbosity -> LogProgress a -> IO a
runLogProgress Verbosity
verbosity (LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
 -> IO ([ComponentLocalBuildInfo], InstalledPackageIndex))
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
-> IO ([ComponentLocalBuildInfo], InstalledPackageIndex)
forall a b. (a -> b) -> a -> b
$
          Verbosity
-> Bool
-> ComponentRequestedSpec
-> Bool
-> Flag ProgArg
-> Flag ComponentId
-> PackageDescription
-> ([PreExistingComponent], [ConfiguredPromisedComponent])
-> FlagAssignment
-> [(ModuleName, Module)]
-> InstalledPackageIndex
-> Compiler
-> LogProgress ([ComponentLocalBuildInfo], InstalledPackageIndex)
configureComponentLocalBuildInfos
            Verbosity
verbosity
            Bool
use_external_internal_deps
            ComponentRequestedSpec
enabled
            (Bool -> Flag Bool -> Bool
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], [ConfiguredPromisedComponent])
externalPkgDeps
            (ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
cfg)
            (ConfigFlags -> [(ModuleName, Module)]
configInstantiateWith ConfigFlags
cfg)
            InstalledPackageIndex
installedPackageSet
            Compiler
comp

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

      let cbd =
            LBC.ComponentBuildDescr
              { componentGraph :: Graph ComponentLocalBuildInfo
componentGraph = [ComponentLocalBuildInfo] -> Graph ComponentLocalBuildInfo
forall a. (IsNode a, Show (Key a)) => [a] -> Graph a
Graph.fromDistinctList [ComponentLocalBuildInfo]
buildComponents
              , componentNameMap :: Map ComponentName [ComponentLocalBuildInfo]
componentNameMap = Map ComponentName [ComponentLocalBuildInfo]
buildComponentsMap
              , promisedPkgs :: Map (PackageName, ComponentName) PromisedComponent
promisedPkgs = Map (PackageName, ComponentName) PromisedComponent
promisedDepsSet
              , installedPkgs :: InstalledPackageIndex
installedPkgs = InstalledPackageIndex
packageDependsIndex
              }

          -- For whole-package configure, we determine the
          -- extraCoverageFor of the main lib and sub libs here.
          extraCoverageUnitIds = case ComponentRequestedSpec
enabled of
            -- Whole package configure, add package libs
            ComponentRequestedSpec{} -> (ComponentLocalBuildInfo -> Maybe UnitId)
-> [ComponentLocalBuildInfo] -> [UnitId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ComponentLocalBuildInfo -> Maybe UnitId
mbCompUnitId [ComponentLocalBuildInfo]
buildComponents
            -- Component configure, no need to do anything since
            -- extra-coverage-for will be passed for all other components that
            -- should be covered.
            OneComponentRequestedSpec{} -> []
          mbCompUnitId LibComponentLocalBuildInfo{UnitId
componentUnitId :: UnitId
componentUnitId :: ComponentLocalBuildInfo -> UnitId
componentUnitId} = UnitId -> Maybe UnitId
forall a. a -> Maybe a
Just UnitId
componentUnitId
          mbCompUnitId ComponentLocalBuildInfo
_ = Maybe UnitId
forall a. Maybe a
Nothing

          pbd =
            PackageBuildDescr
pbd0
              { LBC.extraCoverageFor = extraCoverageUnitIds
              }

          lbd =
            LBC.LocalBuildDescr
              { packageBuildDescr :: PackageBuildDescr
packageBuildDescr = PackageBuildDescr
pbd
              , componentBuildDescr :: ComponentBuildDescr
componentBuildDescr = ComponentBuildDescr
cbd
              }

          lbi =
            NewLocalBuildInfo
              { localBuildDescr :: LocalBuildDescr
localBuildDescr = LocalBuildDescr
lbd
              , localBuildConfig :: LocalBuildConfig
localBuildConfig = LocalBuildConfig
lbc
              }

      when (LBC.relocatable $ LBC.withBuildOptions lbc) $
        checkRelocatable verbosity pkg_descr lbi

      when (LBC.withDynExe $ LBC.withBuildOptions lbc) $
        checkSharedExes verbosity lbi

      -- TODO: This is not entirely correct, because the dirs may vary
      -- across libraries/executables
      let dirs = PackageDescription
-> LocalBuildInfo -> CopyDest -> InstallDirs ProgArg
absoluteInstallDirs PackageDescription
pkg_descr LocalBuildInfo
lbi CopyDest
NoCopyDest
          relative = PackageIdentifier -> LocalBuildInfo -> InstallDirs (Maybe ProgArg)
prefixRelativeInstallDirs (PackageDescription -> PackageIdentifier
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
      unless
        ( isAbsolute (prefix dirs)
            || "${pkgroot}" `isPrefixOf` prefix dirs
        )
        $ dieWithException verbosity
        $ ExpectedAbsoluteDirectory (prefix dirs)

      when ("${pkgroot}" `isPrefixOf` prefix dirs) $
        warn verbosity $
          "Using ${pkgroot} in prefix "
            ++ prefix dirs
            ++ " will not work if you rely on the Path_* module "
            ++ " or other hard coded paths.  Cabal does not yet "
            ++ " support fully relocatable builds! "
            ++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909"
            ++ " #4097 #4291 #4872"

      info verbosity $
        "Using "
          ++ prettyShow currentCabalId
          ++ " compiled by "
          ++ prettyShow currentCompilerId
      info verbosity $ "Using compiler: " ++ showCompilerId comp
      info verbosity $ "Using install prefix: " ++ prefix dirs

      let dirinfo ProgArg
name ProgArg
dir Maybe a
isPrefixRelative =
            Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgArg
name ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
" installed in: " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
dir ProgArg -> ShowS
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
&& Maybe a -> Bool
forall a. Maybe a -> Bool
isNothing Maybe a
isPrefixRelative ->
                      ProgArg
"  (fixed location)"
                OS
_ -> ProgArg
""

      dirinfo "Executables" (bindir dirs) (bindir relative)
      dirinfo "Libraries" (libdir dirs) (libdir relative)
      dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative)
      dirinfo "Private executables" (libexecdir dirs) (libexecdir relative)
      dirinfo "Data files" (datadir dirs) (datadir relative)
      dirinfo "Documentation" (docdir dirs) (docdir relative)
      dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative)

      sequence_
        [ reportProgram verbosity prog configuredProg
        | (prog, configuredProg) <- knownPrograms programDb
        ]

      return lbi

mkPromisedDepsSet :: [PromisedComponent] -> Map (PackageName, ComponentName) PromisedComponent
mkPromisedDepsSet :: [PromisedComponent]
-> Map (PackageName, ComponentName) PromisedComponent
mkPromisedDepsSet [PromisedComponent]
comps = [((PackageName, ComponentName), PromisedComponent)]
-> Map (PackageName, ComponentName) PromisedComponent
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [((PackageIdentifier -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName PackageIdentifier
pn, LibraryName -> ComponentName
CLibName LibraryName
ln), PromisedComponent
p) | p :: PromisedComponent
p@(PromisedComponent PackageIdentifier
pn LibraryName
ln ComponentId
_) <- [PromisedComponent]
comps]

-- | Adds the extra program paths from the flags provided to @configure@ as
-- well as specified locations for certain known programs and their default
-- arguments.
mkProgramDb :: ConfigFlags -> ProgramDb -> IO ProgramDb
mkProgramDb :: ConfigFlags -> ProgramDb -> IO ProgramDb
mkProgramDb ConfigFlags
cfg ProgramDb
initialProgramDb = do
  programDb <-
    (ProgramSearchPath -> ProgramSearchPath) -> ProgramDb -> ProgramDb
modifyProgramSearchPath (ProgramDb -> ProgramSearchPath
getProgramSearchPath ProgramDb
initialProgramDb ProgramSearchPath -> ProgramSearchPath -> ProgramSearchPath
forall a. [a] -> [a] -> [a]
++) -- We need to have the paths to programs installed by build-tool-depends before all other paths
      (ProgramDb -> ProgramDb) -> IO ProgramDb -> IO ProgramDb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Verbosity
-> [ProgArg]
-> [(ProgArg, Maybe ProgArg)]
-> ProgramDb
-> IO ProgramDb
prependProgramSearchPath (Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
cfg)) [ProgArg]
searchpath [] ProgramDb
initialProgramDb
  pure
    . userSpecifyArgss (configProgramArgs cfg)
    . userSpecifyPaths (configProgramPaths cfg)
    $ programDb
  where
    searchpath :: [ProgArg]
searchpath = NubList ProgArg -> [ProgArg]
forall a. NubList a -> [a]
fromNubList (ConfigFlags -> NubList ProgArg
configProgramPathExtra ConfigFlags
cfg)

-- Note. We try as much as possible to _prepend_ rather than postpend the extra-prog-path
-- so that we can override the system path. However, in a v2-build, at this point, the "system" path
-- has already been extended by both the built-tools-depends paths, as well as the program-path-extra
-- so for v2 builds adding it again is entirely unnecessary. However, it needs to get added again _anyway_
-- so as to take effect for v1 builds or standalone calls to Setup.hs
-- In this instance, the lesser evil is to not allow it to override the system path.

-- -----------------------------------------------------------------------------
-- 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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
cfg Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Flag Bool
forall a. Flag a
NoFlag) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let enable :: ProgArg
enable
          | Flag Bool -> Bool
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 --"
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
enable
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"-executable-profiling is deprecated. "
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"Please use --"
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
enable
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"-profiling instead."
      )

  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ConfigFlags -> Flag Bool
configLibCoverage ConfigFlags
cfg Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Flag Bool
forall a. Flag a
NoFlag) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let enable :: ProgArg
enable
          | Flag Bool -> Bool
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 --"
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
enable
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"-library-coverage is deprecated. "
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"Please use --"
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
enable
          ProgArg -> ShowS
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 =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configExactConfiguration ConfigFlags
cfg)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    let cmdlineFlags :: [FlagName]
cmdlineFlags = ((FlagName, Bool) -> FlagName) -> [(FlagName, Bool)] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map (FlagName, Bool) -> FlagName
forall a b. (a, b) -> a
fst (FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment (ConfigFlags -> FlagAssignment
configConfigurationsFlags ConfigFlags
cfg))
        allFlags :: [FlagName]
allFlags = (PackageFlag -> FlagName) -> [PackageFlag] -> [FlagName]
forall a b. (a -> b) -> [a] -> [b]
map PackageFlag -> FlagName
flagName ([PackageFlag] -> [FlagName])
-> (GenericPackageDescription -> [PackageFlag])
-> GenericPackageDescription
-> [FlagName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> [PackageFlag]
genPackageFlags (GenericPackageDescription -> [FlagName])
-> GenericPackageDescription -> [FlagName]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkg_descr0
        diffFlags :: [FlagName]
diffFlags = [FlagName]
allFlags [FlagName] -> [FlagName] -> [FlagName]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FlagName]
cmdlineFlags
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> ([FlagName] -> Bool) -> [FlagName] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FlagName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([FlagName] -> Bool) -> [FlagName] -> Bool
forall a b. (a -> b) -> a -> b
$ [FlagName]
diffFlags) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
        [FlagName] -> CabalException
FlagsNotSpecified [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 [LibraryName] -> Set LibraryName
forall a. Ord a => [a] -> Set a
Set.fromList ((Library -> LibraryName) -> [Library] -> [LibraryName]
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) PromisedComponent
  -> Map (PackageName, ComponentName) InstalledPackageInfo
  -- ^ required dependencies
  -> (Dependency -> Bool)
dependencySatisfiable :: Bool
-> Bool
-> Bool
-> PackageName
-> InstalledPackageIndex
-> Set LibraryName
-> Map (PackageName, ComponentName) PromisedComponent
-> 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) PromisedComponent
promisedDeps
  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
          then -- Except for internal deps, when we're NOT per-component mode;
          -- those are just True.
            Bool
internalDepSatisfiable
          else -- Backward compatibility for the old sublibrary syntax

            ( NonEmptySet LibraryName
sublibs NonEmptySet LibraryName -> NonEmptySet LibraryName -> Bool
forall a. Eq a => a -> a -> Bool
== NonEmptySet LibraryName
mainLibSet
                Bool -> Bool -> Bool
&& (PackageName, ComponentName)
-> Map (PackageName, ComponentName) InstalledPackageInfo -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member
                  ( PackageName
pn
                  , LibraryName -> ComponentName
CLibName (LibraryName -> ComponentName) -> LibraryName -> ComponentName
forall a b. (a -> b) -> a -> b
$
                      UnqualComponentName -> LibraryName
LSubLibName (UnqualComponentName -> LibraryName)
-> UnqualComponentName -> LibraryName
forall a b. (a -> b) -> a -> b
$
                        PackageName -> UnqualComponentName
packageNameToUnqualComponentName PackageName
depName
                  )
                  Map (PackageName, ComponentName) InstalledPackageInfo
requiredDepsMap
            )
              Bool -> Bool -> Bool
|| (LibraryName -> Bool) -> NonEmptySet LibraryName -> 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
          then -- 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.
            Bool
internalDepSatisfiableExternally
          else -- If a 'PackageName' is defined by an internal component, the dep is
          -- satisfiable (we're going to build it ourselves)
            Bool
internalDepSatisfiable
    | Bool
otherwise =
        Bool
depSatisfiable
    where
      -- Internal dependency is when dependency is the same as package.
      isInternalDep :: Bool
isInternalDep = PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
depName

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

      internalDepSatisfiable :: Bool
internalDepSatisfiable =
        Set LibraryName -> Set LibraryName -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf (NonEmptySet LibraryName -> Set LibraryName
forall a. NonEmptySet a -> Set a
NES.toSet NonEmptySet LibraryName
sublibs) Set LibraryName
packageLibraries
      internalDepSatisfiableExternally :: Bool
internalDepSatisfiableExternally =
        (LibraryName -> Bool) -> NonEmptySet LibraryName -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\LibraryName
ln -> Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [(Version, [InstalledPackageInfo])] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Version, [InstalledPackageInfo])] -> Bool)
-> [(Version, [InstalledPackageInfo])] -> Bool
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 =
        Bool
-> (InstalledPackageInfo -> Bool)
-> Maybe InstalledPackageInfo
-> Bool
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 LibraryVisibility -> LibraryVisibility -> Bool
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) PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pn
          )
          Maybe InstalledPackageInfo
maybeIPI
          -- Don't check if it's visible, we promise to build it before we need it.
          Bool -> Bool -> Bool
|| Bool
promised
        where
          maybeIPI :: Maybe InstalledPackageInfo
maybeIPI = (PackageName, ComponentName)
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Maybe InstalledPackageInfo
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
          promised :: Bool
promised = Maybe PromisedComponent -> Bool
forall a. Maybe a -> Bool
isJust (Maybe PromisedComponent -> Bool)
-> Maybe PromisedComponent -> Bool
forall a b. (a -> b) -> a -> b
$ (PackageName, ComponentName)
-> Map (PackageName, ComponentName) PromisedComponent
-> Maybe PromisedComponent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
depName, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) PromisedComponent
promisedDeps

-- | Finalize a generic package description.
--
-- The workhorse is 'finalizePD'.
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
    (pkg_descr, 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 -> (PackageDescription, FlagAssignment)
-> IO (PackageDescription, FlagAssignment)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription, FlagAssignment)
r
        Left [Dependency]
missing ->
          Verbosity
-> CabalException -> IO (PackageDescription, FlagAssignment)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO (PackageDescription, FlagAssignment))
-> CabalException -> IO (PackageDescription, FlagAssignment)
forall a b. (a -> b) -> a -> b
$ [Dependency] -> CabalException
EncounteredMissingDependency [Dependency]
missing

    unless (nullFlagAssignment flags) $
      info verbosity $
        "Flags chosen: "
          ++ intercalate
            ", "
            [ unFlagName fn ++ "=" ++ prettyShow value
            | (fn, value) <- unFlagAssignment flags
            ]

    return (pkg_descr, flags)

-- | 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
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless
    ( Compiler -> Bool
renamingPackageFlagsSupported Compiler
comp
        Bool -> Bool -> Bool
|| (BuildInfo -> Bool) -> [BuildInfo] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
          ((Mixin -> Bool) -> [Mixin] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (IncludeRenaming -> Bool
isDefaultIncludeRenaming (IncludeRenaming -> Bool)
-> (Mixin -> IncludeRenaming) -> Mixin -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mixin -> IncludeRenaming
mixinIncludeRenaming) ([Mixin] -> Bool) -> (BuildInfo -> [Mixin]) -> BuildInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [Mixin]
mixins)
          (PackageDescription -> ComponentRequestedSpec -> [BuildInfo]
enabledBuildInfos PackageDescription
pkg_descr ComponentRequestedSpec
enabled)
    )
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
CompilerDoesn'tSupportThinning
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( (Library -> Bool) -> [Library] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleReexport] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleReexport] -> Bool)
-> (Library -> [ModuleReexport]) -> Library -> Bool
forall 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)
    )
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
CompilerDoesn'tSupportReexports
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
    ( (Library -> Bool) -> [Library] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not (Bool -> Bool) -> (Library -> Bool) -> Library -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([ModuleName] -> Bool)
-> (Library -> [ModuleName]) -> Library -> Bool
forall 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)
    )
    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
CompilerDoesn'tSupportBackpack

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

        promisedPkgDeps :: [ConfiguredPromisedComponent]
promisedPkgDeps =
          [ ConfiguredPromisedComponent
fpec
          | (Dependency
_, PromisedDependency ConfiguredPromisedComponent
fpec) <- [ResolvedDependency]
allPkgDeps
          ]

    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
      ( Bool -> Bool
not ([PackageIdentifier] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PackageIdentifier]
internalPkgDeps)
          Bool -> Bool -> Bool
&& Bool -> Bool
not (PackageDescription -> Bool
newPackageDepsBehaviour PackageDescription
pkg_descr)
      )
      (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity
      (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ [PackageIdentifier] -> CabalException
LibraryWithinSamePackage [PackageIdentifier]
internalPkgDeps
    Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies Verbosity
verbosity [FailedDependency]
failedDeps
    Verbosity -> [ResolvedDependency] -> IO ()
reportSelectedDependencies Verbosity
verbosity [ResolvedDependency]
allPkgDeps

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

-- | Select and apply coverage settings for the build based on the
-- 'ConfigFlags' and 'Compiler'.
configureCoverage
  :: Verbosity
  -> ConfigFlags
  -> Compiler
  -> IO (LBC.BuildOptions -> LBC.BuildOptions)
configureCoverage :: Verbosity
-> ConfigFlags -> Compiler -> IO (BuildOptions -> BuildOptions)
configureCoverage Verbosity
verbosity ConfigFlags
cfg Compiler
comp = do
  let tryExeCoverage :: Bool
tryExeCoverage = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configCoverage ConfigFlags
cfg)
      tryLibCoverage :: Bool
tryLibCoverage =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault
          Bool
tryExeCoverage
          (Flag Bool -> Flag Bool -> Flag Bool
forall a. Monoid a => a -> a -> a
mappend (ConfigFlags -> Flag Bool
configCoverage ConfigFlags
cfg) (ConfigFlags -> Flag Bool
configLibCoverage ConfigFlags
cfg))
  -- TODO: Should we also enforce something here on that --coverage-for cannot
  -- include indefinite components or instantiations?
  if Compiler -> Bool
coverageSupported Compiler
comp
    then do
      let apply :: BuildOptions -> BuildOptions
apply BuildOptions
buildOptions =
            BuildOptions
buildOptions
              { LBC.libCoverage = tryLibCoverage
              , LBC.exeCoverage = tryExeCoverage
              }
      (BuildOptions -> BuildOptions) -> IO (BuildOptions -> BuildOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BuildOptions -> BuildOptions
apply
    else do
      let apply :: BuildOptions -> BuildOptions
apply BuildOptions
buildOptions =
            BuildOptions
buildOptions
              { LBC.libCoverage = False
              , LBC.exeCoverage = False
              }
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
tryExeCoverage Bool -> Bool -> Bool
|| Bool
tryLibCoverage) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> ProgArg -> IO ()
warn
          Verbosity
verbosity
          ( ProgArg
"The compiler "
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Compiler -> ProgArg
showCompilerId Compiler
comp
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
" does not support "
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"program coverage. Program coverage has been disabled."
          )
      (BuildOptions -> BuildOptions) -> IO (BuildOptions -> BuildOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BuildOptions -> BuildOptions
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 vanilla-}, Bool {- lib shared -}, Bool {- exe -})
computeEffectiveProfiling :: ConfigFlags -> (Bool, 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 dynamicExe :: Bool
dynamicExe = Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (ConfigFlags -> Flag Bool
configDynExe ConfigFlags
cfg)
      tryExeProfiling :: Bool
tryExeProfiling =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault
          Bool
False
          (Flag Bool -> Flag Bool -> Flag Bool
forall a. Monoid a => a -> a -> a
mappend (ConfigFlags -> Flag Bool
configProf ConfigFlags
cfg) (ConfigFlags -> Flag Bool
configProfExe ConfigFlags
cfg))
      tryLibProfiling :: Bool
tryLibProfiling =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault
          (Bool
tryExeProfiling Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dynamicExe)
          (ConfigFlags -> Flag Bool
configProfLib ConfigFlags
cfg)
      tryLibProfilingShared :: Bool
tryLibProfilingShared =
        Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault
          (Bool
tryExeProfiling Bool -> Bool -> Bool
&& Bool
dynamicExe)
          (ConfigFlags -> Flag Bool
configProfShared ConfigFlags
cfg)
   in (Bool
tryLibProfiling, Bool
tryLibProfilingShared, Bool
tryExeProfiling)

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

      tryExeProfileLevel :: ProfDetailLevel
tryExeProfileLevel =
        ProfDetailLevel -> Flag ProfDetailLevel -> ProfDetailLevel
forall a. a -> Flag a -> a
fromFlagOrDefault
          ProfDetailLevel
ProfDetailDefault
          (ConfigFlags -> Flag ProfDetailLevel
configProfDetail ConfigFlags
cfg)
      tryLibProfileLevel :: ProfDetailLevel
tryLibProfileLevel =
        ProfDetailLevel -> Flag ProfDetailLevel -> ProfDetailLevel
forall a. a -> Flag a -> a
fromFlagOrDefault
          ProfDetailLevel
ProfDetailDefault
          ( Flag ProfDetailLevel
-> Flag ProfDetailLevel -> Flag ProfDetailLevel
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 '"
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
other
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"', using default.\nThe profiling detail levels are: "
              ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg -> [ProgArg] -> ProgArg
forall a. [a] -> [[a]] -> [a]
intercalate
                ProgArg
", "
                [ProgArg
name | (ProgArg
name, [ProgArg]
_, ProfDetailLevel
_) <- [(ProgArg, [ProgArg], ProfDetailLevel)]
knownProfDetailLevels]
          )
        ProfDetailLevel -> IO ProfDetailLevel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProfDetailLevel
ProfDetailDefault
      checkProfileLevel ProfDetailLevel
other = ProfDetailLevel -> IO ProfDetailLevel
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProfDetailLevel
other

  applyProfiling <-
    if Compiler -> Bool
profilingSupported Compiler
comp Bool -> Bool -> Bool
&& (Compiler -> Bool
profilingVanillaSupportedOrUnknown Compiler
comp Bool -> Bool -> Bool
|| Compiler -> Bool
profilingDynamicSupportedOrUnknown Compiler
comp)
      then do
        exeLevel <- ProfDetailLevel -> IO ProfDetailLevel
checkProfileLevel ProfDetailLevel
tryExeProfileLevel
        libLevel <- checkProfileLevel tryLibProfileLevel
        let apply BuildOptions
buildOptions =
              BuildOptions
buildOptions
                { LBC.withProfLib = tryLibProfiling
                , LBC.withProfLibDetail = libLevel
                , LBC.withProfExe = tryExeProfiling
                , LBC.withProfExeDetail = exeLevel
                }
        let compilerSupportsProfilingDynamic = Compiler -> Bool
profilingDynamicSupportedOrUnknown Compiler
comp
        apply2 <-
          if compilerSupportsProfilingDynamic
            then -- Case 1: We support profiled shared libraries so turn on shared profiling
            -- libraries if the user asked for it.
            return $ \BuildOptions
buildOptions -> BuildOptions -> BuildOptions
apply BuildOptions
buildOptions{LBC.withProfLibShared = tryLibProfilingShared}
            else -- Case 2: Compiler doesn't support profiling shared so turn them off
            do
              -- If we wanted to enable profiling shared libraries.. tell the
              -- user we couldn't.
              when (profilingVanillaSupportedOrUnknown comp && tryLibProfilingShared) $
                warn
                  verbosity
                  ( "The compiler "
                      ++ showCompilerId comp
                      ++ " does not support "
                      ++ "profiling shared objects. Static profiled objects "
                      ++ "will be built."
                  )
              return $ \BuildOptions
buildOptions ->
                let original_options :: BuildOptions
original_options = BuildOptions -> BuildOptions
apply BuildOptions
buildOptions
                 in BuildOptions
original_options
                      { LBC.withProfLibShared = False
                      , LBC.withProfLib = profilingVanillaSupportedOrUnknown comp && (tryLibProfilingShared || LBC.withProfLib original_options)
                      , LBC.withDynExe = if LBC.withProfExe original_options then False else LBC.withDynExe original_options
                      }

        when (tryExeProfiling && not (tryLibProfiling || tryLibProfilingShared)) $ do
          warn
            verbosity
            ( "Executables will be built with profiling, but library "
                ++ "profiling is disabled. Linking will fail if any executables "
                ++ "depend on the library."
            )
        return apply2
      else do
        let apply :: BuildOptions -> BuildOptions
apply BuildOptions
buildOptions =
              BuildOptions
buildOptions
                { LBC.withProfLib = False
                , LBC.withProfLibShared = False
                , LBC.withProfLibDetail = ProfDetailNone
                , LBC.withProfExe = False
                , LBC.withProfExeDetail = ProfDetailNone
                }
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
tryExeProfiling Bool -> Bool -> Bool
|| Bool
tryLibProfiling) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          Verbosity -> ProgArg -> IO ()
warn
            Verbosity
verbosity
            ( ProgArg
"The compiler "
                ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Compiler -> ProgArg
showCompilerId Compiler
comp
                ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
" does not support "
                ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"profiling. Profiling has been disabled."
            )
        (BuildOptions -> BuildOptions) -> IO (BuildOptions -> BuildOptions)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BuildOptions -> BuildOptions
apply

  return 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 (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgArg
"No " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
" found"
reportProgram Verbosity
verbosity Program
prog (Just ConfiguredProgram
configuredProg) =
  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$ ProgArg
"Using " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Program -> ProgArg
programName Program
prog ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
version ProgArg -> ShowS
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: " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
p
      UserSpecified ProgArg
p -> ProgArg
" given by user at: " ProgArg -> ShowS
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 " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> ProgArg
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
  | -- | A promised dependency, which doesn't yet exist, but should be provided
    -- at the build time.
    --
    -- We have these such that we can configure components without actually
    -- building its dependencies, if these dependencies need to be built later
    -- again. For example, when launching a multi-repl,
    -- we need to build packages in the interactive ghci session, no matter
    -- whether they have been built before.
    -- Building them in the configure phase is then redundant and costs time.
    PromisedDependency ConfiguredPromisedComponent
  | -- | 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 Pkg' typeclass.)
    InternalDependency PackageId

-- | Test for a package dependency and record the version we have installed.
selectDependency
  :: PackageId
  -- ^ Package id of current package
  -> Set LibraryName
  -- ^ package libraries
  -> Map (PackageName, ComponentName) PromisedComponent
  -- ^ Set of components that are promised, i.e. are not installed already. See 'PromisedDependency' for more details.
  -> 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
-> Map (PackageName, ComponentName) PromisedComponent
-> InstalledPackageIndex
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Bool
-> Dependency
-> [Either FailedDependency DependencyResolution]
selectDependency
  PackageIdentifier
pkgid
  Set LibraryName
internalIndex
  Map (PackageName, ComponentName) PromisedComponent
promisedIndex
  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 PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
pn
      then
        if Bool
use_external_internal_deps
          then LibraryName -> Either FailedDependency DependencyResolution
do_external_internal (LibraryName -> Either FailedDependency DependencyResolution)
-> [LibraryName] -> [Either FailedDependency DependencyResolution]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
          else LibraryName -> Either FailedDependency DependencyResolution
do_internal (LibraryName -> Either FailedDependency DependencyResolution)
-> [LibraryName] -> [Either FailedDependency DependencyResolution]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
      else LibraryName -> Either FailedDependency DependencyResolution
do_external_external (LibraryName -> Either FailedDependency DependencyResolution)
-> [LibraryName] -> [Either FailedDependency DependencyResolution]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmptySet LibraryName -> [LibraryName]
forall a. NonEmptySet a -> [a]
NES.toList NonEmptySet LibraryName
libs
    where
      pn :: PackageName
pn = PackageIdentifier -> PackageName
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
        | LibraryName -> Set LibraryName -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member LibraryName
lib Set LibraryName
internalIndex =
            DependencyResolution
-> Either FailedDependency DependencyResolution
forall a b. b -> Either a b
Right (DependencyResolution
 -> Either FailedDependency DependencyResolution)
-> DependencyResolution
-> Either FailedDependency DependencyResolution
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> DependencyResolution
InternalDependency (PackageIdentifier -> DependencyResolution)
-> PackageIdentifier -> DependencyResolution
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> PackageIdentifier
PackageIdentifier PackageName
dep_pkgname (Version -> PackageIdentifier) -> Version -> PackageIdentifier
forall a b. (a -> b) -> a -> b
$ PackageIdentifier -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion PackageIdentifier
pkgid
        | Bool
otherwise =
            FailedDependency -> Either FailedDependency DependencyResolution
forall a b. a -> Either a b
Left (FailedDependency -> Either FailedDependency DependencyResolution)
-> FailedDependency -> Either FailedDependency DependencyResolution
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
        | Just PromisedComponent
pc <- (PackageName, ComponentName)
-> Map (PackageName, ComponentName) PromisedComponent
-> Maybe PromisedComponent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
dep_pkgname, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) PromisedComponent
promisedIndex =
            DependencyResolution
-> Either FailedDependency DependencyResolution
forall a. a -> Either FailedDependency a
forall (m :: * -> *) a. Monad m => a -> m a
return (DependencyResolution
 -> Either FailedDependency DependencyResolution)
-> DependencyResolution
-> Either FailedDependency DependencyResolution
forall a b. (a -> b) -> a -> b
$ ConfiguredPromisedComponent -> DependencyResolution
PromisedDependency (PackageName
-> AnnotatedId ComponentId -> ConfiguredPromisedComponent
ConfiguredPromisedComponent PackageName
dep_pkgname (PackageIdentifier
-> ComponentName -> ComponentId -> AnnotatedId ComponentId
forall id.
PackageIdentifier -> ComponentName -> id -> AnnotatedId id
AnnotatedId (PromisedComponent -> PackageIdentifier
promisedComponentPackage PromisedComponent
pc) (LibraryName -> ComponentName
CLibName LibraryName
lib) (PromisedComponent -> ComponentId
promisedComponentId PromisedComponent
pc)))
      do_external_external LibraryName
lib = do
        ipi <- case (PackageName, ComponentName)
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Maybe InstalledPackageInfo
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 -> InstalledPackageInfo
-> Either FailedDependency InstalledPackageInfo
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 ([(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo)
-> [(Version, [InstalledPackageInfo])]
-> Maybe InstalledPackageInfo
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 -> FailedDependency -> Either FailedDependency InstalledPackageInfo
forall a b. a -> Either a b
Left (PackageName -> FailedDependency
DependencyNotExists PackageName
dep_pkgname)
            Just InstalledPackageInfo
pkg -> InstalledPackageInfo
-> Either FailedDependency InstalledPackageInfo
forall a b. b -> Either a b
Right InstalledPackageInfo
pkg
        return $ ExternalDependency $ ipiToPreExistingComponent ipi

      do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution
      do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution
do_external_internal LibraryName
lib
        | Just PromisedComponent
pc <- (PackageName, ComponentName)
-> Map (PackageName, ComponentName) PromisedComponent
-> Maybe PromisedComponent
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (PackageName
dep_pkgname, LibraryName -> ComponentName
CLibName LibraryName
lib) Map (PackageName, ComponentName) PromisedComponent
promisedIndex =
            DependencyResolution
-> Either FailedDependency DependencyResolution
forall a. a -> Either FailedDependency a
forall (m :: * -> *) a. Monad m => a -> m a
return (DependencyResolution
 -> Either FailedDependency DependencyResolution)
-> DependencyResolution
-> Either FailedDependency DependencyResolution
forall a b. (a -> b) -> a -> b
$ ConfiguredPromisedComponent -> DependencyResolution
PromisedDependency (PackageName
-> AnnotatedId ComponentId -> ConfiguredPromisedComponent
ConfiguredPromisedComponent PackageName
dep_pkgname (PackageIdentifier
-> ComponentName -> ComponentId -> AnnotatedId ComponentId
forall id.
PackageIdentifier -> ComponentName -> id -> AnnotatedId id
AnnotatedId (PromisedComponent -> PackageIdentifier
promisedComponentPackage PromisedComponent
pc) (LibraryName -> ComponentName
CLibName LibraryName
lib) (PromisedComponent -> ComponentId
promisedComponentId PromisedComponent
pc)))
      do_external_internal LibraryName
lib = do
        ipi <- case (PackageName, ComponentName)
-> Map (PackageName, ComponentName) InstalledPackageInfo
-> Maybe InstalledPackageInfo
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 -> InstalledPackageInfo
-> Either FailedDependency InstalledPackageInfo
forall a b. b -> Either a b
Right InstalledPackageInfo
pkginstance
          Maybe InstalledPackageInfo
Nothing -> case [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI ([(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo)
-> [(Version, [InstalledPackageInfo])]
-> Maybe InstalledPackageInfo
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 -> FailedDependency -> Either FailedDependency InstalledPackageInfo
forall a b. a -> Either a b
Left (PackageName -> LibraryName -> FailedDependency
DependencyMissingInternal PackageName
dep_pkgname LibraryName
lib)
            Just InstalledPackageInfo
pkg -> InstalledPackageInfo
-> Either FailedDependency InstalledPackageInfo
forall a b. b -> Either a b
Right InstalledPackageInfo
pkg
        return $ ExternalDependency $ ipiToPreExistingComponent ipi

      pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
      pickLastIPI :: [(Version, [InstalledPackageInfo])] -> Maybe InstalledPackageInfo
pickLastIPI [(Version, [InstalledPackageInfo])]
pkgs = [InstalledPackageInfo] -> Maybe InstalledPackageInfo
forall a. [a] -> Maybe a
safeHead ([InstalledPackageInfo] -> Maybe InstalledPackageInfo)
-> (NonEmpty (Version, [InstalledPackageInfo])
    -> [InstalledPackageInfo])
-> NonEmpty (Version, [InstalledPackageInfo])
-> Maybe InstalledPackageInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Version, [InstalledPackageInfo]) -> [InstalledPackageInfo]
forall a b. (a, b) -> b
snd ((Version, [InstalledPackageInfo]) -> [InstalledPackageInfo])
-> (NonEmpty (Version, [InstalledPackageInfo])
    -> (Version, [InstalledPackageInfo]))
-> NonEmpty (Version, [InstalledPackageInfo])
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (Version, [InstalledPackageInfo])
-> (Version, [InstalledPackageInfo])
forall a. NonEmpty a -> a
last (NonEmpty (Version, [InstalledPackageInfo])
 -> Maybe InstalledPackageInfo)
-> Maybe (NonEmpty (Version, [InstalledPackageInfo]))
-> Maybe InstalledPackageInfo
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [(Version, [InstalledPackageInfo])]
-> Maybe (NonEmpty (Version, [InstalledPackageInfo]))
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 (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$
    [ProgArg] -> ProgArg
unlines
      [ ProgArg
"Dependency "
        ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ Dependency -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow (Dependency -> Dependency
simplifyDependency Dependency
dep)
        ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
": using "
        ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageIdentifier -> ProgArg
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' -> PreExistingComponent -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId PreExistingComponent
pkg'
              InternalDependency PackageIdentifier
pkgid' -> PackageIdentifier
pkgid'
              PromisedDependency ConfiguredPromisedComponent
promisedComp -> ConfiguredPromisedComponent -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId ConfiguredPromisedComponent
promisedComp
      ]

reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO ()
reportFailedDependencies Verbosity
_ [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
reportFailedDependencies Verbosity
verbosity [FailedDependency]
failed =
  Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ [FailedDependency] -> ProgArg -> CabalException
ReportFailedDependencies [FailedDependency]
failed ProgArg
hackageUrl

-- | 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
  -> Maybe (SymbolicPath CWD (Dir from))
  -> PackageDBStackX (SymbolicPath from (Dir PkgDB))
  -- ^ The stack of package databases.
  -> ProgramDb
  -> IO InstalledPackageIndex
getInstalledPackages :: forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs ProgramDb
progdb = do
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (PackageDBStackX (SymbolicPath from ('Dir PkgDB)) -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
NoPackageDatabaseSpecified

  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity ProgArg
"Reading installed packages..."
  -- do not check empty packagedbs (ghc-pkg would error out)
  packageDBs' <- (PackageDBX (SymbolicPath from ('Dir PkgDB)) -> IO Bool)
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> IO (PackageDBStackX (SymbolicPath from ('Dir PkgDB)))
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM PackageDBX (SymbolicPath from ('Dir PkgDB)) -> IO Bool
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
PackageDBX (SymbolicPathX allowAbsolute from to) -> IO Bool
packageDBExists PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs
  case compilerFlavor comp of
    CompilerFlavor
GHC -> Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
GHC.getInstalledPackages Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs' ProgramDb
progdb
    CompilerFlavor
GHCJS -> Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
GHCJS.getInstalledPackages Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs' ProgramDb
progdb
    CompilerFlavor
UHC -> Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
UHC.getInstalledPackages Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs' ProgramDb
progdb
    HaskellSuite{} ->
      Verbosity
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
HaskellSuite.getInstalledPackages Verbosity
verbosity PackageDBStackX (SymbolicPath from ('Dir PkgDB))
packageDBs' ProgramDb
progdb
    CompilerFlavor
flv ->
      Verbosity -> CabalException -> IO InstalledPackageIndex
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO InstalledPackageIndex)
-> CabalException -> IO InstalledPackageIndex
forall a b. (a -> b) -> a -> b
$ CompilerFlavor -> CabalException
HowToFindInstalledPackages CompilerFlavor
flv
  where
    packageDBExists :: PackageDBX (SymbolicPathX allowAbsolute from to) -> IO Bool
packageDBExists (SpecificPackageDB SymbolicPathX allowAbsolute from to
path0) = do
      let path :: ProgArg
path = Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> ProgArg
forall from (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
Maybe (SymbolicPath CWD ('Dir from))
-> SymbolicPathX allowAbsolute from to -> ProgArg
interpretSymbolicPath Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir SymbolicPathX allowAbsolute from to
path0
      exists <- ProgArg -> IO Bool
doesPathExist ProgArg
path
      unless exists $
        warn verbosity $
          "Package db " <> path <> " does not exist yet"
      return 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 PackageDBX (SymbolicPathX allowAbsolute from to)
UserPackageDB = Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    packageDBExists PackageDBX (SymbolicPathX allowAbsolute from to)
GlobalPackageDB = Bool -> IO Bool
forall a. a -> IO a
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
  -> Maybe (SymbolicPath CWD (Dir Pkg))
  -> PackageDB
  -> ProgramDb
  -> IO InstalledPackageIndex
getPackageDBContents :: Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getPackageDBContents Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
packageDB ProgramDb
progdb = do
  Verbosity -> ProgArg -> IO ()
info Verbosity
verbosity ProgArg
"Reading installed packages..."
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC -> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
GHC.getPackageDBContents Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
packageDB ProgramDb
progdb
    CompilerFlavor
GHCJS -> Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
GHCJS.getPackageDBContents Verbosity
verbosity Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
packageDB ProgramDb
progdb
    -- For other compilers, try to fall back on 'getInstalledPackages'.
    CompilerFlavor
_ -> Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir [PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
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
  -> Maybe (SymbolicPath CWD ('Dir from))
  -> PackageDBStackS from
  -> ProgramDb
  -> Platform
  -> IO [FilePath]
getInstalledPackagesMonitorFiles :: forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackS from
-> ProgramDb
-> Platform
-> IO [ProgArg]
getInstalledPackagesMonitorFiles Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir PackageDBStackS from
packageDBs ProgramDb
progdb Platform
platform =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
comp of
    CompilerFlavor
GHC ->
      Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> Platform
-> ProgramDb
-> PackageDBStackS from
-> IO [ProgArg]
forall from.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir from))
-> Platform
-> ProgramDb
-> [PackageDBS from]
-> IO [ProgArg]
GHC.getInstalledPackagesMonitorFiles
        Verbosity
verbosity
        Maybe (SymbolicPath CWD ('Dir from))
mbWorkDir
        Platform
platform
        ProgramDb
progdb
        PackageDBStackS from
packageDBs
    CompilerFlavor
other -> do
      Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$
        ProgArg
"don't know how to find change monitoring files for "
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"the installed package databases for "
          ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ CompilerFlavor -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow CompilerFlavor
other
      [ProgArg] -> IO [ProgArg]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []

-- | Looks up the 'InstalledPackageInfo' of the given 'UnitId's from the
-- 'PackageDBStack' in the 'LocalBuildInfo'.
getInstalledPackagesById
  :: (Exception (VerboseException exception), Show exception, Typeable exception)
  => Verbosity
  -> LocalBuildInfo
  -> (UnitId -> exception)
  -- ^ Construct an exception that is thrown if a
  -- unit-id is not found in the installed packages,
  -- from the unit-id that is missing.
  -> [UnitId]
  -- ^ The unit ids to lookup in the installed packages
  -> IO [InstalledPackageInfo]
getInstalledPackagesById :: forall exception.
(Exception (VerboseException exception), Show exception,
 Typeable exception) =>
Verbosity
-> LocalBuildInfo
-> (UnitId -> exception)
-> [UnitId]
-> IO [InstalledPackageInfo]
getInstalledPackagesById Verbosity
verbosity lbi :: LocalBuildInfo
lbi@LocalBuildInfo{compiler :: LocalBuildInfo -> Compiler
compiler = Compiler
comp, withPackageDB :: LocalBuildInfo -> PackageDBStack
withPackageDB = PackageDBStack
pkgDb, withPrograms :: LocalBuildInfo -> ProgramDb
withPrograms = ProgramDb
progDb} UnitId -> exception
mkException [UnitId]
unitids = do
  let mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI LocalBuildInfo
lbi
  ipindex <- Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> PackageDBStack
-> ProgramDb
-> IO InstalledPackageIndex
forall from.
Verbosity
-> Compiler
-> Maybe (SymbolicPath CWD ('Dir from))
-> PackageDBStackX (SymbolicPath from ('Dir PkgDB))
-> ProgramDb
-> IO InstalledPackageIndex
getInstalledPackages Verbosity
verbosity Compiler
comp Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir PackageDBStack
pkgDb ProgramDb
progDb
  mapM
    ( \UnitId
uid -> case InstalledPackageIndex -> UnitId -> Maybe InstalledPackageInfo
forall a. PackageIndex a -> UnitId -> Maybe a
lookupUnitId InstalledPackageIndex
ipindex UnitId
uid of
        Maybe InstalledPackageInfo
Nothing -> Verbosity -> exception -> IO InstalledPackageInfo
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (UnitId -> exception
mkException UnitId
uid)
        Just InstalledPackageInfo
ipkg -> InstalledPackageInfo -> IO InstalledPackageInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return InstalledPackageInfo
ipkg
    )
    unitids

-- | 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 (PackageDBX fp)] -> PackageDBStackX fp
interpretPackageDbFlags :: forall fp. Bool -> [Maybe (PackageDBX fp)] -> PackageDBStackX fp
interpretPackageDbFlags Bool
userInstall [Maybe (PackageDBX fp)]
specificDBs =
  [PackageDBX fp] -> [Maybe (PackageDBX fp)] -> [PackageDBX fp]
forall {a}. [a] -> [Maybe a] -> [a]
extra [PackageDBX fp]
forall {fp}. [PackageDBX fp]
initialStack [Maybe (PackageDBX fp)]
specificDBs
  where
    initialStack :: [PackageDBX fp]
initialStack
      | Bool
userInstall = [PackageDBX fp
forall fp. PackageDBX fp
GlobalPackageDB, PackageDBX fp
forall fp. PackageDBX fp
UserPackageDB]
      | Bool
otherwise = [PackageDBX fp
forall fp. PackageDBX fp
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' [a] -> [a] -> [a]
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]
  -- ^ installed dependencies
  -> InstalledPackageIndex
  -> Either
      CabalException
      ( [PackageVersionConstraint]
      , Map (PackageName, ComponentName) InstalledPackageInfo
      )
combinedConstraints :: [PackageVersionConstraint]
-> [GivenComponent]
-> InstalledPackageIndex
-> Either
     CabalException
     ([PackageVersionConstraint],
      Map (PackageName, ComponentName) InstalledPackageInfo)
combinedConstraints [PackageVersionConstraint]
constraints [GivenComponent]
dependencies InstalledPackageIndex
installedPackages = do
  Bool -> Either CabalException () -> Either CabalException ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not ([(PackageName, ComponentName, ComponentId)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(PackageName, ComponentName, ComponentId)]
badComponentIds)) (Either CabalException () -> Either CabalException ())
-> Either CabalException () -> Either CabalException ()
forall a b. (a -> b) -> a -> b
$
    CabalException -> Either CabalException ()
forall a b. a -> Either a b
Left (CabalException -> Either CabalException ())
-> CabalException -> Either CabalException ()
forall a b. (a -> b) -> a -> b
$
      Doc -> CabalException
CombinedConstraints ([(PackageName, ComponentName, ComponentId)] -> Doc
forall {a} {a}.
(Pretty a, Pretty a) =>
[(a, ComponentName, a)] -> Doc
dispDependencies [(PackageName, ComponentName, ComponentId)]
badComponentIds)

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

  ([PackageVersionConstraint],
 Map (PackageName, ComponentName) InstalledPackageInfo)
-> Either
     CabalException
     ([PackageVersionConstraint],
      Map (PackageName, ComponentName) InstalledPackageInfo)
forall a. a -> Either CabalException a
forall (m :: * -> *) a. Monad m => a -> m a
return ([PackageVersionConstraint]
allConstraints, Map (PackageName, ComponentName) InstalledPackageInfo
idConstraintMap)
  where
    allConstraints :: [PackageVersionConstraint]
    allConstraints :: [PackageVersionConstraint]
allConstraints =
      [PackageVersionConstraint]
constraints
        [PackageVersionConstraint]
-> [PackageVersionConstraint] -> [PackageVersionConstraint]
forall a. [a] -> [a] -> [a]
++ [ PackageIdentifier -> PackageVersionConstraint
thisPackageVersionConstraint (InstalledPackageInfo -> PackageIdentifier
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 =
      [((PackageName, ComponentName), InstalledPackageInfo)]
-> Map (PackageName, ComponentName) InstalledPackageInfo
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 =
              InstalledPackageIndex -> ComponentId -> Maybe InstalledPackageInfo
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
            ( a -> Doc
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
<<>> UnqualComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty UnqualComponentName
n
                  ComponentName
_ -> Doc
":" Doc -> Doc -> Doc
<<>> ComponentName -> Doc
forall a. Pretty a => a -> Doc
pretty ComponentName
cname
                Doc -> Doc -> Doc
<<>> Char -> Doc
char Char
'='
                Doc -> Doc -> Doc
<<>> a -> 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 =
  (ProgramDb -> LegacyExeDependency -> IO ProgramDb)
-> ProgramDb -> [LegacyExeDependency] -> IO ProgramDb
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 ConfiguredProgram
lookupProgramByName ProgArg
progName ProgramDb
progdb of
      Just ConfiguredProgram
prog ->
        -- If the program has already been configured, use it
        -- (as long as the version is compatible).
        --
        -- Not doing so means falling back to the "simpleProgram" path below,
        -- which might fail if the program has custom logic to find a version
        -- (such as hsc2hs).
        let loc :: ProgArg
loc = ProgramLocation -> ProgArg
locationPath (ProgramLocation -> ProgArg) -> ProgramLocation -> ProgArg
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> ProgramLocation
programLocation ConfiguredProgram
prog
         in case ConfiguredProgram -> Maybe Version
programVersion ConfiguredProgram
prog of
              Maybe Version
Nothing
                | VersionRange
verRange VersionRange -> VersionRange -> Bool
forall a. Eq a => a -> a -> Bool
== VersionRange
anyVersion ->
                    ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb
                | Bool
otherwise ->
                    Verbosity -> CabalException -> IO ProgramDb
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ProgramDb) -> CabalException -> IO ProgramDb
forall a b. (a -> b) -> a -> b
$!
                      ProgArg -> VersionRange -> ProgArg -> CabalException
UnknownVersionDb (ConfiguredProgram -> ProgArg
programId ConfiguredProgram
prog) VersionRange
verRange ProgArg
loc
              Just Version
version
                | Version -> VersionRange -> Bool
withinRange Version
version VersionRange
verRange ->
                    ProgramDb -> IO ProgramDb
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ProgramDb
progdb
                | Bool
otherwise ->
                    Verbosity -> CabalException -> IO ProgramDb
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ProgramDb) -> CabalException -> IO ProgramDb
forall a b. (a -> b) -> a -> b
$!
                      ProgArg -> Version -> VersionRange -> ProgArg -> CabalException
BadVersionDb (ConfiguredProgram -> ProgArg
programId ConfiguredProgram
prog) Version
version VersionRange
verRange ProgArg
loc
      Maybe ConfiguredProgram
Nothing ->
        -- Otherwise, try to configure it as a 'simpleProgram' automatically
        case ProgArg -> ProgramDb -> Maybe Program
lookupKnownProgram ProgArg
progName ProgramDb
progdb of
          Maybe Program
Nothing ->
            -- 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 VersionRange -> VersionRange -> Bool
forall a. Eq a => a -> a -> Bool
== VersionRange
anyVersion -> do
                (_, progdb') <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
prog ProgramDb
progdb
                return progdb'
            | Bool
otherwise -> do
                (_, _, progdb') <- Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion Verbosity
verbosity Program
prog VersionRange
verRange ProgramDb
progdb
                return 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
  | [PkgconfigDependency] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [PkgconfigDependency]
allpkgs = (PackageDescription, ProgramDb)
-> IO (PackageDescription, ProgramDb)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (PackageDescription
pkg_descr, ProgramDb
progdb)
  | Bool
otherwise = do
      (_, _, progdb') <-
        Verbosity
-> Program
-> VersionRange
-> ProgramDb
-> IO (ConfiguredProgram, Version, ProgramDb)
requireProgramVersion
          (Verbosity -> Verbosity
lessVerbose Verbosity
verbosity)
          Program
pkgConfigProgram
          (Version -> VersionRange
orLaterVersion (Version -> VersionRange) -> Version -> VersionRange
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
0, Int
9, Int
0])
          ProgramDb
progdb
      traverse_ requirePkg allpkgs
      mlib' <- traverse addPkgConfigBILib (library pkg_descr)
      libs' <- traverse addPkgConfigBILib (subLibraries pkg_descr)
      exes' <- traverse addPkgConfigBIExe (executables pkg_descr)
      tests' <- traverse addPkgConfigBITest (testSuites pkg_descr)
      benches' <- traverse addPkgConfigBIBench (benchmarks pkg_descr)
      let pkg_descr' =
            PackageDescription
pkg_descr
              { library = mlib'
              , subLibraries = libs'
              , executables = exes'
              , testSuites = tests'
              , benchmarks = benches'
              }
      return (pkg_descr', progdb')
  where
    allpkgs :: [PkgconfigDependency]
allpkgs = (BuildInfo -> [PkgconfigDependency])
-> [BuildInfo] -> [PkgconfigDependency]
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
      version <-
        [ProgArg] -> IO ProgArg
pkgconfig [ProgArg
"--modversion", ProgArg
pkg]
          IO ProgArg -> (IOException -> IO ProgArg) -> IO ProgArg
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> Verbosity -> CabalException -> IO ProgArg
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ProgArg) -> CabalException -> IO ProgArg
forall a b. (a -> b) -> a -> b
$ ProgArg -> ProgArg -> CabalException
PkgConfigNotFound ProgArg
pkg ProgArg
versionRequirement)
          IO ProgArg -> (ExitCode -> IO ProgArg) -> IO ProgArg
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> Verbosity -> CabalException -> IO ProgArg
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ProgArg) -> CabalException -> IO ProgArg
forall a b. (a -> b) -> a -> b
$ ProgArg -> ProgArg -> CabalException
PkgConfigNotFound ProgArg
pkg ProgArg
versionRequirement)
      let trim = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
      let v = ByteString -> PkgconfigVersion
PkgconfigVersion (ProgArg -> ByteString
toUTF8BS (ProgArg -> ByteString) -> ProgArg -> ByteString
forall a b. (a -> b) -> a -> b
$ ShowS
trim ProgArg
version)
      if not (withinPkgconfigVersionRange v range)
        then dieWithException verbosity $ BadVersion pkg versionRequirement v
        else info verbosity (depSatisfied v)
      where
        depSatisfied :: a -> ProgArg
depSatisfied a
v =
          ProgArg
"Dependency "
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgconfigDependency -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow PkgconfigDependency
dep
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
": using version "
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow a
v

        versionRequirement :: ProgArg
versionRequirement
          | PkgconfigVersionRange -> Bool
isAnyPkgconfigVersion PkgconfigVersionRange
range = ProgArg
""
          | Bool
otherwise = ProgArg
" version " ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ PkgconfigVersionRange -> ProgArg
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
      bi <- [PkgconfigDependency] -> IO BuildInfo
pkgconfigBuildInfo (BuildInfo -> [PkgconfigDependency]
pkgconfigDepends (t -> BuildInfo
compBI t
comp))
      return $ setCompBI comp (compBI comp `mappend` bi)

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

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

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

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

    pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo
    pkgconfigBuildInfo :: [PkgconfigDependency] -> IO BuildInfo
pkgconfigBuildInfo [] = BuildInfo -> IO BuildInfo
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return BuildInfo
forall a. Monoid a => a
mempty
    pkgconfigBuildInfo [PkgconfigDependency]
pkgdeps = do
      let pkgs :: [ProgArg]
pkgs = [ProgArg] -> [ProgArg]
forall a. Eq a => [a] -> [a]
nub [PkgconfigName -> ProgArg
forall a. Pretty a => a -> ProgArg
prettyShow PkgconfigName
pkg | PkgconfigDependency PkgconfigName
pkg PkgconfigVersionRange
_ <- [PkgconfigDependency]
pkgdeps]
      ccflags <- [ProgArg] -> IO ProgArg
pkgconfig (ProgArg
"--cflags" ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: [ProgArg]
pkgs)
      ldflags <- pkgconfig ("--libs" : pkgs)
      ldflags_static <- pkgconfig ("--libs" : "--static" : pkgs)
      return (ccLdOptionsBuildInfo (words ccflags) (words ldflags) (words 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') = (ProgArg -> Bool) -> [ProgArg] -> ([ProgArg], [ProgArg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-I" ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
cflags
      ([ProgArg]
extraLibs', [ProgArg]
ldflags') = (ProgArg -> Bool) -> [ProgArg] -> ([ProgArg], [ProgArg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-l" ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags
      ([ProgArg]
extraLibDirs', [ProgArg]
ldflags'') = (ProgArg -> Bool) -> [ProgArg] -> ([ProgArg], [ProgArg])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (ProgArg
"-L" ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags'
      ([ProgArg]
extraLibsStatic') = (ProgArg -> Bool) -> [ProgArg] -> [ProgArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (ProgArg
"-l" ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags_static
      ([ProgArg]
extraLibDirsStatic') = (ProgArg -> Bool) -> [ProgArg] -> [ProgArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (ProgArg
"-L" ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [ProgArg]
ldflags_static
   in BuildInfo
forall a. Monoid a => a
mempty
        { includeDirs = map (makeSymbolicPath . drop 2) includeDirs'
        , extraLibs = map (drop 2) extraLibs'
        , extraLibDirs = map (makeSymbolicPath . drop 2) extraLibDirs'
        , extraLibsStatic = map (drop 2) extraLibsStatic'
        , extraLibDirsStatic = map (makeSymbolicPath . drop 2) extraLibDirsStatic'
        , ccOptions = cflags'
        , ldOptions = ldflags''
        }

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

configCompilerAuxEx
  :: ConfigFlags
  -> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx :: ConfigFlags -> IO (Compiler, Platform, ProgramDb)
configCompilerAuxEx ConfigFlags
cfg = do
  programDb <- ConfigFlags -> ProgramDb -> IO ProgramDb
mkProgramDb ConfigFlags
cfg ProgramDb
defaultProgramDb
  let common = ConfigFlags -> CommonSetupFlags
configCommonFlags ConfigFlags
cfg
      verbosity = Flag Verbosity -> Verbosity
forall a. WithCallStack (Flag a -> a)
fromFlag (Flag Verbosity -> Verbosity) -> Flag Verbosity -> Verbosity
forall a b. (a -> b) -> a -> b
$ CommonSetupFlags -> Flag Verbosity
setupVerbosity CommonSetupFlags
common
  configCompilerEx
    (flagToMaybe $ configHcFlavor cfg)
    (flagToMaybe $ configHcPath cfg)
    (flagToMaybe $ configHcPkg cfg)
    programDb
    verbosity

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 = Verbosity -> CabalException -> IO (Compiler, Platform, ProgramDb)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
UnknownCompilerException
configCompilerEx (Just CompilerFlavor
hcFlavor) Maybe ProgArg
hcPath Maybe ProgArg
hcPkg ProgramDb
progdb Verbosity
verbosity = do
  (comp, maybePlatform, 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
_ -> Verbosity
-> CabalException -> IO (Compiler, Maybe Platform, ProgramDb)
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
UnknownCompilerException
  return (comp, fromMaybe buildPlatform maybePlatform, 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 =
  [ProgArg] -> [ProgArg] -> IO () -> IO () -> IO ()
forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith
    [ProgArg]
allHeaders
    ([ProgArg]
commonCcArgs [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ProgArg] -> [ProgArg]
makeLdArgs [ProgArg]
allLibs) -- I'm feeling lucky
    (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    ( do
        missingLibs <- IO [ProgArg]
findMissingLibs
        missingHdr <- findOffendingHdr
        explainErrors missingHdr missingLibs
    )
  where
    allHeaders :: [ProgArg]
allHeaders = (BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField ((SymbolicPathX 'AllowAbsolute Include 'File -> ProgArg)
-> [SymbolicPathX 'AllowAbsolute Include 'File] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPathX 'AllowAbsolute Include 'File -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath ([SymbolicPathX 'AllowAbsolute Include 'File] -> [ProgArg])
-> (BuildInfo -> [SymbolicPathX 'AllowAbsolute Include 'File])
-> BuildInfo
-> [ProgArg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPathX 'AllowAbsolute Include 'File]
includes)
    allLibs :: [ProgArg]
allLibs =
      (BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField ((BuildInfo -> [ProgArg]) -> [ProgArg])
-> (BuildInfo -> [ProgArg]) -> [ProgArg]
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
      ok <- ProgArg -> [ProgArg] -> IO Bool
builds ([ProgArg] -> ProgArg
makeProgram [ProgArg]
headers) [ProgArg]
args
      if ok then success else 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 = (ProgArg -> Bool) -> [ProgArg] -> [ProgArg]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ProgArg -> Bool) -> ProgArg -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProgArg -> Bool
isAbsolute) ((BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField ((SymbolicPath Pkg ('Dir Include) -> ProgArg)
-> [SymbolicPath Pkg ('Dir Include)] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Include) -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath ([SymbolicPath Pkg ('Dir Include)] -> [ProgArg])
-> (BuildInfo -> [SymbolicPath Pkg ('Dir Include)])
-> BuildInfo
-> [ProgArg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath Pkg ('Dir Include)]
includeDirs))
          isHeader :: ProgArg -> Bool
isHeader = ProgArg -> ProgArg -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf ProgArg
".h"
      genHeaders <- [ProgArg] -> (ProgArg -> IO [ProgArg]) -> IO [[ProgArg]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [ProgArg]
relIncDirs ((ProgArg -> IO [ProgArg]) -> IO [[ProgArg]])
-> (ProgArg -> IO [ProgArg]) -> IO [[ProgArg]]
forall a b. (a -> b) -> a -> b
$ \ProgArg
dir ->
        ShowS -> [ProgArg] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProgArg
dir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</>) ([ProgArg] -> [ProgArg])
-> ([ProgArg] -> [ProgArg]) -> [ProgArg] -> [ProgArg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgArg -> Bool) -> [ProgArg] -> [ProgArg]
forall a. (a -> Bool) -> [a] -> [a]
filter ProgArg -> Bool
isHeader
          ([ProgArg] -> [ProgArg]) -> IO [ProgArg] -> IO [ProgArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProgArg -> IO [ProgArg]
listDirectory (SymbolicPath Pkg ('Dir Build) -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i (LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi) ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
dir) IO [ProgArg] -> (IOException -> IO [ProgArg]) -> IO [ProgArg]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> [ProgArg] -> IO [ProgArg]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      srcHeaders <- for relIncDirs $ \ProgArg
dir ->
        ShowS -> [ProgArg] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProgArg
dir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</>) ([ProgArg] -> [ProgArg])
-> ([ProgArg] -> [ProgArg]) -> [ProgArg] -> [ProgArg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProgArg -> Bool) -> [ProgArg] -> [ProgArg]
forall a. (a -> Bool) -> [a] -> [a]
filter ProgArg -> Bool
isHeader
          ([ProgArg] -> [ProgArg]) -> IO [ProgArg] -> IO [ProgArg]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProgArg -> IO [ProgArg]
listDirectory (ProgArg
baseDir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
dir) IO [ProgArg] -> (IOException -> IO [ProgArg]) -> IO [ProgArg]
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> [ProgArg] -> IO [ProgArg]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
      let commonHeaders = [[ProgArg]] -> [ProgArg]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProgArg]]
genHeaders [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [[ProgArg]] -> [ProgArg]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ProgArg]]
srcHeaders
      for_ commonHeaders $ \ProgArg
hdr -> do
        Verbosity -> ProgArg -> IO ()
warn Verbosity
verbosity (ProgArg -> IO ()) -> ProgArg -> IO ()
forall a b. (a -> b) -> a -> b
$
          ProgArg
"Duplicate header found in "
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ (SymbolicPath Pkg ('Dir Build) -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath (LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi) ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
hdr)
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
" and "
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ (ProgArg
baseDir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
hdr)
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
"; removing "
            ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ (ProgArg
baseDir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
hdr)
        ProgArg -> IO ()
removeFile (ProgArg
baseDir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg
hdr)

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

        cppArgs :: [ProgArg]
cppArgs = ProgArg
"-E" ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: [ProgArg]
commonCppArgs -- preprocess only
        ccArgs :: [ProgArg]
ccArgs = ProgArg
"-c" ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: [ProgArg]
commonCcArgs -- don't try to link
    findMissingLibs :: IO [ProgArg]
findMissingLibs =
      [ProgArg]
-> [ProgArg] -> IO [ProgArg] -> IO [ProgArg] -> IO [ProgArg]
forall {b}. [ProgArg] -> [ProgArg] -> IO b -> IO b -> IO b
ifBuildsWith
        []
        ([ProgArg] -> [ProgArg]
makeLdArgs [ProgArg]
allLibs)
        ([ProgArg] -> IO [ProgArg]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
        ((ProgArg -> IO Bool) -> [ProgArg] -> IO [ProgArg]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM ((Bool -> Bool) -> IO Bool -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not (IO Bool -> IO Bool) -> (ProgArg -> IO Bool) -> ProgArg -> IO Bool
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])

    common :: CommonSetupFlags
common = ConfigFlags -> CommonSetupFlags
configCommonFlags (ConfigFlags -> CommonSetupFlags)
-> ConfigFlags -> CommonSetupFlags
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> ConfigFlags
configFlags LocalBuildInfo
lbi
    baseDir :: ProgArg
baseDir = CommonSetupFlags -> ProgArg
packageRoot CommonSetupFlags
common

    -- See Note [Symbolic paths] in Distribution.Utils.Path
    i :: SymbolicPathX allowAbsolute Pkg to -> ProgArg
i = LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> ProgArg
forall (allowAbsolute :: AllowAbsolute) (to :: FileOrDir).
LocalBuildInfo -> SymbolicPathX allowAbsolute Pkg to -> ProgArg
interpretSymbolicPathLBI LocalBuildInfo
lbi
    mbWorkDir :: Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir = LocalBuildInfo -> Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDirLBI 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.)
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 1) -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i (LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> RelativePath Build (ZonkAny 1)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 1)
forall p q r. PathLike p q r => p -> q -> r
</> ProgArg -> RelativePath Build (ZonkAny 1)
forall from (to :: FileOrDir).
HasCallStack =>
ProgArg -> RelativePath from to
makeRelativePathEx ProgArg
"autogen")]
        -- `configure' may generate headers in the build directory
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2) -> ProgArg
forall {allowAbsolute :: AllowAbsolute} {to :: FileOrDir}.
SymbolicPathX allowAbsolute Pkg to -> ProgArg
i (LocalBuildInfo -> SymbolicPath Pkg ('Dir Build)
buildDir LocalBuildInfo
lbi SymbolicPath Pkg ('Dir Build)
-> SymbolicPathX 'OnlyRelative Build (ZonkAny 2)
-> SymbolicPathX 'AllowAbsolute Pkg (ZonkAny 2)
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
-> SymbolicPathX 'OnlyRelative Build (ZonkAny 2)
forall (allowAbsolute :: AllowAbsolute) from1 (to1 :: FileOrDir)
       from2 (to2 :: FileOrDir).
SymbolicPathX allowAbsolute from1 to1
-> SymbolicPathX allowAbsolute from2 to2
unsafeCoerceSymbolicPath SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir)
           | SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir <- (SymbolicPath Pkg ('Dir Include)
 -> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include)))
-> [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SymbolicPath Pkg ('Dir Include)
-> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe ([SymbolicPath Pkg ('Dir Include)]
 -> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)])
-> [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> b) -> a -> b
$ [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPath Pkg ('Dir Include)]
forall a. Ord a => [a] -> [a]
ordNub ((BuildInfo -> [SymbolicPath Pkg ('Dir Include)])
-> [SymbolicPath Pkg ('Dir Include)]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [SymbolicPath Pkg ('Dir Include)]
includeDirs)
           ]
        -- we might also reference headers from the
        -- packages directory.
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
baseDir ProgArg -> ShowS
forall p q r. PathLike p q r => p -> q -> r
</> SymbolicPathX 'OnlyRelative Pkg ('Dir Include) -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir
           | SymbolicPathX 'OnlyRelative Pkg ('Dir Include)
dir <- (SymbolicPath Pkg ('Dir Include)
 -> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include)))
-> [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SymbolicPath Pkg ('Dir Include)
-> Maybe (SymbolicPathX 'OnlyRelative Pkg ('Dir Include))
forall from (to :: FileOrDir).
SymbolicPath from to -> Maybe (RelativePath from to)
symbolicPathRelative_maybe ([SymbolicPath Pkg ('Dir Include)]
 -> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)])
-> [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPathX 'OnlyRelative Pkg ('Dir Include)]
forall a b. (a -> b) -> a -> b
$ [SymbolicPath Pkg ('Dir Include)]
-> [SymbolicPath Pkg ('Dir Include)]
forall a. Ord a => [a] -> [a]
ordNub ((BuildInfo -> [SymbolicPath Pkg ('Dir Include)])
-> [SymbolicPath Pkg ('Dir Include)]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [SymbolicPath Pkg ('Dir Include)]
includeDirs)
           ]
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
dir
           | ProgArg
dir <- [ProgArg] -> [ProgArg]
forall a. Ord a => [a] -> [a]
ordNub ((BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField ((SymbolicPath Pkg ('Dir Include) -> ProgArg)
-> [SymbolicPath Pkg ('Dir Include)] -> [ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SymbolicPath Pkg ('Dir Include) -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath ([SymbolicPath Pkg ('Dir Include)] -> [ProgArg])
-> (BuildInfo -> [SymbolicPath Pkg ('Dir Include)])
-> BuildInfo
-> [ProgArg]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath Pkg ('Dir Include)]
includeDirs))
           , ProgArg -> Bool
isAbsolute ProgArg
dir
           ]
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
baseDir]
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ (BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
cppOptions
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ (BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
ccOptions
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-I" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
dir
           | ProgArg
dir <-
              [ProgArg] -> [ProgArg]
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
           ]
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
opt
           | InstalledPackageInfo
dep <- [InstalledPackageInfo]
deps
           , ProgArg
opt <- InstalledPackageInfo -> [ProgArg]
IPI.ccOptions InstalledPackageInfo
dep
           ]

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

    commonLdArgs :: [ProgArg]
commonLdArgs =
      [ ProgArg
"-L" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ SymbolicPath Pkg ('Dir Lib) -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath SymbolicPath Pkg ('Dir Lib)
dir
      | SymbolicPath Pkg ('Dir Lib)
dir <-
          [SymbolicPath Pkg ('Dir Lib)] -> [SymbolicPath Pkg ('Dir Lib)]
forall a. Ord a => [a] -> [a]
ordNub ([SymbolicPath Pkg ('Dir Lib)] -> [SymbolicPath Pkg ('Dir Lib)])
-> [SymbolicPath Pkg ('Dir Lib)] -> [SymbolicPath Pkg ('Dir Lib)]
forall a b. (a -> b) -> a -> b
$
            (BuildInfo -> [SymbolicPath Pkg ('Dir Lib)])
-> [SymbolicPath Pkg ('Dir Lib)]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField
              ( if LocalBuildInfo -> Bool
withFullyStaticExe LocalBuildInfo
lbi
                  then BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirsStatic
                  else BuildInfo -> [SymbolicPath Pkg ('Dir Lib)]
extraLibDirs
              )
      ]
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ (BuildInfo -> [ProgArg]) -> [ProgArg]
forall {b}. (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [ProgArg]
ldOptions
        [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ ProgArg
"-L" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
dir
           | ProgArg
dir <-
              [ProgArg] -> [ProgArg]
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" ProgArg -> ShowS
forall a. [a] -> [a] -> [a]
++ ProgArg
lib | ProgArg
lib <- [ProgArg]
libs] [ProgArg] -> [ProgArg] -> [ProgArg]
forall a. [a] -> [a] -> [a]
++ [ProgArg]
commonLdArgs

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

    collectField :: (BuildInfo -> [b]) -> [b]
collectField BuildInfo -> [b]
f = (BuildInfo -> [b]) -> [BuildInfo] -> [b]
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 = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageInstalled a => PackageIndex a -> [a]
PackageIndex.topologicalOrder (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)

    builds :: String -> [ProgArg] -> IO Bool
    builds :: ProgArg -> [ProgArg] -> IO Bool
builds ProgArg
program [ProgArg]
args =
      do
        tempDir <- ProgArg -> SymbolicPath Pkg ('Dir (ZonkAny 0))
forall from (to :: FileOrDir). ProgArg -> SymbolicPath from to
makeSymbolicPath (ProgArg -> SymbolicPath Pkg ('Dir (ZonkAny 0)))
-> IO ProgArg -> IO (SymbolicPath Pkg ('Dir (ZonkAny 0)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO ProgArg
getTemporaryDirectory
        withTempFileCwd mbWorkDir tempDir ".c" $ \SymbolicPath Pkg 'File
cName Handle
cHnd ->
          Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir (ZonkAny 0))
-> ProgArg
-> (SymbolicPath Pkg 'File -> Handle -> IO Bool)
-> IO Bool
forall tmpDir a.
Maybe (SymbolicPath CWD ('Dir Pkg))
-> SymbolicPath Pkg ('Dir tmpDir)
-> ProgArg
-> (SymbolicPath Pkg 'File -> Handle -> IO a)
-> IO a
withTempFileCwd Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir SymbolicPath Pkg ('Dir (ZonkAny 0))
tempDir ProgArg
"" ((SymbolicPath Pkg 'File -> Handle -> IO Bool) -> IO Bool)
-> (SymbolicPath Pkg 'File -> Handle -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \SymbolicPath Pkg 'File
oNname Handle
oHnd -> do
            Handle -> ProgArg -> IO ()
hPutStrLn Handle
cHnd ProgArg
program
            Handle -> IO ()
hClose Handle
cHnd
            Handle -> IO ()
hClose Handle
oHnd
            _ <-
              Verbosity
-> Maybe (SymbolicPath CWD ('Dir Pkg))
-> Program
-> ProgramDb
-> [ProgArg]
-> IO ProgArg
forall to.
Verbosity
-> Maybe (SymbolicPath CWD ('Dir to))
-> Program
-> ProgramDb
-> [ProgArg]
-> IO ProgArg
getDbProgramOutputCwd
                Verbosity
verbosity
                Maybe (SymbolicPath CWD ('Dir Pkg))
mbWorkDir
                Program
gccProgram
                (LocalBuildInfo -> ProgramDb
withPrograms LocalBuildInfo
lbi)
                (SymbolicPath Pkg 'File -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath SymbolicPath Pkg 'File
cName ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: ProgArg
"-o" ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: SymbolicPath Pkg 'File -> ProgArg
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> ProgArg
getSymbolicPath SymbolicPath Pkg 'File
oNname ProgArg -> [ProgArg] -> [ProgArg]
forall a. a -> [a] -> [a]
: [ProgArg]
args)
            return True
        IO Bool -> (IOException -> IO Bool) -> IO Bool
forall a. IO a -> (IOException -> IO a) -> IO a
`catchIO` (\IOException
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
        IO Bool -> (ExitCode -> IO Bool) -> IO Bool
forall a. IO a -> (ExitCode -> IO a) -> IO a
`catchExit` (\ExitCode
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)

    explainErrors :: Maybe (Either ProgArg ProgArg) -> [ProgArg] -> IO ()
explainErrors Maybe (Either ProgArg ProgArg)
Nothing [] = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- should be impossible!
    explainErrors Maybe (Either ProgArg ProgArg)
_ [ProgArg]
_
      | Maybe ConfiguredProgram -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe ConfiguredProgram -> Bool)
-> (LocalBuildInfo -> Maybe ConfiguredProgram)
-> LocalBuildInfo
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program -> ProgramDb -> Maybe ConfiguredProgram
lookupProgram Program
gccProgram (ProgramDb -> Maybe ConfiguredProgram)
-> (LocalBuildInfo -> ProgramDb)
-> LocalBuildInfo
-> Maybe ConfiguredProgram
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> ProgramDb
withPrograms (LocalBuildInfo -> Bool) -> LocalBuildInfo -> Bool
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
lbi =
          Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalException
NoWorkingGcc
    explainErrors Maybe (Either ProgArg ProgArg)
hdr [ProgArg]
libs =
      Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (Either ProgArg ProgArg) -> [ProgArg] -> CabalException
ExplainErrors Maybe (Either ProgArg ProgArg)
hdr [ProgArg]
libs

-- | 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
  ioChecks <- Verbosity -> PackageDescription -> ProgArg -> IO [PackageCheck]
checkPackageFiles Verbosity
verbosity PackageDescription
pkg ProgArg
dir
  let pureChecks = GenericPackageDescription -> [PackageCheck]
checkPackage GenericPackageDescription
gpkg
      (errors, warnings) =
        partitionEithers (M.mapMaybe classEW $ pureChecks ++ ioChecks)
  if null errors
    then traverse_ (warn verbosity) (map ppPackageCheck warnings)
    else dieWithException verbosity $ CheckPackageProblems (map ppPackageCheck 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
_) = Either PackageCheck PackageCheck
-> Maybe (Either PackageCheck PackageCheck)
forall a. a -> Maybe a
Just (PackageCheck -> Either PackageCheck PackageCheck
forall a b. a -> Either a b
Left PackageCheck
e)
    classEW w :: PackageCheck
w@(PackageBuildWarning CheckExplanation
_) = Either PackageCheck PackageCheck
-> Maybe (Either PackageCheck PackageCheck)
forall a. a -> Maybe a
Just (PackageCheck -> Either PackageCheck PackageCheck
forall a b. b -> Either a b
Right PackageCheck
w)
    classEW (PackageDistSuspicious CheckExplanation
_) = Maybe (Either PackageCheck PackageCheck)
forall a. Maybe a
Nothing
    classEW (PackageDistSuspiciousWarn CheckExplanation
_) = Maybe (Either PackageCheck PackageCheck)
forall a. Maybe a
Nothing
    classEW (PackageDistInexcusable CheckExplanation
_) = Maybe (Either PackageCheck PackageCheck)
forall a. Maybe a
Nothing

-- | Perform checks if a shared executable can be built
checkSharedExes
  :: Verbosity
  -> LocalBuildInfo
  -> IO ()
checkSharedExes :: Verbosity -> LocalBuildInfo -> IO ()
checkSharedExes Verbosity
verbosity LocalBuildInfo
lbi =
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (OS
os OS -> OS -> Bool
forall a. Eq a => a -> a -> Bool
== OS
Windows) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
      OS -> ProgArg -> CabalException
NoOSSupport OS
os ProgArg
"shared executables"
  where
    (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi

-- | 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 =
  [IO ()] -> IO ()
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 =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (OS
os OS -> [OS] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [OS
OSX, OS
Linux]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          OS -> ProgArg -> CabalException
NoOSSupport OS
os ProgArg
"relocatable builds"
      where
        (Platform Arch
_ OS
os) = LocalBuildInfo -> Platform
hostPlatform LocalBuildInfo
lbi

    -- Check if the Compiler support relocatable builds
    checkCompiler :: IO ()
checkCompiler =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Compiler -> CompilerFlavor
compilerFlavor Compiler
comp CompilerFlavor -> [CompilerFlavor] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CompilerFlavor
GHC]) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          ProgArg -> CabalException
NoCompilerSupport (Compiler -> ProgArg
forall a. Show a => a -> ProgArg
show Compiler
comp)
      where
        comp :: Compiler
comp = LocalBuildInfo -> Compiler
compiler LocalBuildInfo
lbi

    -- Check if all the install dirs are relative to same prefix
    packagePrefixRelative :: IO ()
packagePrefixRelative =
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (InstallDirs ProgArg -> Bool
relativeInstallDirs InstallDirs ProgArg
installDirs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Verbosity -> CabalException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity (CabalException -> IO ()) -> CabalException -> IO ()
forall a b. (a -> b) -> a -> b
$
          InstallDirs ProgArg -> CabalException
InstallDirsNotPrefixRelative (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 = InstallDirs ProgArg -> ProgArg
forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
installDirs
        relativeInstallDirs :: InstallDirs ProgArg -> Bool
relativeInstallDirs (InstallDirs{ProgArg
prefix :: forall dir. InstallDirs dir -> dir
bindir :: forall dir. InstallDirs dir -> dir
libdir :: forall dir. InstallDirs dir -> dir
dynlibdir :: forall dir. InstallDirs dir -> dir
libexecdir :: forall dir. InstallDirs dir -> dir
datadir :: forall dir. InstallDirs dir -> dir
docdir :: forall dir. InstallDirs dir -> dir
sysconfdir :: forall dir. InstallDirs dir -> dir
prefix :: ProgArg
bindir :: ProgArg
libdir :: ProgArg
libsubdir :: ProgArg
dynlibdir :: ProgArg
flibdir :: ProgArg
libexecdir :: ProgArg
libexecsubdir :: ProgArg
includedir :: ProgArg
datadir :: ProgArg
datasubdir :: ProgArg
docdir :: ProgArg
mandir :: ProgArg
htmldir :: ProgArg
haddockdir :: ProgArg
sysconfdir :: 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
..}) =
          (Maybe ProgArg -> Bool) -> [Maybe ProgArg] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all
            Maybe ProgArg -> Bool
forall a. Maybe a -> Bool
isJust
            ( (ProgArg -> Maybe ProgArg) -> [ProgArg] -> [Maybe ProgArg]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
                (ProgArg -> ProgArg -> Maybe ProgArg
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
      pkgr <- Verbosity
-> LocalBuildInfo
-> PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
-> IO (SymbolicPath CWD ('Dir Pkg))
GHC.pkgRoot Verbosity
verbosity LocalBuildInfo
lbi (PackageDBStack -> PackageDBX (SymbolicPath Pkg ('Dir PkgDB))
forall from. PackageDBStackX from -> PackageDBX from
registrationPackageDB (LocalBuildInfo -> PackageDBStack
withPackageDB LocalBuildInfo
lbi))
      traverse_ (doCheck $ getSymbolicPath pkgr) ipkgs
      where
        doCheck :: ProgArg -> InstalledPackageInfo -> IO ()
doCheck ProgArg
pkgr InstalledPackageInfo
ipkg
          | Bool -> (ProgArg -> Bool) -> Maybe ProgArg -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (ProgArg -> ProgArg -> Bool
forall a. Eq a => a -> a -> Bool
== ProgArg
pkgr) (InstalledPackageInfo -> Maybe ProgArg
IPI.pkgRoot InstalledPackageInfo
ipkg) =
              [ProgArg] -> (ProgArg -> IO ()) -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (InstalledPackageInfo -> [ProgArg]
IPI.libraryDirs InstalledPackageInfo
ipkg) ((ProgArg -> IO ()) -> IO ()) -> (ProgArg -> IO ()) -> IO ()
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@.
                canonicalized <- ProgArg -> IO ProgArg
canonicalizePath ProgArg
libdir
                -- The @prefix@ itself must also be canonicalized because
                -- canonicalizing @libdir@ may expand symlinks which would make
                -- @prefix@ no longer being a prefix of @canonical libdir@,
                -- while @canonical p@ could be a prefix of @canonical libdir@
                p' <- canonicalizePath p
                unless (p' `isPrefixOf` canonicalized) $
                  dieWithException verbosity $
                    LibDirDepsPrefixNotRelative libdir p
          | Bool
otherwise =
              () -> IO ()
forall a. a -> IO a
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 = InstallDirs ProgArg -> ProgArg
forall dir. InstallDirs dir -> dir
prefix InstallDirs ProgArg
installDirs
        ipkgs :: [InstalledPackageInfo]
ipkgs = InstalledPackageIndex -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
PackageIndex.allPackages (LocalBuildInfo -> InstalledPackageIndex
installedPkgs LocalBuildInfo
lbi)

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

unsupportedForeignLibs :: Compiler -> Platform -> [ForeignLib] -> [String]
unsupportedForeignLibs :: Compiler -> Platform -> [ForeignLib] -> [ProgArg]
unsupportedForeignLibs Compiler
comp Platform
platform =
  (ForeignLib -> Maybe ProgArg) -> [ForeignLib] -> [ProgArg]
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 Version -> Version -> Bool
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 ([RelativePath Source 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> [RelativePath Source 'File]
foreignLibModDefFile ForeignLib
flib)) =
          [ProgArg] -> Maybe ProgArg
unsupported
            [ ProgArg
"Module definition file not supported on OSX"
            ]
      | Bool -> Bool
not (Maybe LibVersionInfo -> Bool
forall a. Maybe a -> Bool
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 =
          Maybe ProgArg
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 ([RelativePath Source 'File] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> [RelativePath Source 'File]
foreignLibModDefFile ForeignLib
flib)) =
          [ProgArg] -> Maybe ProgArg
unsupported
            [ ProgArg
"Module definition file not supported on Linux"
            ]
      | Bool -> Bool
not (Maybe LibVersionInfo -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (ForeignLib -> Maybe LibVersionInfo
foreignLibVersionInfo ForeignLib
flib))
          Bool -> Bool -> Bool
&& Bool -> Bool
not (Maybe Version -> Bool
forall a. Maybe a -> Bool
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 =
          Maybe ProgArg
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 (Maybe LibVersionInfo -> Bool
forall a. Maybe a -> Bool
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 =
          Maybe ProgArg
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 ForeignLibOption -> [ForeignLibOption] -> Bool
forall a. Eq a => a -> [a] -> Bool
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 = ProgArg -> Maybe ProgArg
forall a. a -> Maybe a
Just (ProgArg -> Maybe ProgArg)
-> ([ProgArg] -> ProgArg) -> [ProgArg] -> Maybe ProgArg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ProgArg] -> ProgArg
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat