Configure.hs 88.4 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,
ijones's avatar
ijones committed
56
                                     )
ijones's avatar
ijones committed
57
    where
58

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

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

106
107
108
109
110
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
111
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
112

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

140
141
type UseExternalInternalDeps = Bool

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

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
-- | 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
174
        | oldCompiler == currentCompilerId = mempty
175
176
177
178
        | otherwise =
            text "• the compiler changed from"
            <+> disp oldCompiler <+> "to" <+> disp currentCompilerId

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

instance Exception ConfigStateFileError
183

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
184
-- | Read the 'localBuildInfoFile'.  Throw an exception if the file is
185
186
187
188
-- 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
189
getConfigStateFile filename = do
190
    exists <- doesFileExist filename
191
    unless exists $ throwIO ConfigStateFileMissing
192
193
194
195
    -- 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])
196

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

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

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

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

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

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

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

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

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

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

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

288
-- | Check that localBuildInfoFile is up-to-date with respect to the
289
-- .cabal file.
290
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> NoCallStackIO Bool
Pranit Bauva's avatar
Pranit Bauva committed
291
292
checkPersistBuildConfigOutdated distPref pkg_descr_file =
  pkg_descr_file `moreRecentFile` localBuildInfoFile distPref
293

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

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

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
303
304
305
-- | 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.
306
307
findDistPref :: FilePath  -- ^ default \"dist\" prefix
             -> Setup.Flag FilePath  -- ^ override \"dist\" prefix
308
             -> NoCallStackIO FilePath
309
310
311
312
313
314
315
316
317
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
318
319
320
321
322
323
-- | 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'.)
324
findDistPrefOrDefault :: Setup.Flag FilePath  -- ^ override \"dist\" prefix
325
                      -> NoCallStackIO FilePath
326
327
findDistPrefOrDefault = findDistPref defaultDistPref

328
329
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
330
configure :: (GenericPackageDescription, HookedBuildInfo)
331
          -> ConfigFlags -> IO LocalBuildInfo
332
configure (pkg_descr0, pbi) cfg = do
333
334
335
336
337
338
339
    -- 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
340
        targets <- readBuildTargets verbosity flat_pkg_descr (configArgs cfg)
341
342
343
344
345
        -- 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)
346
347
            [] -> die' verbosity "No valid component targets found"
            _ -> die' verbosity "Can only configure either single component or all of them"
348
349
350
351

    let use_external_internal_deps = isJust mb_cname
    case mb_cname of
        Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0)
352
353
        Just cname -> setupMessage' verbosity "Configuring" (packageId pkg_descr0)
                        cname (Just (configInstantiateWith cfg))
354
355
356

    -- configCID is only valid for per-component configure
    when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $
357
        die' verbosity "--cid is only supported for per-component configure"
358
359

    checkDeprecatedFlags verbosity cfg
360
    checkExactConfiguration verbosity pkg_descr0 cfg
361
362

    -- Where to build the package
363
    let buildDir :: FilePath -- e.g. dist/build
364
365
        -- fromFlag OK due to Distribution.Simple calling
        -- findDistPrefOrDefault to fill it in
366
        buildDir = fromFlag (configDistPref cfg) </> "build"
367
368
369
    createDirectoryIfMissingVerbose (lessVerbose verbosity) True buildDir

    -- What package database(s) to use
370
371
    let packageDbs :: PackageDBStack
        packageDbs
372
373
374
375
376
377
         = interpretPackageDbFlags
            (fromFlag (configUserInstall cfg))
            (configPackageDBs cfg)

    -- comp:            the compiler we're building with
    -- compPlatform:    the platform we're building for
378
    -- programDb:  location and args of all programs we're
379
    --                  building with
380
381
382
    (comp         :: Compiler,
     compPlatform :: Platform,
     programDb    :: ProgramDb)
383
384
385
386
        <- configCompilerEx
            (flagToMaybe (configHcFlavor cfg))
            (flagToMaybe (configHcPath cfg))
            (flagToMaybe (configHcPkg cfg))
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
387
            (mkProgramDb cfg (configPrograms cfg))
388
389
390
            (lessVerbose verbosity)

    -- The InstalledPackageIndex of all installed packages
391
392
    installedPackageSet :: InstalledPackageIndex
        <- getInstalledPackages (lessVerbose verbosity) comp
393
                                  packageDbs programDb
394

395
396
    -- The set of package names which are "shadowed" by internal
    -- packages, and which component they map to
397
    let internalPackageSet :: Map PackageName (Maybe UnqualComponentName)
398
        internalPackageSet = getInternalPackages pkg_descr0
399

400
    -- Make a data structure describing what components are enabled.
401
    let enabled :: ComponentRequestedSpec
402
        enabled = case mb_cname of
403
404
405
406
407
408
409
410
411
412
413
                    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
414
                                  fromFlag (configBenchmarks cfg) }
415
    -- Some sanity checks related to enabling components.
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
416
417
    when (isJust mb_cname
          && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $
418
        die' verbosity $ "--enable-tests/--enable-benchmarks are incompatible with" ++
419
              " explicitly specifying a component to configure."
420

421
422
423
424
425
426
427
428
429
430
431
432
433
    -- 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.
434
435
    (allConstraints  :: [Dependency],
     requiredDepsMap :: Map PackageName InstalledPackageInfo)
436
        <- either (die' verbosity) return $
437
438
439
              combinedConstraints (configConstraints cfg)
                                  (configDependencies cfg)
                                  installedPackageSet
440

441
442
443
444
445
446
447
    -- 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.
448
449
450
451
452
453
454
455
    --
    -- 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.
456
457
    (pkg_descr :: PackageDescription,
     flags     :: FlagAssignment)
458
        <- configureFinalizedPackage verbosity cfg enabled
459
460
                allConstraints
                (dependencySatisfiable
461
                    use_external_internal_deps
462
                    (fromFlagOrDefault False (configExactConfiguration cfg))
463
                    (packageName pkg_descr0)
464
465
466
467
468
469
470
                    installedPackageSet
                    internalPackageSet
                    requiredDepsMap)
                comp
                compPlatform
                pkg_descr0

471
472
473
474
475
476
477
478
479
480
481
482
    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))

483
    checkCompilerProblems verbosity comp pkg_descr enabled
484
485
486
487
    checkPackageProblems verbosity pkg_descr0
        (updatePackageDescription pbi pkg_descr)

    -- The list of 'InstalledPackageInfo' recording the selected
488
    -- dependencies on external packages.
489
490
491
492
493
494
495
496
497
498
    --
    -- 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),
499
500
501
502
503
504
505
506
507
    --
    -- 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.)
508
    externalPkgDeps :: [PreExistingComponent]
509
510
        <- configureDependencies
                verbosity
511
                use_external_internal_deps
512
513
514
515
516
                internalPackageSet
                installedPackageSet
                requiredDepsMap
                pkg_descr

517
518
519
    -- Compute installation directory templates, based on user
    -- configuration.
    --
Edward Z. Yang's avatar
Edward Z. Yang committed
520
    -- TODO: Move this into a helper function.
521
    defaultDirs :: InstallDirTemplates
522
523
        <- defaultInstallDirs' use_external_internal_deps
                              (compilerFlavor comp)
524
525
526
527
                              (fromFlag (configUserInstall cfg))
                              (hasLibs pkg_descr)
    let installDirs :: InstallDirTemplates
        installDirs = combineInstallDirs fromFlagOrDefault
528
529
                        defaultDirs (configInstallDirs cfg)

530
    -- Check languages and extensions
Edward Z. Yang's avatar
Edward Z. Yang committed
531
    -- TODO: Move this into a helper function.
532
    let langlist = nub $ catMaybes $ map defaultLanguage
533
                   (enabledBuildInfos pkg_descr enabled)
534
535
    let langs = unsupportedLanguages comp langlist
    when (not (null langs)) $
536
      die' verbosity $ "The package " ++ display (packageId pkg_descr0)
537
538
539
         ++ " requires the following languages which are not "
         ++ "supported by " ++ display (compilerId comp) ++ ": "
         ++ intercalate ", " (map display langs)
540
    let extlist = nub $ concatMap allExtensions (enabledBuildInfos pkg_descr enabled)
541
542
    let exts = unsupportedExtensions comp extlist
    when (not (null exts)) $
543
      die' verbosity $ "The package " ++ display (packageId pkg_descr0)
544
545
546
547
         ++ " requires the following language extensions which are not "
         ++ "supported by " ++ display (compilerId comp) ++ ": "
         ++ intercalate ", " (map display exts)

548
549
550
551
    -- Check foreign library build requirements
    let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled]
    let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs
    when (not (null unsupportedFLibs)) $
552
      die' verbosity $ "Cannot build some foreign libraries: "
553
554
         ++ intercalate "," unsupportedFLibs

555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
    -- 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
577

578
579
    programDb' <-
          configureAllKnownPrograms (lessVerbose verbosity) programDb
580
581
      >>= configureRequiredPrograms verbosity requiredBuildTools

582
    (pkg_descr', programDb'') <-
583
      configurePkgconfigPackages verbosity pkg_descr programDb' enabled
584

585
586
587
588
589
590
    -- 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.
591
592
593
594
    -- internalPackageSet
    -- use_external_internal_deps
    (buildComponents :: [ComponentLocalBuildInfo],
     packageDependsIndex :: InstalledPackageIndex) <-
595
      runLogProgress verbosity $ configureComponentLocalBuildInfos
596
597
598
            verbosity
            use_external_internal_deps
            enabled
599
            (fromFlagOrDefault False (configDeterministic cfg))
600
601
602
            (configIPID cfg)
            (configCID cfg)
            pkg_descr
603
            externalPkgDeps
604
605
606
607
            (configConfigurationsFlags cfg)
            (configInstantiateWith cfg)
            installedPackageSet
            comp
608

Ben Gamari's avatar
Ben Gamari committed
609
610
611
612
613
614
615
616
617
618
619
620
621
622
    -- Decide if we're going to compile with split sections.
    split_sections :: Bool <-
       if not (fromFlag $ configSplitSections cfg)
            then return False
            else case compilerFlavor comp of
                        GHC | compilerVersion comp >= mkVersion [8,0]
                          -> return True
                        GHCJS
                          -> return True
                        _ -> do warn verbosity
                                     ("this compiler does not support " ++
                                      "--enable-split-sections; ignoring")
                                return False

623
624
    -- Decide if we're going to compile with split objects.
    split_objs :: Bool <-
625
626
627
       if not (fromFlag $ configSplitObjs cfg)
            then return False
            else case compilerFlavor comp of
Ben Gamari's avatar
Ben Gamari committed
628
629
630
631
632
633
                        _ | split_sections
                          -> do warn verbosity
                                     ("--enable-split-sections and " ++
                                      "--enable-split-objs are mutually" ++
                                      "exclusive; ignoring the latter")
                                return False
634
                        GHC | compilerVersion comp >= mkVersion [6,5]
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
676
677
                          -> 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
Moritz Angermann's avatar
Moritz Angermann committed
678
679

        withStaticLib_ =
Moritz Angermann's avatar
Moritz Angermann committed
680
681
            -- build a static library (all dependent libraries rolled
            -- into a huge .a archive) via GHCs -staticlib flag.
Moritz Angermann's avatar
Moritz Angermann committed
682
683
            fromFlagOrDefault False $ configStaticLib cfg

684
685
686
687
688
689
        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."

690
    setProfLBI <- configureProfiling verbosity cfg comp
691

692
    setCoverageLBI <- configureCoverage verbosity cfg comp
693

Sergey Vinokurov's avatar
Sergey Vinokurov committed
694
    let reloc = fromFlagOrDefault False $ configRelocatable cfg
695

696
    let buildComponentsMap =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
697
698
            foldl' (\m clbi -> Map.insertWith (++)
                               (componentLocalName clbi) [clbi] m)
699
700
                   Map.empty buildComponents

701
    let lbi = (setCoverageLBI . setProfLBI)
702
703
              LocalBuildInfo {
                configFlags         = cfg,
704
                flagAssignment      = flags,
705
                componentEnabledSpec = enabled,
706
707
708
709
710
711
712
                extraConfigArgs     = [],  -- Currently configure does not
                                           -- take extra args, but if it
                                           -- did they would go here.
                installDirTemplates = installDirs,
                compiler            = comp,
                hostPlatform        = compPlatform,
                buildDir            = buildDir,
713
                componentGraph      = Graph.fromDistinctList buildComponents,
714
                componentNameMap    = buildComponentsMap,
715
716
717
                installedPkgs       = packageDependsIndex,
                pkgDescrFile        = Nothing,
                localPkgDescr       = pkg_descr',
718
                withPrograms        = programDb'',
719
720
                withVanillaLib      = fromFlag $ configVanillaLib cfg,
                withSharedLib       = withSharedLib_,
Moritz Angermann's avatar
Moritz Angermann committed
721
                withStaticLib       = withStaticLib_,
722
                withDynExe          = withDynExe_,
723
724
725
726
                withProfLib         = False,
                withProfLibDetail   = ProfDetailNone,
                withProfExe         = False,
                withProfExeDetail   = ProfDetailNone,
727
728
729
730
                withOptimization    = fromFlag $ configOptimization cfg,
                withDebugInfo       = fromFlag $ configDebugInfo cfg,
                withGHCiLib         = fromFlagOrDefault ghciLibByDefault $
                                      configGHCiLib cfg,
Ben Gamari's avatar
Ben Gamari committed
731
                splitSections       = split_sections,
732
733
734
                splitObjs           = split_objs,
                stripExes           = fromFlag $ configStripExes cfg,
                stripLibs           = fromFlag $ configStripLibs cfg,
735
736
                exeCoverage         = False,
                libCoverage         = False,
737
738
739
740
                withPackageDB       = packageDbs,
                progPrefix          = fromFlag $ configProgPrefix cfg,
                progSuffix          = fromFlag $ configProgSuffix cfg,
                relocatable         = reloc
741
              }
742
743
744

    when reloc (checkRelocatable verbosity pkg_descr lbi)

745
746
    -- TODO: This is not entirely correct, because the dirs may vary
    -- across libraries/executables
747
748
    let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
        relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
749

750
    unless (isAbsolute (prefix dirs)) $ die' verbosity $
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
        "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)"
                  _      -> ""

766
    dirinfo "Executables"      (bindir dirs)     (bindir relative)
767
    dirinfo "Libraries"        (libdir dirs)     (libdir relative)
Christiaan Baaij's avatar
Christiaan Baaij committed
768
    dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative)
769
    dirinfo "Private executables" (libexecdir dirs) (libexecdir relative)
770
771
772
773
774
    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
775
              | (prog, configuredProg) <- knownPrograms programDb'' ]
776
777

    return lbi
778

779
    where
780
781
      verbosity = fromFlag (configVerbosity cfg)

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
782
783
mkProgramDb :: ConfigFlags -> ProgramDb -> ProgramDb
mkProgramDb cfg initialProgramDb = programDb
784
  where
785
786
787
    programDb  = userSpecifyArgss (configProgramArgs cfg)
                 . userSpecifyPaths (configProgramPaths cfg)
                 . setProgramSearchPath searchpath
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
788
                 $ initialProgramDb
Pranit Bauva's avatar
Pranit Bauva committed
789
    searchpath = getProgramSearchPath initialProgramDb
790
791
                 ++ map ProgramSearchPathDir
                 (fromNubList $ configProgramPathExtra cfg)
792

793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
-- -----------------------------------------------------------------------------
-- 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.
815
checkExactConfiguration :: Verbosity -> GenericPackageDescription -> ConfigFlags -> IO ()
Pranit Bauva's avatar
Pranit Bauva committed
816
checkExactConfiguration verbosity pkg_descr0 cfg =
817
    when (fromFlagOrDefault False (configExactConfiguration cfg)) $ do
818
      let cmdlineFlags = map fst (unFlagAssignment (configConfigurationsFlags cfg))
819
820
821
          allFlags     = map flagName . genPackageFlags $ pkg_descr0
          diffFlags    = allFlags \\ cmdlineFlags
      when (not . null $ diffFlags) $
822
        die' verbosity $ "'--exact-configuration' was given, "
823
824
825
826
827
828
829
830
831
        ++ "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
832
-- file, and we haven't resolved them yet.  finalizePD
833
834
835
-- does the resolution of conditionals, and it takes internalPackageSet
-- as part of its input.
getInternalPackages :: GenericPackageDescription
836
                    -> Map PackageName (Maybe UnqualComponentName)
837
getInternalPackages pkg_descr0 =
838
    -- TODO: some day, executables will be fair game here too!
839
    let pkg_descr = flattenPackageDescription pkg_descr0
840
        f lib = case libName lib of
841
842
                    Nothing -> (packageName pkg_descr, Nothing)
                    Just n' -> (unqualComponentNameToPackageName n', Just n')
843
844
    in Map.fromList (map f (allLibraries pkg_descr))

845
846
847
-- | 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.
848
dependencySatisfiable
849
850
851
    :: Bool -- ^ use external internal deps?
    -> Bool -- ^ exact configuration?
    -> PackageName
852
    -> InstalledPackageIndex -- ^ installed set
853
    -> Map PackageName (Maybe UnqualComponentName) -- ^ internal set
854
855
856
    -> Map PackageName InstalledPackageInfo -- ^ required dependencies
    -> (Dependency -> Bool)
dependencySatisfiable
857
858
  use_external_internal_deps
  exact_config pn installedPackageSet internalPackageSet requiredDepsMap
859
  d@(Dependency depName vr)
860

861
    | exact_config
862
863
864
865
866
867
868
869
    -- 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?
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
    = if isInternalDep && not use_external_internal_deps
        -- Except for internal deps, when we're NOT per-component mode;
        -- those are just True.
        then True
        else depName `Map.member` requiredDepsMap

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

    | otherwise
    = depSatisfiable

  where
    isInternalDep = Map.member depName internalPackageSet

892
    depSatisfiable =
893
894
895
896
897
898
899
900
901
902
903
904
        not . null $ PackageIndex.lookupDependency installedPackageSet d

    internalDepSatisfiable =
        not . null $ PackageIndex.lookupInternalDependency
                        installedPackageSet (Dependency pn vr) cn
      where
        cn | pn == depName
           = Nothing
           | otherwise
           -- Reinterpret the "package name" as an unqualified component
           -- name
           = Just (mkUnqualComponentName (unPackageName depName))
905
906

-- | Finalize a generic package description.  The workhorse is
907
-- 'finalizePD' but there's a bit of other nattering
908
909
910
911
912
913
914
-- about necessary.
--
-- TODO: what exactly is the business with @flaggedTests@ and
-- @flaggedBenchmarks@?
configureFinalizedPackage
    :: Verbosity
    -> ConfigFlags
915
    -> ComponentRequestedSpec
916
917
918
919
920
921
    -> [Dependency]
    -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
                            -- Might say it's satisfiable even when not.
    -> Compiler
    -> Platform
    -> GenericPackageDescription
922
    -> IO (PackageDescription, FlagAssignment)
923
configureFinalizedPackage verbosity cfg enabled
924
925
926
  allConstraints satisfies comp compPlatform pkg_descr0 = do

    (pkg_descr0', flags) <-
927
            case finalizePD
928
                   (configConfigurationsFlags cfg)
929
                   enabled
930
931
932
933
                   satisfies
                   compPlatform
                   (compilerInfo comp)
                   allConstraints
934
                   pkg_descr0
935
936
            of Right r -> return r
               Left missing ->
937
                   die' verbosity $ "Encountered missing dependencies:\n"
938
939
940
941
942
943
944
945
                     ++ (render . nest 4 . sep . punctuate comma
                                . map (disp . simplifyDependency)
                                $ missing)

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

946
    unless (nullFlagAssignment flags) $
947
      info verbosity $ "Flags chosen: "
948
                    ++ intercalate ", " [ unFlagName fn ++ "=" ++ display value
949
                                        | (fn, value) <- unFlagAssignment flags ]
950

951
    return (pkg_descr, flags)
952
953
954
  where
    addExtraIncludeLibDirs pkg_descr =
        let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
955
                             , extraFrameworkDirs = configExtraFrameworkDirs cfg