Configure.hs 87.8 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable #-}
2
{-# LANGUAGE FlexibleContexts #-}
3
{-# LANGUAGE OverloadedStrings #-}
4
{-# LANGUAGE RankNTypes #-}
5
{-# LANGUAGE RecordWildCards #-}
6
{-# LANGUAGE ScopedTypeVariables #-}
7

8 9
-----------------------------------------------------------------------------
-- |
ijones's avatar
ijones committed
10
-- Module      :  Distribution.Simple.Configure
11
-- Copyright   :  Isaac Jones 2003-2005
12
-- License     :  BSD3
13
--
Duncan Coutts's avatar
Duncan Coutts committed
14
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
15
-- Portability :  portable
16
--
Duncan Coutts's avatar
Duncan Coutts committed
17 18 19 20 21 22 23 24
-- 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)
25
--
Duncan Coutts's avatar
Duncan Coutts committed
26 27 28 29
-- 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.
30

ijones's avatar
ijones committed
31 32
module Distribution.Simple.Configure (configure,
                                      writePersistBuildConfig,
33
                                      getConfigStateFile,
ijones's avatar
ijones committed
34
                                      getPersistBuildConfig,
35
                                      checkPersistBuildConfigOutdated,
36
                                      tryGetPersistBuildConfig,
37
                                      maybeGetPersistBuildConfig,
38
                                      findDistPref, findDistPrefOrDefault,
39
                                      getInternalPackages,
40
                                      computeComponentId,
41
                                      computeCompatPackageKey,
42
                                      computeCompatPackageName,
ijones's avatar
ijones committed
43
                                      localBuildInfoFile,
44 45 46
                                      getInstalledPackages,
                                      getInstalledPackagesMonitorFiles,
                                      getPackageDBContents,
47
                                      configCompiler, configCompilerAux,
48
                                      configCompilerEx, configCompilerAuxEx,
49
                                      computeEffectiveProfiling,
50
                                      ccLdOptionsBuildInfo,
51
                                      checkForeignDeps,
52
                                      interpretPackageDbFlags,
53
                                      ConfigStateFileError(..),
54
                                      tryGetConfigStateFile,
55
                                      platformDefines,
56
                                      relaxPackageDeps,
ijones's avatar
ijones committed
57
                                     )
ijones's avatar
ijones committed
58
    where
59

60 61 62
import Prelude ()
import Distribution.Compat.Prelude

63
import Distribution.Compiler
64
import Distribution.Types.IncludeRenaming
65
import Distribution.Utils.NubList
66 67
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.PreProcess
68
import Distribution.Package
69
import qualified Distribution.InstalledPackageInfo as Installed
70
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
71
import qualified Distribution.Simple.PackageIndex as PackageIndex
72
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
73
import Distribution.PackageDescription as PD hiding (Flag)
74
import Distribution.Types.PackageDescription as PD
75
import Distribution.PackageDescription.PrettyPrint
76
import Distribution.PackageDescription.Configuration
77
import Distribution.PackageDescription.Check hiding (doesFileExist)
78
import Distribution.Simple.BuildToolDepends
79
import Distribution.Simple.Program
80
import Distribution.Simple.Setup as Setup
81
import Distribution.Simple.BuildTarget
82
import Distribution.Simple.LocalBuildInfo
83
import Distribution.Types.Dependency
84
import Distribution.Types.ExeDependency
85 86
import Distribution.Types.LegacyExeDependency
import Distribution.Types.PkgconfigDependency
87
import Distribution.Types.LocalBuildInfo
88
import Distribution.Types.ComponentRequestedSpec
89 90 91
import Distribution.Types.ForeignLib
import Distribution.Types.ForeignLibType
import Distribution.Types.ForeignLibOption
92
import Distribution.Types.Mixin
93
import Distribution.Types.UnqualComponentName
94 95 96 97
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
import Distribution.Verbosity
98
import qualified Distribution.Compat.Graph as Graph
99
import Distribution.Compat.Stack
100
import Distribution.Backpack.Configure
101
import Distribution.Backpack.DescribeUnitId
102 103 104 105
import Distribution.Backpack.PreExistingComponent
import Distribution.Backpack.ConfiguredComponent (newPackageDepsBehaviour)
import Distribution.Backpack.Id
import Distribution.Utils.LogProgress
106

107 108 109 110 111
import qualified Distribution.Simple.GHC   as GHC
import qualified Distribution.Simple.GHCJS as GHCJS
import qualified Distribution.Simple.JHC   as JHC
import qualified Distribution.Simple.LHC   as LHC
import qualified Distribution.Simple.UHC   as UHC
112
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
113

114
import Control.Exception
115
    ( ErrorCall, Exception, evaluate, throw, throwIO, try )
116
import Distribution.Compat.Binary ( decodeOrFailIO, encode )
117
import Data.ByteString.Lazy (ByteString)
118 119
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
120
import Data.List
121
    ( (\\), partition, inits, stripPrefix )
122 123
import Data.Either
    ( partitionEithers )
124
import qualified Data.Map as Map
125
import System.Directory
126
    ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
127
import System.FilePath
128
    ( (</>), isAbsolute )
129
import qualified System.Info
130
    ( compilerName, compilerVersion )
131
import System.IO
132
    ( hPutStrLn, hClose )
133
import Distribution.Text
134
    ( Text(disp), defaultStyle, display, simpleParse )
dterei's avatar
dterei committed
135
import Text.PrettyPrint
136
    ( Doc, (<+>), ($+$), char, comma, hsep, nest
137
    , punctuate, quotes, render, renderStyle, sep, text )
138
import Distribution.Compat.Environment ( lookupEnv )
139
import Distribution.Compat.Exception ( catchExit, catchIO )
140

141 142
type UseExternalInternalDeps = Bool

143
-- | The errors that can be thrown when reading the @setup-config@ file.
144
data ConfigStateFileError
145 146 147 148
    = ConfigStateFileNoHeader -- ^ No header found.
    | ConfigStateFileBadHeader -- ^ Incorrect header.
    | ConfigStateFileNoParse -- ^ Cannot parse file contents.
    | ConfigStateFileMissing -- ^ No file!
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
149 150
    | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
      (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
151 152
  deriving (Typeable)

153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174
-- | Format a 'ConfigStateFileError' as a user-facing error message.
dispConfigStateFileError :: ConfigStateFileError -> Doc
dispConfigStateFileError ConfigStateFileNoHeader =
    text "Saved package config file header is missing."
    <+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileBadHeader =
    text "Saved package config file header is corrupt."
    <+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileNoParse =
    text "Saved package config file is corrupt."
    <+> text "Re-run the 'configure' command."
dispConfigStateFileError ConfigStateFileMissing =
    text "Run the 'configure' command first."
dispConfigStateFileError (ConfigStateFileBadVersion oldCabal oldCompiler _) =
    text "Saved package config file is outdated:"
    $+$ badCabal $+$ badCompiler
    $+$ text "Re-run the 'configure' command."
    where
      badCabal =
          text "• the Cabal version changed from"
          <+> disp oldCabal <+> "to" <+> disp currentCabalId
      badCompiler
175
        | oldCompiler == currentCompilerId = mempty
176 177 178 179
        | otherwise =
            text "• the compiler changed from"
            <+> disp oldCompiler <+> "to" <+> disp currentCompilerId

180
instance Show ConfigStateFileError where
181
    show = renderStyle defaultStyle . dispConfigStateFileError
182 183

instance Exception ConfigStateFileError
184

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
185
-- | Read the 'localBuildInfoFile'.  Throw an exception if the file is
186 187 188 189
-- missing, if the file cannot be read, or if the file was created by an older
-- version of Cabal.
getConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
                   -> IO LocalBuildInfo
190
getConfigStateFile filename = do
191
    exists <- doesFileExist filename
192
    unless exists $ throwIO ConfigStateFileMissing
193 194 195 196
    -- 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])
197

198 199 200
    headerParseResult <- try $ evaluate $ parseHeader header
    let (cabalId, compId) =
            case headerParseResult of
201
              Left (_ :: ErrorCall) -> throw ConfigStateFileBadHeader
202 203
              Right x -> x

204
    let getStoredValue = do
205
          result <- decodeOrFailIO (BLC8.tail body)
206 207 208
          case result of
            Left _ -> throw ConfigStateFileNoParse
            Right x -> return x
209
        deferErrorIfBadVersion act
210
          | cabalId /= currentCabalId = do
211 212 213 214
              eResult <- try act
              throw $ ConfigStateFileBadVersion cabalId compId eResult
          | otherwise = act
    deferErrorIfBadVersion getStoredValue
215 216
  where
    _ = callStack -- TODO: attach call stack to exception
217

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
218 219
-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
220
tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
221 222
                      -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = try . getConfigStateFile
223

224 225
-- | Try to read the 'localBuildInfoFile'.
tryGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
226 227
                         -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig = try . getPersistBuildConfig
228

229 230 231
-- | 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.
232 233
getPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                      -> IO LocalBuildInfo
234
getPersistBuildConfig = getConfigStateFile . localBuildInfoFile
235

236 237 238
-- | Try to read the 'localBuildInfoFile'.
maybeGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                           -> IO (Maybe LocalBuildInfo)
239 240
maybeGetPersistBuildConfig =
    liftM (either (const Nothing) Just) . tryGetPersistBuildConfig
ijones's avatar
ijones committed
241

242
-- | After running configure, output the 'LocalBuildInfo' to the
ijones's avatar
ijones committed
243
-- 'localBuildInfoFile'.
244
writePersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
245
                        -> LocalBuildInfo -- ^ The 'LocalBuildInfo' to write.
246
                        -> NoCallStackIO ()
247
writePersistBuildConfig distPref lbi = do
248 249
    createDirectoryIfMissing False distPref
    writeFileAtomic (localBuildInfoFile distPref) $
250
      BLC8.unlines [showHeader pkgId, encode lbi]
251
  where
252
    pkgId = localPackage lbi
253

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
254
-- | Identifier of the current Cabal package.
255
currentCabalId :: PackageIdentifier
256
currentCabalId = PackageIdentifier (mkPackageName "Cabal") cabalVersion
257

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
258
-- | Identifier of the current compiler package.
259
currentCompilerId :: PackageIdentifier
260
currentCompilerId = PackageIdentifier (mkPackageName System.Info.compilerName)
261
                                      (mkVersion' System.Info.compilerVersion)
262

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
263
-- | Parse the @setup-config@ file header, returning the package identifiers
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
264
-- for Cabal and the compiler.
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
265
parseHeader :: ByteString -- ^ The file contents.
266
            -> (PackageIdentifier, PackageIdentifier)
267
parseHeader header = case BLC8.words header of
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
268 269
  ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId,
   "using", compId] ->
270
      fromMaybe (throw ConfigStateFileBadHeader) $ do
271 272 273
          _ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier
          cabalId' <- simpleParse (BLC8.unpack cabalId)
          compId' <- simpleParse (BLC8.unpack compId)
274 275
          return (cabalId', compId')
  _ -> throw ConfigStateFileNoHeader
276

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
277
-- | Generate the @setup-config@ file header.
278 279
showHeader :: PackageIdentifier -- ^ The processed package.
            -> ByteString
280
showHeader pkgId = BLC8.unwords
281
    [ "Saved", "package", "config", "for"
282
    , BLC8.pack $ display pkgId
283
    , "written", "by"
284
    , BLC8.pack $ display currentCabalId
285
    , "using"
286
    , BLC8.pack $ display currentCompilerId
287
    ]
288

289
-- | Check that localBuildInfoFile is up-to-date with respect to the
290
-- .cabal file.
291
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> NoCallStackIO Bool
292
checkPersistBuildConfigOutdated distPref pkg_descr_file = do
293
  pkg_descr_file `moreRecentFile` (localBuildInfoFile distPref)
294

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
295
-- | Get the path of @dist\/setup-config@.
296 297
localBuildInfoFile :: FilePath -- ^ The @dist@ directory path.
                    -> FilePath
298
localBuildInfoFile distPref = distPref </> "setup-config"
ijones's avatar
ijones committed
299

300
-- -----------------------------------------------------------------------------
ijones's avatar
ijones committed
301 302
-- * Configuration
-- -----------------------------------------------------------------------------
303

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
304 305 306
-- | 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.
307 308
findDistPref :: FilePath  -- ^ default \"dist\" prefix
             -> Setup.Flag FilePath  -- ^ override \"dist\" prefix
309
             -> NoCallStackIO FilePath
310 311 312 313 314 315 316 317 318
findDistPref defDistPref overrideDistPref = do
    envDistPref <- liftM parseEnvDistPref (lookupEnv "CABAL_BUILDDIR")
    return $ fromFlagOrDefault defDistPref (mappend envDistPref overrideDistPref)
  where
    parseEnvDistPref env =
      case env of
        Just distPref | not (null distPref) -> toFlag distPref
        _ -> NoFlag

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
319 320 321 322 323 324
-- | 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'.)
325
findDistPrefOrDefault :: Setup.Flag FilePath  -- ^ override \"dist\" prefix
326
                      -> NoCallStackIO FilePath
327 328
findDistPrefOrDefault = findDistPref defaultDistPref

329 330
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
331
configure :: (GenericPackageDescription, HookedBuildInfo)
332
          -> ConfigFlags -> IO LocalBuildInfo
333 334
configure (pkg_descr0', pbi) cfg = do
    let pkg_descr0 =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
335 336
          -- Ignore '--allow-{older,newer}' when we're given
          -- '--exact-configuration'.
337 338
          if fromFlagOrDefault False (configExactConfiguration cfg)
          then pkg_descr0'
339 340 341
          else relaxPackageDeps removeLowerBound
               (maybe RelaxDepsNone unAllowOlder $ configAllowOlder cfg) $
               relaxPackageDeps removeUpperBound
342
               (maybe RelaxDepsNone unAllowNewer $ configAllowNewer cfg)
343
               pkg_descr0'
344

345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363
    -- 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 = flattenPackageDescription pkg_descr0
        targets <- readBuildTargets flat_pkg_descr (configArgs cfg)
        -- TODO: bleat if you use the module/file syntax
        let targets' = [ cname | BuildTargetComponent cname <- targets ]
        case targets' of
            _ | null (configArgs cfg) -> return Nothing
            [cname] -> return (Just cname)
            [] -> die "No valid component targets found"
            _ -> die "Can only configure either single component or all of them"

    let use_external_internal_deps = isJust mb_cname
    case mb_cname of
        Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0)
364 365
        Just cname -> setupMessage' verbosity "Configuring" (packageId pkg_descr0)
                        cname (Just (configInstantiateWith cfg))
366 367 368 369

    -- configCID is only valid for per-component configure
    when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
        die "--cid is only supported for per-component configure"
370 371 372 373 374

    checkDeprecatedFlags verbosity cfg
    checkExactConfiguration pkg_descr0 cfg

    -- Where to build the package
375
    let buildDir :: FilePath -- e.g. dist/build
376 377
        -- fromFlag OK due to Distribution.Simple calling
        -- findDistPrefOrDefault to fill it in
378
        buildDir = fromFlag (configDistPref cfg) </> "build"
379 380 381
    createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir

    -- What package database(s) to use
382 383
    let packageDbs :: PackageDBStack
        packageDbs
384 385 386 387 388 389
         = interpretPackageDbFlags
            (fromFlag (configUserInstall cfg))
            (configPackageDBs cfg)

    -- comp:            the compiler we're building with
    -- compPlatform:    the platform we're building for
390
    -- programDb:  location and args of all programs we're
391
    --                  building with
392 393 394
    (comp         :: Compiler,
     compPlatform :: Platform,
     programDb    :: ProgramDb)
395 396 397 398
        <- configCompilerEx
            (flagToMaybe (configHcFlavor cfg))
            (flagToMaybe (configHcPath cfg))
            (flagToMaybe (configHcPkg cfg))
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
399
            (mkProgramDb cfg (configPrograms cfg))
400 401 402
            (lessVerbose verbosity)

    -- The InstalledPackageIndex of all installed packages
403 404
    installedPackageSet :: InstalledPackageIndex
        <- getInstalledPackages (lessVerbose verbosity) comp
405
                                  packageDbs programDb
406

407 408 409
    -- The set of package names which are "shadowed" by internal
    -- packages, and which component they map to
    let internalPackageSet :: Map PackageName ComponentName
410
        internalPackageSet = getInternalPackages pkg_descr0
411

412
    -- Make a data structure describing what components are enabled.
413
    let enabled :: ComponentRequestedSpec
414
        enabled = case mb_cname of
415 416 417 418 419 420 421 422 423 424 425
                    Just cname -> OneComponentRequestedSpec cname
                    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 = fromFlag (configTests cfg)
                                , benchmarksRequested =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
426
                                  fromFlag (configBenchmarks cfg) }
427
    -- Some sanity checks related to enabling components.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
428 429
    when (isJust mb_cname
          && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $
430 431
        die $ "--enable-tests/--enable-benchmarks are incompatible with" ++
              " explicitly specifying a component to configure."
432

433 434 435 436 437 438 439 440 441 442 443 444 445
    -- 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.
446 447 448 449 450 451
    (allConstraints  :: [Dependency],
     requiredDepsMap :: Map PackageName InstalledPackageInfo)
        <- either die return $
              combinedConstraints (configConstraints cfg)
                                  (configDependencies cfg)
                                  installedPackageSet
452

453 454 455 456 457 458 459
    -- pkg_descr:   The resolved package description, that does not contain any
    --              conditionals, because we have 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.
460 461 462 463 464 465 466 467
    --
    -- 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.
468 469
    (pkg_descr :: PackageDescription,
     flags     :: FlagAssignment)
470
        <- configureFinalizedPackage verbosity cfg enabled
471 472
                allConstraints
                (dependencySatisfiable
473
                    use_external_internal_deps
474
                    (fromFlagOrDefault False (configExactConfiguration cfg))
475
                    (packageName pkg_descr0)
476 477 478 479 480 481 482
                    installedPackageSet
                    internalPackageSet
                    requiredDepsMap)
                comp
                compPlatform
                pkg_descr0

483 484 485 486 487 488 489 490 491 492 493 494
    debug verbosity $ "Finalized package description:\n"
                  ++ showPackageDescription pkg_descr
    -- NB: showPackageDescription does not display the AWFUL HACK GLOBAL
    -- buildDepends, so we have to display it separately.  See #2066
    -- Some day, we should eliminate this, so that
    -- configureFinalizedPackage returns the set of overall dependencies
    -- separately.  Then 'configureDependencies' and
    -- 'Distribution.PackageDescription.Check' need to be adjusted
    -- accordingly.
    debug verbosity $ "Finalized build-depends: "
                  ++ intercalate ", " (map display (buildDepends pkg_descr))

495
    checkCompilerProblems comp pkg_descr enabled
496 497 498 499
    checkPackageProblems verbosity pkg_descr0
        (updatePackageDescription pbi pkg_descr)

    -- The list of 'InstalledPackageInfo' recording the selected
500
    -- dependencies on external packages.
501 502 503 504 505 506 507 508 509 510
    --
    -- 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),
511 512 513 514 515 516 517 518 519 520
    --
    -- 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.)
    externalPkgDeps :: [(PackageName, InstalledPackageInfo)]
521 522
        <- configureDependencies
                verbosity
523
                use_external_internal_deps
524 525 526 527 528
                internalPackageSet
                installedPackageSet
                requiredDepsMap
                pkg_descr

529 530 531
    -- Compute installation directory templates, based on user
    -- configuration.
    --
Edward Z. Yang's avatar
Edward Z. Yang committed
532
    -- TODO: Move this into a helper function.
533
    defaultDirs :: InstallDirTemplates
534 535
        <- defaultInstallDirs' use_external_internal_deps
                              (compilerFlavor comp)
536 537 538 539
                              (fromFlag (configUserInstall cfg))
                              (hasLibs pkg_descr)
    let installDirs :: InstallDirTemplates
        installDirs = combineInstallDirs fromFlagOrDefault
540 541
                        defaultDirs (configInstallDirs cfg)

542
    -- Check languages and extensions
Edward Z. Yang's avatar
Edward Z. Yang committed
543
    -- TODO: Move this into a helper function.
544
    let langlist = nub $ catMaybes $ map defaultLanguage
545
                   (enabledBuildInfos pkg_descr enabled)
546 547 548 549 550 551
    let langs = unsupportedLanguages comp langlist
    when (not (null langs)) $
      die $ "The package " ++ display (packageId pkg_descr0)
         ++ " requires the following languages which are not "
         ++ "supported by " ++ display (compilerId comp) ++ ": "
         ++ intercalate ", " (map display langs)
552
    let extlist = nub $ concatMap allExtensions (enabledBuildInfos pkg_descr enabled)
553 554 555 556 557 558 559
    let exts = unsupportedExtensions comp extlist
    when (not (null exts)) $
      die $ "The package " ++ display (packageId pkg_descr0)
         ++ " requires the following language extensions which are not "
         ++ "supported by " ++ display (compilerId comp) ++ ": "
         ++ intercalate ", " (map display exts)

560 561 562 563 564 565 566
    -- Check foreign library build requirements
    let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled]
    let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs
    when (not (null unsupportedFLibs)) $
      die $ "Cannot build some foreign libraries: "
         ++ intercalate "," unsupportedFLibs

567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588
    -- Configure certain external build tools, see below for which ones.
    let requiredBuildTools = do
          bi <- enabledBuildInfos pkg_descr enabled
          -- First, we collect any tool dep that we know is external. This is,
          -- in practice:
          --
          -- 1. `build-tools` entries on the whitelist
          --
          -- 2. `build-tool-depends` that aren't from the current package.
          let externBuildToolDeps =
                [ LegacyExeDependency (unUnqualComponentName eName) versionRange
                | buildTool@(ExeDependency _ eName versionRange)
                  <- getAllToolDependencies pkg_descr bi
                , not $ isInternal pkg_descr 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 =
                [ buildTool
                | buildTool <- buildTools bi
                , Nothing == desugarBuildTool pkg_descr buildTool ]
          externBuildToolDeps ++ unknownBuildTools
589

590 591
    programDb' <-
          configureAllKnownPrograms (lessVerbose verbosity) programDb
592 593
      >>= configureRequiredPrograms verbosity requiredBuildTools

594
    (pkg_descr', programDb'') <-
595
      configurePkgconfigPackages verbosity pkg_descr programDb' enabled
596

597 598 599 600 601 602
    -- 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.
603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619
    -- internalPackageSet
    -- use_external_internal_deps
    (buildComponents :: [ComponentLocalBuildInfo],
     packageDependsIndex :: InstalledPackageIndex) <-
      let prePkgDeps = map ipiToPreExistingComponent externalPkgDeps
      in runLogProgress verbosity $ configureComponentLocalBuildInfos
            verbosity
            use_external_internal_deps
            enabled
            (configIPID cfg)
            (configCID cfg)
            pkg_descr
            prePkgDeps
            (configConfigurationsFlags cfg)
            (configInstantiateWith cfg)
            installedPackageSet
            comp
620

621 622
    -- Decide if we're going to compile with split objects.
    split_objs :: Bool <-
623 624 625
       if not (fromFlag $ configSplitObjs cfg)
            then return False
            else case compilerFlavor comp of
626
                        GHC | compilerVersion comp >= mkVersion [6,5]
627 628 629 630 631 632 633 634 635 636 637 638 639 640 641 642 643 644 645 646 647 648 649 650 651 652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673 674 675
                          -> return True
                        GHCJS
                          -> return True
                        _ -> do warn verbosity
                                     ("this compiler does not support " ++
                                      "--enable-split-objs; ignoring")
                                return False

    let ghciLibByDefault =
          case compilerId comp of
            CompilerId GHC _ ->
              -- 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).
              not (GHC.isDynamic comp)
            CompilerId GHCJS _ ->
              not (GHCJS.isDynamic comp)
            _ -> False

    let sharedLibsByDefault
          | fromFlag (configDynExe cfg) =
              -- build a shared library if dynamically-linked
              -- executables are requested
              True
          | otherwise = case compilerId comp of
            CompilerId GHC _ ->
              -- if ghc is dynamic, then ghci needs a shared
              -- library, so we build one by default.
              GHC.isDynamic comp
            CompilerId GHCJS _ ->
              GHCJS.isDynamic comp
            _ -> 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.
            fromFlagOrDefault sharedLibsByDefault $ configSharedLib cfg
        withDynExe_ = fromFlag $ configDynExe cfg
    when (withDynExe_ && not withSharedLib_) $ 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."

676
    setProfLBI <- configureProfiling verbosity cfg comp
677

678
    setCoverageLBI <- configureCoverage verbosity cfg comp
679 680 681 682 683 684

    reloc <-
       if not (fromFlag $ configRelocatable cfg)
            then return False
            else return True

685
    let buildComponentsMap =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
686 687
            foldl' (\m clbi -> Map.insertWith (++)
                               (componentLocalName clbi) [clbi] m)
688 689
                   Map.empty buildComponents

690
    let lbi = (setCoverageLBI . setProfLBI)
691 692
              LocalBuildInfo {
                configFlags         = cfg,
693
                flagAssignment      = flags,
694
                componentEnabledSpec = enabled,
695 696 697 698 699 700 701
                extraConfigArgs     = [],  -- Currently configure does not
                                           -- take extra args, but if it
                                           -- did they would go here.
                installDirTemplates = installDirs,
                compiler            = comp,
                hostPlatform        = compPlatform,
                buildDir            = buildDir,
702
                componentGraph      = Graph.fromDistinctList buildComponents,
703
                componentNameMap    = buildComponentsMap,
704 705 706
                installedPkgs       = packageDependsIndex,
                pkgDescrFile        = Nothing,
                localPkgDescr       = pkg_descr',
707
                withPrograms        = programDb'',
708 709 710
                withVanillaLib      = fromFlag $ configVanillaLib cfg,
                withSharedLib       = withSharedLib_,
                withDynExe          = withDynExe_,
711 712 713 714
                withProfLib         = False,
                withProfLibDetail   = ProfDetailNone,
                withProfExe         = False,
                withProfExeDetail   = ProfDetailNone,
715 716 717 718 719 720 721
                withOptimization    = fromFlag $ configOptimization cfg,
                withDebugInfo       = fromFlag $ configDebugInfo cfg,
                withGHCiLib         = fromFlagOrDefault ghciLibByDefault $
                                      configGHCiLib cfg,
                splitObjs           = split_objs,
                stripExes           = fromFlag $ configStripExes cfg,
                stripLibs           = fromFlag $ configStripLibs cfg,
722 723
                exeCoverage         = False,
                libCoverage         = False,
724 725 726 727
                withPackageDB       = packageDbs,
                progPrefix          = fromFlag $ configProgPrefix cfg,
                progSuffix          = fromFlag $ configProgSuffix cfg,
                relocatable         = reloc
728
              }
729 730 731

    when reloc (checkRelocatable verbosity pkg_descr lbi)

732 733
    -- TODO: This is not entirely correct, because the dirs may vary
    -- across libraries/executables
734 735
    let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
        relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
736 737 738 739 740 741 742 743 744 745 746 747 748 749 750 751 752 753 754

    unless (isAbsolute (prefix dirs)) $ die $
        "expected an absolute directory name for --prefix: " ++ prefix dirs

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

    let dirinfo name dir isPrefixRelative =
          info verbosity $ name ++ " installed in: " ++ dir ++ relNote
          where relNote = case buildOS of
                  Windows | not (hasLibs pkg_descr)
                         && isNothing isPrefixRelative
                         -> "  (fixed location)"
                  _      -> ""

    dirinfo "Binaries"         (bindir dirs)     (bindir relative)
    dirinfo "Libraries"        (libdir dirs)     (libdir relative)
Christiaan Baaij's avatar
Christiaan Baaij committed
755
    dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative)
756 757 758 759 760 761
    dirinfo "Private binaries" (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
762
              | (prog, configuredProg) <- knownPrograms programDb'' ]
763 764

    return lbi
765

766
    where
767 768
      verbosity = fromFlag (configVerbosity cfg)

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
769 770
mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb cfg initialProgramDb = programDb
771
  where
772 773 774
    programDb  = userSpecifyArgss (configProgramArgs cfg)
                 . userSpecifyPaths (configProgramPaths cfg)
                 . setProgramSearchPath searchpath
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
775 776
                 $ initialProgramDb
    searchpath = getProgramSearchPath (initialProgramDb)
777 778
                 ++ map ProgramSearchPathDir
                 (fromNubList $ configProgramPathExtra cfg)
779

780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806 807 808
-- -----------------------------------------------------------------------------
-- Helper functions for configure

-- | Check if the user used any deprecated flags.
checkDeprecatedFlags :: Verbosity -> ConfigFlags -> IO ()
checkDeprecatedFlags verbosity cfg = do
    unless (configProfExe cfg == NoFlag) $ do
      let enable | fromFlag (configProfExe cfg) = "enable"
                 | otherwise = "disable"
      warn verbosity
        ("The flag --" ++ enable ++ "-executable-profiling is deprecated. "
         ++ "Please use --" ++ enable ++ "-profiling instead.")

    unless (configLibCoverage cfg == NoFlag) $ do
      let enable | fromFlag (configLibCoverage cfg) = "enable"
                 | otherwise = "disable"
      warn verbosity
        ("The flag --" ++ enable ++ "-library-coverage is deprecated. "
         ++ "Please use --" ++ enable ++ "-coverage instead.")

-- | Sanity check: if '--exact-configuration' was given, ensure that the
-- complete flag assignment was specified on the command line.
checkExactConfiguration :: GenericPackageDescription -> ConfigFlags -> IO ()
checkExactConfiguration pkg_descr0 cfg = do
    when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do
      let cmdlineFlags = map fst (configConfigurationsFlags cfg)
          allFlags     = map flagName . genPackageFlags $ pkg_descr0
          diffFlags    = allFlags \\ cmdlineFlags
      when (not . null $ diffFlags) $
809
        die $ "'--exact-configuration' was given, "
810 811 812 813 814 815 816 817 818
        ++ "but the following flags were not specified: "
        ++ intercalate ", " (map show 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
819
-- file, and we haven't resolved them yet.  finalizePD
820 821 822
-- does the resolution of conditionals, and it takes internalPackageSet
-- as part of its input.
getInternalPackages :: GenericPackageDescription
823
                    -> Map PackageName ComponentName
824
getInternalPackages pkg_descr0 =
825
    -- TODO: some day, executables will be fair game here too!
826
    let pkg_descr = flattenPackageDescription pkg_descr0
827 828
        f lib = case libName lib of
                    Nothing -> (packageName pkg_descr, CLibName)
829
                    Just n' -> (unqualComponentNameToPackageName n', CSubLibName n')
830 831
    in Map.fromList (map f (allLibraries pkg_descr))

832 833 834
-- | 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 finalizePD.
835
dependencySatisfiable
836 837 838
    :: Bool -- ^ use external internal deps?
    -> Bool -- ^ exact configuration?
    -> PackageName
839
    -> InstalledPackageIndex -- ^ installed set
840
    -> Map PackageName ComponentName -- ^ internal set
841 842 843
    -> Map PackageName InstalledPackageInfo -- ^ required dependencies
    -> (Dependency -> Bool)
dependencySatisfiable
844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892 893 894 895 896
  use_external_internal_deps
  exact_config pn installedPackageSet internalPackageSet requiredDepsMap
  (Dependency depName0 vr)

    -- When we are doing per-component configure, the behavior is very
    -- uniform: if an exact configuration is requested, check for the
    -- dep in requiredDepsMap; otherwise, check if the dep is in
    -- the index
    | use_external_internal_deps
    = depSatisfiable

    -- If we are not per-component, internal dependencies need to
    -- be treated specially
    | otherwise
    = if isInternalDep
        -- If a 'PackageName' is defined by an internal component, the dep is
        -- satisfiable (we're going to build it ourselves)
        then True
        -- Otherwise, handle as before
        else depSatisfiable

  where
    isInternalDep = Map.member depName0 internalPackageSet

    -- 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?
    depSatisfiable =
      if exact_config
          -- NB: required deps map is indexed by *compat* package name.
          then depName `Map.member` requiredDepsMap
          else not . null . PackageIndex.lookupDependency installedPackageSet $ d

    -- When it's an internal library, we have to lookup the *compat*
    -- package name in the database; the real one won't match anything
    d = Dependency depName vr
    depName
      | isInternalDep && pn /= depName0
      = computeCompatPackageName pn
            -- TODO: Don't go through String
            -- TODO: Hard-coding this to be a sub-library is a
            -- bit grotty, but currently it seems that this
            -- function is only called on build-depends
            -- dependencies, which must be libraries.  If
            -- pn /= depName0, then it must be a sub library!
            (CSubLibName (mkUnqualComponentName (unPackageName depName0)))
      | otherwise = depName0
897

898
-- | Relax the dependencies of this package if needed.
899 900 901 902 903
relaxPackageDeps :: (VersionRange -> VersionRange)
                 -> RelaxDeps
                 -> GenericPackageDescription -> GenericPackageDescription
relaxPackageDeps _ RelaxDepsNone gpd = gpd
relaxPackageDeps vrtrans RelaxDepsAll  gpd = transformAllBuildDepends relaxAll gpd
904 905
  where
    relaxAll = \(Dependency pkgName verRange) ->