Configure.hs 93.4 KB
Newer Older
1
{-# LANGUAGE DeriveDataTypeable #-}
2
{-# LANGUAGE OverloadedStrings #-}
3
{-# LANGUAGE RecordWildCards #-}
4
{-# LANGUAGE ScopedTypeVariables #-}
5
{-# LANGUAGE PatternGuards #-}
6

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

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

56
import Distribution.Compiler
57
import Distribution.Utils.NubList
58
59
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Simple.PreProcess
60
import Distribution.Package
61
import qualified Distribution.InstalledPackageInfo as Installed
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
62
63
import Distribution.InstalledPackageInfo (InstalledPackageInfo
                                         ,emptyInstalledPackageInfo)
64
import qualified Distribution.Simple.PackageIndex as PackageIndex
65
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
66
import Distribution.PackageDescription as PD hiding (Flag)
67
import Distribution.ModuleName
68
import Distribution.PackageDescription.Configuration
69
import Distribution.PackageDescription.Check hiding (doesFileExist)
70
import Distribution.Simple.Program
71
import Distribution.Simple.Setup as Setup
72
import qualified Distribution.Simple.InstallDirs as InstallDirs
73
import Distribution.Simple.LocalBuildInfo
74
75
76
77
import Distribution.Simple.Utils
import Distribution.System
import Distribution.Version
import Distribution.Verbosity
78

79
80
81
82
83
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
84
import qualified Distribution.Simple.HaskellSuite as HaskellSuite
85

86
87
-- Prefer the more generic Data.Traversable.mapM to Prelude.mapM
import Prelude hiding ( mapM )
88
import Control.Exception
89
    ( Exception, evaluate, throw, throwIO, try )
90
import Control.Exception ( ErrorCall )
91
import Control.Monad
92
    ( liftM, when, unless, foldM, filterM, mplus )
93
import Distribution.Compat.Binary ( decodeOrFailIO, encode )
94
import GHC.Fingerprint ( Fingerprint(..), fingerprintString )
95
import Data.ByteString.Lazy (ByteString)
96
97
import qualified Data.ByteString            as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8
98
import Data.List
99
    ( (\\), nub, partition, isPrefixOf, inits, stripPrefix )
100
import Data.Maybe
101
    ( isNothing, catMaybes, fromMaybe, mapMaybe, isJust )
102
103
import Data.Either
    ( partitionEithers )
104
import qualified Data.Set as Set
105
import Data.Monoid as Mon ( Monoid(..) )
106
107
import qualified Data.Map as Map
import Data.Map (Map)
108
109
import Data.Traversable
    ( mapM )
110
import Data.Typeable
111
112
import Data.Char ( chr, isAlphaNum )
import Numeric ( showIntAtBase )
113
import System.Directory
114
    ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory )
115
import System.FilePath
116
    ( (</>), isAbsolute )
117
import qualified System.Info
118
    ( compilerName, compilerVersion )
119
import System.IO
120
    ( hPutStrLn, hClose )
121
import Distribution.Text
122
    ( Text(disp), defaultStyle, display, simpleParse )
dterei's avatar
dterei committed
123
import Text.PrettyPrint
124
125
    ( Doc, (<>), (<+>), ($+$), char, comma, empty, hsep, nest
    , punctuate, quotes, render, renderStyle, sep, text )
126
import Distribution.Compat.Environment ( lookupEnv )
127
import Distribution.Compat.Exception ( catchExit, catchIO )
128

129
-- | The errors that can be thrown when reading the @setup-config@ file.
130
data ConfigStateFileError
131
132
133
134
    = ConfigStateFileNoHeader -- ^ No header found.
    | ConfigStateFileBadHeader -- ^ Incorrect header.
    | ConfigStateFileNoParse -- ^ Cannot parse file contents.
    | ConfigStateFileMissing -- ^ No file!
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
135
136
    | ConfigStateFileBadVersion PackageIdentifier PackageIdentifier
      (Either ConfigStateFileError LocalBuildInfo) -- ^ Mismatched version.
137
138
  deriving (Typeable)

139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
-- | 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
        | oldCompiler == currentCompilerId = empty
        | otherwise =
            text "• the compiler changed from"
            <+> disp oldCompiler <+> "to" <+> disp currentCompilerId

166
instance Show ConfigStateFileError where
167
    show = renderStyle defaultStyle . dispConfigStateFileError
168
169

instance Exception ConfigStateFileError
170

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
171
-- | Read the 'localBuildInfoFile'.  Throw an exception if the file is
172
173
174
175
-- 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
176
getConfigStateFile filename = do
177
    exists <- doesFileExist filename
178
    unless exists $ throwIO ConfigStateFileMissing
179
180
181
182
    -- 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])
183

184
185
186
    headerParseResult <- try $ evaluate $ parseHeader header
    let (cabalId, compId) =
            case headerParseResult of
187
              Left (_ :: ErrorCall) -> throw ConfigStateFileBadHeader
188
189
              Right x -> x

190
191
192
193
194
    let getStoredValue = do
          result <- decodeOrFailIO (BLC8.tail body)
          case result of
            Left _ -> throw ConfigStateFileNoParse
            Right x -> return x
195
        deferErrorIfBadVersion act
196
          | cabalId /= currentCabalId = do
197
198
199
200
201
              eResult <- try act
              throw $ ConfigStateFileBadVersion cabalId compId eResult
          | otherwise = act
    deferErrorIfBadVersion getStoredValue

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
202
203
-- | Read the 'localBuildInfoFile', returning either an error or the local build
-- info.
204
tryGetConfigStateFile :: FilePath -- ^ The file path of the @setup-config@ file.
205
206
                      -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetConfigStateFile = try . getConfigStateFile
207

208
209
-- | Try to read the 'localBuildInfoFile'.
tryGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
210
211
                         -> IO (Either ConfigStateFileError LocalBuildInfo)
tryGetPersistBuildConfig = try . getPersistBuildConfig
212

213
214
215
-- | 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.
216
217
getPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                      -> IO LocalBuildInfo
218
getPersistBuildConfig = getConfigStateFile . localBuildInfoFile
219

220
221
222
-- | Try to read the 'localBuildInfoFile'.
maybeGetPersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
                           -> IO (Maybe LocalBuildInfo)
223
224
maybeGetPersistBuildConfig =
    liftM (either (const Nothing) Just) . tryGetPersistBuildConfig
ijones's avatar
ijones committed
225

226
-- | After running configure, output the 'LocalBuildInfo' to the
ijones's avatar
ijones committed
227
-- 'localBuildInfoFile'.
228
writePersistBuildConfig :: FilePath -- ^ The @dist@ directory path.
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
229
                        -> LocalBuildInfo -- ^ The 'LocalBuildInfo' to write.
230
                        -> IO ()
231
writePersistBuildConfig distPref lbi = do
232
233
    createDirectoryIfMissing False distPref
    writeFileAtomic (localBuildInfoFile distPref) $
234
      BLC8.unlines [showHeader pkgId, encode lbi]
235
236
  where
    pkgId = packageId $ localPkgDescr lbi
237

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
238
-- | Identifier of the current Cabal package.
239
currentCabalId :: PackageIdentifier
240
currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion
241

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
242
-- | Identifier of the current compiler package.
243
currentCompilerId :: PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
244
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
245
246
                                      System.Info.compilerVersion

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
247
-- | Parse the @setup-config@ file header, returning the package identifiers
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
248
-- for Cabal and the compiler.
JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
249
parseHeader :: ByteString -- ^ The file contents.
250
            -> (PackageIdentifier, PackageIdentifier)
251
parseHeader header = case BLC8.words header of
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
252
253
  ["Saved", "package", "config", "for", pkgId, "written", "by", cabalId,
   "using", compId] ->
254
      fromMaybe (throw ConfigStateFileBadHeader) $ do
255
256
257
          _ <- simpleParse (BLC8.unpack pkgId) :: Maybe PackageIdentifier
          cabalId' <- simpleParse (BLC8.unpack cabalId)
          compId' <- simpleParse (BLC8.unpack compId)
258
259
          return (cabalId', compId')
  _ -> throw ConfigStateFileNoHeader
260

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
261
-- | Generate the @setup-config@ file header.
262
263
showHeader :: PackageIdentifier -- ^ The processed package.
            -> ByteString
264
showHeader pkgId = BLC8.unwords
265
    [ "Saved", "package", "config", "for"
266
    , BLC8.pack $ display pkgId
267
    , "written", "by"
268
    , BLC8.pack $ display currentCabalId
269
    , "using"
270
    , BLC8.pack $ display currentCompilerId
271
    ]
272

273
-- | Check that localBuildInfoFile is up-to-date with respect to the
274
-- .cabal file.
275
276
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool
checkPersistBuildConfigOutdated distPref pkg_descr_file = do
277
  pkg_descr_file `moreRecentFile` (localBuildInfoFile distPref)
278

JeanPhilippeMoresmau's avatar
JeanPhilippeMoresmau committed
279
-- | Get the path of @dist\/setup-config@.
280
281
localBuildInfoFile :: FilePath -- ^ The @dist@ directory path.
                    -> FilePath
282
localBuildInfoFile distPref = distPref </> "setup-config"
ijones's avatar
ijones committed
283

284
-- -----------------------------------------------------------------------------
ijones's avatar
ijones committed
285
286
-- * Configuration
-- -----------------------------------------------------------------------------
287

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
288
289
290
-- | 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.
291
292
293
294
295
296
297
298
299
300
301
302
findDistPref :: FilePath  -- ^ default \"dist\" prefix
             -> Setup.Flag FilePath  -- ^ override \"dist\" prefix
             -> IO FilePath
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
303
304
305
306
307
308
-- | 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'.)
309
310
311
312
findDistPrefOrDefault :: Setup.Flag FilePath  -- ^ override \"dist\" prefix
                      -> IO FilePath
findDistPrefOrDefault = findDistPref defaultDistPref

313
314
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
315
configure :: (GenericPackageDescription, HookedBuildInfo)
316
          -> ConfigFlags -> IO LocalBuildInfo
317
318
319
320
321
configure (pkg_descr0', pbi) cfg = do
    let pkg_descr0 =
          -- Ignore '--allow-newer' when we're given '--exact-configuration'.
          if fromFlagOrDefault False (configExactConfiguration cfg)
          then pkg_descr0'
322
323
324
          else relaxPackageDeps
               (fromMaybe AllowNewerNone $ configAllowNewer cfg)
               pkg_descr0'
325

326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
    setupMessage verbosity "Configuring" (packageId pkg_descr0)

    checkDeprecatedFlags verbosity cfg
    checkExactConfiguration pkg_descr0 cfg

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

    -- What package database(s) to use
    let packageDbs
         = interpretPackageDbFlags
            (fromFlag (configUserInstall cfg))
            (configPackageDBs cfg)

    -- comp:            the compiler we're building with
    -- compPlatform:    the platform we're building for
    -- programsConfig:  location and args of all programs we're
    --                  building with
    (comp, compPlatform, programsConfig)
        <- configCompilerEx
            (flagToMaybe (configHcFlavor cfg))
            (flagToMaybe (configHcPath cfg))
            (flagToMaybe (configHcPkg cfg))
353
            (mkProgramsConfig cfg (configPrograms cfg))
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
            (lessVerbose verbosity)

    -- The InstalledPackageIndex of all installed packages
    installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
                                  packageDbs programsConfig

    -- The InstalledPackageIndex of all (possible) internal packages
    let internalPackageSet = getInternalPackages pkg_descr0

    -- allConstraints:  The set of all 'Dependency's we have.  Used ONLY
    --                  to 'configureFinalizedPackage'.
    -- requiredDepsMap: A map from 'PackageName' to the specifically
    --                  required 'InstalledPackageInfo', due to --dependency
    --
    -- NB: These constraints are to be applied to ALL components of
    -- a package.  Thus, it's not an error if allConstraints contains
    -- more constraints than is necessary for a component (another
    -- component might need it.)
    --
    -- NB: The fact that we bundle all the constraints together means
    -- that is not possible to configure a test-suite to use one
    -- version of a dependency, and the executable to use another.
    (allConstraints, requiredDepsMap) <- either die return $
      combinedConstraints (configConstraints cfg)
                          (configDependencies cfg)
                          installedPackageSet

381
382
383
384
385
386
387
    -- 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.
388
389
390
391
392
393
394
395
    --
    -- 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.
396
    (pkg_descr, flags)
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
        <- configureFinalizedPackage verbosity cfg
                allConstraints
                (dependencySatisfiable
                    (fromFlagOrDefault False (configExactConfiguration cfg))
                    installedPackageSet
                    internalPackageSet
                    requiredDepsMap)
                comp
                compPlatform
                pkg_descr0

    checkCompilerProblems comp pkg_descr
    checkPackageProblems verbosity pkg_descr0
        (updatePackageDescription pbi pkg_descr)

    -- The list of 'InstalledPackageInfo' recording the selected
    -- dependencies...
    -- internalPkgDeps: ...on internal packages (these are fake!)
    -- externalPkgDeps: ...on external packages
    --
    -- Invariant: For any package name, there is at most one package
    -- in externalPackageDeps which has that name.
    --
    -- NB: The dependency selection is global over ALL components
    -- in the package (similar to how allConstraints and
    -- requiredDepsMap are global over all components).  In particular,
    -- if *any* component (post-flag resolution) has an unsatisfiable
    -- dependency, we will fail.  This can sometimes be undesirable
    -- for users, see #1786 (benchmark conflicts with executable),
    (internalPkgDeps, externalPkgDeps)
        <- configureDependencies
                verbosity
                internalPackageSet
                installedPackageSet
                requiredDepsMap
                pkg_descr

    let installDeps = Map.elems -- deduplicate
                    . Map.fromList
436
                    . map (\v -> (Installed.installedUnitId v, v))
437
                    $ externalPkgDeps
438
439
440

    packageDependsIndex <-
      case PackageIndex.dependencyClosure installedPackageSet
441
              (map Installed.installedUnitId installDeps) of
442
443
444
445
446
447
448
449
450
451
452
453
        Left packageDependsIndex -> return packageDependsIndex
        Right broken ->
          die $ "The following installed packages are broken because other"
             ++ " packages they depend on are missing. These broken "
             ++ "packages must be rebuilt before they can be used.\n"
             ++ unlines [ "package "
                       ++ display (packageId pkg)
                       ++ " is broken due to missing package "
                       ++ intercalate ", " (map display deps)
                        | (pkg, deps) <- broken ]

    let pseudoTopPkg = emptyInstalledPackageInfo {
454
            Installed.installedUnitId =
455
               mkLegacyUnitId (packageId pkg_descr),
456
457
            Installed.sourcePackageId = packageId pkg_descr,
            Installed.depends =
458
              map Installed.installedUnitId installDeps
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
          }
    case PackageIndex.dependencyInconsistencies
       . PackageIndex.insert pseudoTopPkg
       $ packageDependsIndex of
      [] -> return ()
      inconsistencies ->
        warn verbosity $
             "This package indirectly depends on multiple versions of the same "
          ++ "package. This is highly likely to cause a compile failure.\n"
          ++ unlines [ "package " ++ display pkg ++ " requires "
                    ++ display (PackageIdentifier name ver)
                     | (name, uses) <- inconsistencies
                     , (pkg, ver) <- uses ]

    -- installation directories
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
474
475
    defaultDirs <- defaultInstallDirs (compilerFlavor comp)
                   (fromFlag (configUserInstall cfg)) (hasLibs pkg_descr)
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
    let installDirs = combineInstallDirs fromFlagOrDefault
                        defaultDirs (configInstallDirs cfg)

    -- check languages and extensions
    let langlist = nub $ catMaybes $ map defaultLanguage
                   (allBuildInfo pkg_descr)
    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)
    let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)
    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)

    -- configured known/required programs & external build tools
    -- exclude build-tool deps on "internal" exes in the same package
    let requiredBuildTools =
          [ buildTool
          | let exeNames = map exeName (executables pkg_descr)
          , bi <- allBuildInfo pkg_descr
          , buildTool@(Dependency (PackageName toolName) reqVer)
            <- buildTools bi
          , let isInternal =
                    toolName `elem` exeNames
                    -- we assume all internal build-tools are
                    -- versioned with the package:
                 && packageVersion pkg_descr `withinRange` reqVer
          , not isInternal ]

    programsConfig' <-
          configureAllKnownPrograms (lessVerbose verbosity) programsConfig
      >>= configureRequiredPrograms verbosity requiredBuildTools

    (pkg_descr', programsConfig'') <-
      configurePkgconfigPackages verbosity pkg_descr programsConfig'

    -- internal component graph
    buildComponents <-
      case mkComponentsGraph pkg_descr internalPkgDeps of
        Left  componentCycle -> reportComponentCycle componentCycle
522
        Right comps          ->
523
          mkComponentsLocalBuildInfo cfg comp packageDependsIndex pkg_descr
524
                                     internalPkgDeps externalPkgDeps
525
                                     comps (configConfigurationsFlags cfg)
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614

    split_objs <-
       if not (fromFlag $ configSplitObjs cfg)
            then return False
            else case compilerFlavor comp of
                        GHC | compilerVersion comp >= Version [6,5] []
                          -> 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."

    -- The --profiling flag sets the default for both libs and exes,
    -- but can be overidden by --library-profiling, or the old deprecated
    -- --executable-profiling flag.
    let profEnabledLibOnly = configProfLib cfg
        profEnabledBoth    = fromFlagOrDefault False (configProf cfg)
        profEnabledLib = fromFlagOrDefault profEnabledBoth profEnabledLibOnly
        profEnabledExe = fromFlagOrDefault profEnabledBoth (configProfExe cfg)

    -- The --profiling-detail and --library-profiling-detail flags behave
    -- similarly
    profDetailLibOnly <- checkProfDetail (configProfLibDetail cfg)
    profDetailBoth    <- liftM (fromFlagOrDefault ProfDetailDefault)
                               (checkProfDetail (configProfDetail cfg))
    let profDetailLib = fromFlagOrDefault profDetailBoth profDetailLibOnly
        profDetailExe = profDetailBoth

    when (profEnabledExe && not profEnabledLib) $
      warn verbosity $
           "Executables will be built with profiling, but library "
        ++ "profiling is disabled. Linking will fail if any executables "
        ++ "depend on the library."

    let configCoverage_ =
          mappend (configCoverage cfg) (configLibCoverage cfg)

        cfg' = cfg { configCoverage = configCoverage_ }

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

    let lbi = LocalBuildInfo {
                configFlags         = cfg',
615
                flagAssignment      = flags,
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
                extraConfigArgs     = [],  -- Currently configure does not
                                           -- take extra args, but if it
                                           -- did they would go here.
                installDirTemplates = installDirs,
                compiler            = comp,
                hostPlatform        = compPlatform,
                buildDir            = buildDir,
                componentsConfigs   = buildComponents,
                installedPkgs       = packageDependsIndex,
                pkgDescrFile        = Nothing,
                localPkgDescr       = pkg_descr',
                withPrograms        = programsConfig'',
                withVanillaLib      = fromFlag $ configVanillaLib cfg,
                withProfLib         = profEnabledLib,
                withSharedLib       = withSharedLib_,
                withDynExe          = withDynExe_,
                withProfExe         = profEnabledExe,
                withProfLibDetail   = profDetailLib,
                withProfExeDetail   = profDetailExe,
                withOptimization    = fromFlag $ configOptimization cfg,
                withDebugInfo       = fromFlag $ configDebugInfo cfg,
                withGHCiLib         = fromFlagOrDefault ghciLibByDefault $
                                      configGHCiLib cfg,
                splitObjs           = split_objs,
                stripExes           = fromFlag $ configStripExes cfg,
                stripLibs           = fromFlag $ configStripLibs cfg,
                withPackageDB       = packageDbs,
                progPrefix          = fromFlag $ configProgPrefix cfg,
                progSuffix          = fromFlag $ configProgSuffix cfg,
                relocatable         = reloc
646
              }
647
648
649

    when reloc (checkRelocatable verbosity pkg_descr lbi)

650
651
652
653
    -- TODO: This is not entirely correct, because the dirs may vary
    -- across libraries/executables
    let dirs = absoluteInstallDirs pkg_descr lbi (localUnitId lbi) NoCopyDest
        relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi (localUnitId lbi)
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681

    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)
    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
              | (prog, configuredProg) <- knownPrograms programsConfig'' ]

    return lbi
682

683
    where
684
685
686
687
688
689
690
691
692
693
694
      verbosity = fromFlag (configVerbosity cfg)

      checkProfDetail (Flag (ProfDetailOther other)) = do
        warn verbosity $
             "Unknown profiling detail level '" ++ other
          ++ "', using default.\n"
          ++ "The profiling detail levels are: " ++ intercalate ", "
             [ name | (name, _, _) <- knownProfDetailLevels ]
        return (Flag ProfDetailDefault)
      checkProfDetail other = return other

695
696
697
698
699
700
701
702
mkProgramsConfig :: ConfigFlags -> ProgramConfiguration -> ProgramConfiguration
mkProgramsConfig cfg initialProgramsConfig = programsConfig
  where
    programsConfig = userSpecifyArgss (configProgramArgs cfg)
                   . userSpecifyPaths (configProgramPaths cfg)
                   . setProgramSearchPath searchpath
                   $ initialProgramsConfig
    searchpath     = getProgramSearchPath (initialProgramsConfig)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
703
704
                  ++ map ProgramSearchPathDir
                     (fromNubList $ configProgramPathExtra cfg)
705

706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
-- -----------------------------------------------------------------------------
-- 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) $
735
        die $ "'--exact-configuration' was given, "
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
        ++ "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
-- file, and we haven't resolved them yet.  finalizePackageDescription
-- does the resolution of conditionals, and it takes internalPackageSet
-- as part of its input.
--
-- Currently a package can define no more than one library (which has
-- the same name as the package) but we could extend this later.
-- If we later allowed private internal libraries, then here we would
-- need to pre-scan the conditional data to make a list of all private
-- libraries that could possibly be defined by the .cabal file.
getInternalPackages :: GenericPackageDescription
                    -> InstalledPackageIndex
getInternalPackages pkg_descr0 =
757
758
    let pkg_descr = flattenPackageDescription pkg_descr0
        mkInternalPackage lib = emptyInstalledPackageInfo {
759
760
            --TODO: should use a per-compiler method to map the source
            --      package ID into an installed package id we can use
761
762
763
764
765
766
767
768
769
770
            --      for the internal package set.  What we do here
            --      is skeevy, but we're highly unlikely to accidentally
            --      shadow something legitimate.
            Installed.installedUnitId = mkUnitId (libName lib),
            -- NB: we TEMPORARILY set the package name to be the
            -- library name.  When we actually register, it won't
            -- look like this; this is just so that internal
            -- build-depends get resolved correctly.
            Installed.sourcePackageId = PackageIdentifier (PackageName (libName lib))
                                            (pkgVersion (package pkg_descr))
771
          }
772
    in PackageIndex.fromList (map mkInternalPackage (libraries pkg_descr))
773
774
775
776
777
778
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


-- | Returns true if a dependency is satisfiable.  This is to be passed
-- to finalizePackageDescription.
dependencySatisfiable
    :: Bool
    -> InstalledPackageIndex -- ^ installed set
    -> InstalledPackageIndex -- ^ internal set
    -> Map PackageName InstalledPackageInfo -- ^ required dependencies
    -> (Dependency -> Bool)
dependencySatisfiable
    exact_config installedPackageSet internalPackageSet requiredDepsMap
    d@(Dependency depName _)
      | exact_config =
        -- When we're given '--exact-configuration', we assume that all
        -- dependencies and flags are exactly specified on the command
        -- line. Thus we only consult the 'requiredDepsMap'. Note that
        -- we're not doing the version range check, so if there's some
        -- dependency that wasn't specified on the command line,
        -- 'finalizePackageDescription' will fail.
        --
        -- TODO: mention '--exact-configuration' in the error message
        -- when this fails?
        --
        -- (However, note that internal deps don't have to be
        -- specified!)
        (depName `Map.member` requiredDepsMap) || isInternalDep

      | otherwise =
        -- Normal operation: just look up dependency in the combined
        -- package index.
        not . null . PackageIndex.lookupDependency pkgs $ d
      where
806
807
        -- NB: Prefer the INTERNAL package set
        pkgs = PackageIndex.merge installedPackageSet internalPackageSet
808
809
810
        isInternalDep = not . null
                      $ PackageIndex.lookupDependency internalPackageSet d

811
-- | Relax the dependencies of this package if needed.
812
813
relaxPackageDeps :: AllowNewer -> GenericPackageDescription
                 -> GenericPackageDescription
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
relaxPackageDeps AllowNewerNone gpd = gpd
relaxPackageDeps AllowNewerAll  gpd = transformAllBuildDepends relaxAll gpd
  where
    relaxAll = \(Dependency pkgName verRange) ->
      Dependency pkgName (removeUpperBound verRange)
relaxPackageDeps (AllowNewerSome allowNewerDeps') gpd =
  transformAllBuildDepends relaxSome gpd
  where
    thisPkgName    = packageName gpd
    allowNewerDeps = mapMaybe f allowNewerDeps'

    f (Setup.AllowNewerDep p) = Just p
    f (Setup.AllowNewerDepScoped scope p) | scope == thisPkgName = Just p
                                          | otherwise            = Nothing

    relaxSome = \d@(Dependency depName verRange) ->
      if depName `elem` allowNewerDeps
      then Dependency depName (removeUpperBound verRange)
      else d
833

834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
-- | Finalize a generic package description.  The workhorse is
-- 'finalizePackageDescription' but there's a bit of other nattering
-- about necessary.
--
-- TODO: what exactly is the business with @flaggedTests@ and
-- @flaggedBenchmarks@?
configureFinalizedPackage
    :: Verbosity
    -> ConfigFlags
    -> [Dependency]
    -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable.
                            -- Might say it's satisfiable even when not.
    -> Compiler
    -> Platform
    -> GenericPackageDescription
849
    -> IO (PackageDescription, FlagAssignment)
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
configureFinalizedPackage verbosity cfg
  allConstraints satisfies comp compPlatform pkg_descr0 = do
    let enableTest t = t { testEnabled = fromFlag (configTests cfg) }
        flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
                           (condTestSuites pkg_descr0)
        enableBenchmark bm = bm { benchmarkEnabled =
                                     fromFlag (configBenchmarks cfg) }
        flaggedBenchmarks = map (\(n, bm) ->
                                  (n, mapTreeData enableBenchmark bm))
                           (condBenchmarks pkg_descr0)
        pkg_descr0'' = pkg_descr0 { condTestSuites = flaggedTests
                                  , condBenchmarks = flaggedBenchmarks }

    (pkg_descr0', flags) <-
            case finalizePackageDescription
                   (configConfigurationsFlags cfg)
                   satisfies
                   compPlatform
                   (compilerInfo comp)
                   allConstraints
                   pkg_descr0''
            of Right r -> return r
               Left missing ->
873
                   die $ "Encountered missing dependencies:\n"
874
875
876
877
878
879
880
881
882
883
884
885
886
                     ++ (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'

    when (not (null flags)) $
      info verbosity $ "Flags chosen: "
                    ++ intercalate ", " [ name ++ "=" ++ display value
                                        | (FlagName name, value) <- flags ]

887
    return (pkg_descr, flags)
888
889
890
  where
    addExtraIncludeLibDirs pkg_descr =
        let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
891
                             , extraFrameworkDirs = configExtraFrameworkDirs cfg
892
893
894
895
896
                             , PD.includeDirs = configExtraIncludeDirs cfg}
            modifyLib l        = l{ libBuildInfo = libBuildInfo l
                                                   `mappend` extraBi }
            modifyExecutable e = e{ buildInfo    = buildInfo e
                                                   `mappend` extraBi}
897
        in pkg_descr{ libraries   = modifyLib         `map` libraries pkg_descr
898
899
900
901
902
903
904
905
906
907
908
909
910
911
                    , executables = modifyExecutable  `map`
                                      executables pkg_descr}

-- | Check for use of Cabal features which require compiler support
checkCompilerProblems :: Compiler -> PackageDescription -> IO ()
checkCompilerProblems comp pkg_descr = do
    unless (renamingPackageFlagsSupported comp ||
                and [ True
                    | bi <- allBuildInfo pkg_descr
                    , _ <- Map.elems (targetBuildRenaming bi)]) $
        die $ "Your compiler does not support thinning and renaming on "
           ++ "package flags.  To use this feature you probably must use "
           ++ "GHC 7.9 or later."

912
    when (any (not.null.PD.reexportedModules) (PD.libraries pkg_descr)
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
          && not (reexportedModulesSupported comp)) $ do
        die $ "Your compiler does not support module re-exports. To use "
           ++ "this feature you probably must use GHC 7.9 or later."

-- | Select dependencies for the package.
configureDependencies
    :: Verbosity
    -> InstalledPackageIndex -- ^ internal packages
    -> InstalledPackageIndex -- ^ installed packages
    -> Map PackageName InstalledPackageInfo -- ^ required deps
    -> PackageDescription
    -> IO ([PackageId], [InstalledPackageInfo])
configureDependencies verbosity
  internalPackageSet installedPackageSet requiredDepsMap pkg_descr = do
    let selectDependencies :: [Dependency] ->
                              ([FailedDependency], [ResolvedDependency])
        selectDependencies =
            partitionEithers
          . map (selectDependency internalPackageSet installedPackageSet
                                  requiredDepsMap)

        (failedDeps, allPkgDeps) =
          selectDependencies (buildDepends pkg_descr)

        internalPkgDeps = [ pkgid
                          | InternalDependency _ pkgid <- allPkgDeps ]
        externalPkgDeps = [ pkg
                          | ExternalDependency _ pkg   <- allPkgDeps ]

    when (not (null internalPkgDeps)
          && not (newPackageDepsBehaviour pkg_descr)) $
        die $ "The field 'build-depends: "
           ++ intercalate ", " (map (display . packageName) internalPkgDeps)
           ++ "' refers to a library which is defined within the same "
           ++ "package. To use this feature the package must specify at "
           ++ "least 'cabal-version: >= 1.8'."

    reportFailedDependencies failedDeps
    reportSelectedDependencies verbosity allPkgDeps

    return (internalPkgDeps, externalPkgDeps)

955
956
957
-- -----------------------------------------------------------------------------
-- Configuring package dependencies

958
959
960
961
962
reportProgram :: Verbosity -> Program -> Maybe ConfiguredProgram -> IO ()
reportProgram verbosity prog Nothing
    = info verbosity $ "No " ++ programName prog ++ " found"
reportProgram verbosity prog (Just configuredProg)
    = info verbosity $ "Using " ++ programName prog ++ version ++ location
963
964
965
966
967
    where location = case programLocation configuredProg of
            FoundOnSystem p -> " found on system at: " ++ p
            UserSpecified p -> " given by user at: " ++ p
          version = case programVersion configuredProg of
            Nothing -> ""
968
            Just v  -> " version " ++ display v
ijones's avatar
ijones committed
969

970
hackageUrl :: String
971
972
973
hackageUrl = "http://hackage.haskell.org/package/"

data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo
refold's avatar
refold committed
974
                        | InternalDependency Dependency PackageId -- should be a
975
                                                                      -- lib name
976
977
978

data FailedDependency = DependencyNotExists PackageName
                      | DependencyNoVersion Dependency
979

ijones's avatar
ijones committed
980
-- | Test for a package dependency and record the version we have installed.
981
982
selectDependency :: InstalledPackageIndex  -- ^ Internally defined packages
                 -> InstalledPackageIndex  -- ^ Installed packages
983
                 -> Map PackageName InstalledPackageInfo
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
984
985
                    -- ^ Packages for which we have been given specific deps to
                    -- use
986
                 -> Dependency
987
                 -> Either FailedDependency ResolvedDependency
988
selectDependency internalIndex installedIndex requiredDepsMap
989
  dep@(Dependency pkgname vr) =
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
  -- If the dependency specification matches anything in the internal package
  -- index, then we prefer that match to anything in the second.
  -- For example:
  --
  -- Name: MyLibrary
  -- Version: 0.1
  -- Library
  --     ..
  -- Executable my-exec
  --     build-depends: MyLibrary
  --
  -- We want "build-depends: MyLibrary" always to match the internal library
  -- even if there is a newer installed library "MyLibrary-0.2".
  -- However, "build-depends: MyLibrary >= 0.2" should match the installed one.
1004
1005
1006
1007
  case PackageIndex.lookupPackageName internalIndex pkgname of
    [(_,[pkg])] | packageVersion pkg `withinRange` vr
           -> Right $ InternalDependency dep (packageId pkg)

1008
1009
1010
1011
1012
1013
1014
1015
1016
    _      -> case Map.lookup pkgname requiredDepsMap of
      -- If we know the exact pkg to use, then use it.
      Just pkginstance -> Right (ExternalDependency dep pkginstance)
      -- Otherwise we just pick an arbitrary instance of the latest version.
      Nothing -> case PackageIndex.lookupDependency installedIndex dep of
        []   -> Left  $ DependencyNotExists pkgname
        pkgs -> Right $ ExternalDependency dep $
                case last pkgs of
                  (_ver, pkginstances) -> head pkginstances
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033

reportSelectedDependencies :: Verbosity
                           -> [ResolvedDependency] -> IO ()
reportSelectedDependencies verbosity deps =
  info verbosity $ unlines
    [ "Dependency " ++ display (simplifyDependency dep)
                    ++ ": using " ++ display pkgid
    | resolved <- deps
    , let (dep, pkgid) = case resolved of
            ExternalDependency dep' pkg'   -> (dep', packageId pkg')
            InternalDependency dep' pkgid' -> (dep', pkgid') ]

reportFailedDependencies :: [FailedDependency] -> IO ()
reportFailedDependencies []     = return ()
reportFailedDependencies failed =
    die (intercalate "\n\n" (map reportFailedDependency failed))

1034
  where
1035
1036
1037
1038
1039
1040
1041
    reportFailedDependency (DependencyNotExists pkgname) =
         "there is no version of " ++ display pkgname ++ " installed.\n"
      ++ "Perhaps you need to download and install it from\n"
      ++ hackageUrl ++ display pkgname ++ "?"

    reportFailedDependency (DependencyNoVersion dep) =
        "cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n"
ijones's avatar
ijones committed
1042

1043
-- | List all installed packages in the given package databases.
1044
getInstalledPackages :: Verbosity -> Compiler
1045
1046
                     -> PackageDBStack -- ^ The stack of package databases.
                     -> ProgramConfiguration
1047
                     -> IO InstalledPackageIndex
1048
getInstalledPackages verbosity comp packageDBs progconf = do
1049
1050
1051
1052
1053
  when (null packageDBs) $
    die $ "No package databases have been specified. If you use "
       ++ "--package-db=clear, you must follow it with --package-db= "
       ++ "with 'global', 'user' or a specific file."

1054
  info verbosity "Reading installed packages..."
1055
  case compilerFlavor comp of
1056
    GHC   -> GHC.getInstalledPackages verbosity comp packageDBs progconf
1057
1058
1059
1060
    GHCJS -> GHCJS.getInstalledPackages verbosity packageDBs progconf
    JHC   -> JHC.getInstalledPackages verbosity packageDBs progconf
    LHC   -> LHC.getInstalledPackages verbosity packageDBs progconf
    UHC   -> UHC.getInstalledPackages verbosity comp packageDBs progconf
1061
1062
    HaskellSuite {} ->
      HaskellSuite.getInstalledPackages verbosity packageDBs progconf
1063
1064
    flv -> die $ "don't know how to find the installed packages for "
              ++ display flv
ekarttun's avatar
ekarttun committed
1065

1066
-- | Like 'getInstalledPackages', but for a single package DB.
1067
1068
1069
1070
1071
--
-- NB: Why isn't this always a fall through to 'getInstalledPackages'?
-- That is because 'getInstalledPackages' performs some sanity checks
-- on the package database stack in question.  However, when sandboxes
-- are involved these sanity checks are not desirable.
1072
1073
getPackageDBContents :: Verbosity -> Compiler
                     -> PackageDB -> ProgramConfiguration
1074
                     -> IO InstalledPackageIndex
1075
1076
1077
1078
getPackageDBContents verbosity comp packageDB progconf = do
  info verbosity "Reading installed packages..."
  case compilerFlavor comp of
    GHC -> GHC.getPackageDBContents verbosity packageDB progconf
1079
    GHCJS -> GHCJS.getPackageDBContents verbosity packageDB progconf
1080
1081
1082
1083
    -- For other compilers, try to fall back on 'getInstalledPackages'.
    _   -> getInstalledPackages verbosity comp [packageDB] progconf


1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
-- | A set of files (or directories) that can be monitored to detect when
-- there might have been a change in the installed packages.
--
getInstalledPackagesMonitorFiles :: Verbosity -> Compiler
                                 -> PackageDBStack
                                 -> ProgramConfiguration -> Platform
                                 -> IO [FilePath]
getInstalledPackagesMonitorFiles verbosity comp packageDBs progconf platform =
  case compilerFlavor comp of
    GHC   -> GHC.getInstalledPackagesMonitorFiles
               verbosity platform progconf packageDBs
    other -> do
      warn verbosity $ "don't know how to find change monitoring files for "
                    ++ "the installed package databases for " ++ display other
      return []

1100
1101
1102
1103
-- | The user interface specifies the package dbs to use with a combination of
-- @--global@, @--user@ and @--package-db=global|user|clear|$file@.
-- This function combines the global/user flag and interprets the package-db
-- flag into a single package db stack.
1104
--
1105
1106
1107
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags userInstall specificDBs =
    extra initialStack specificDBs
1108
  where
1109
1110
1111
1112
1113
1114
    initialStack | userInstall = [GlobalPackageDB, UserPackageDB]
                 | otherwise   = [GlobalPackageDB]

    extra dbs' []            = dbs'
    extra _    (Nothing:dbs) = extra []             dbs
    extra dbs' (Just db:dbs) = extra (dbs' ++ [db]) dbs
1115

1116
newPackageDepsBehaviourMinVersion :: Version
1117
newPackageDepsBehaviourMinVersion = Version [1,7,1] []
1118
1119
1120
1121
1122
1123
1124

-- In older cabal versions, there was only one set of package dependencies for
-- the whole package. In this version, we can have separate dependencies per
-- target, but we only enable this behaviour if the minimum cabal version
-- specified is >= a certain minimum. Otherwise, for compatibility we use the
-- old behaviour.
newPackageDepsBehaviour :: PackageDescription -> Bool
1125
1126
newPackageDepsBehaviour pkg =
   specVersion pkg >= newPackageDepsBehaviourMinVersion
1127

1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
-- We are given both --constraint="foo < 2.0" style constraints and also
-- specific packages to pick via --dependency="foo=foo-2.0-177d5cdf20962d0581".
--
-- When finalising the package we have to take into account the specific
-- installed deps we've been given, and the finalise function expects
-- constraints, so we have to translate these deps into version constraints.
--
-- But after finalising we then have to make sure we pick the right specific
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints :: [Dependency] ->
1139
                       [(PackageName, UnitId)] ->
1140
                       InstalledPackageIndex ->
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
1141
                       Either String ([Dependency],
1142
1143
1144
                                      Map PackageName InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do

1145
    when (not (null badUnitIds)) $
1146
      Left $ render $ text "The following package dependencies were requested"
1147
         $+$ nest 4 (dispDependencies badUnitIds)
1148
1149
1150
1151
1152
         $+$ text "however the given installed package instance does not exist."

    when (not (null badNames)) $
      Left $ render $ text "The following package dependencies were requested"
         $+$ nest 4 (dispDependencies badNames)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
1153
1154
         $+$ text ("however the installed package's name does not match "
                   ++ "the name given.")
1155
1156
1157
1158

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

    return (allConstraints, idConstraintMap)
1159
1160

  where
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
    allConstraints :: [Dependency]
    allConstraints = constraints
                  ++ [ thisPackageVersion (packageId pkg)
                     | (_, _, Just pkg) <- dependenciesPkgInfo ]

    idConstraintMap :: Map PackageName InstalledPackageInfo
    idConstraintMap = Map.fromList
                        [ (packageName pkg, pkg)
                        | (_, _, Just pkg) <- dependenciesPkgInfo ]

    -- The dependencies along with the installed package info, if it exists
1172
    dependenciesPkgInfo :: [(PackageName, UnitId,
1173
1174
1175
1176
                             Maybe InstalledPackageInfo)]
    dependenciesPkgInfo =
      [ (pkgname, ipkgid, mpkg)
      | (pkgname, ipkgid) <- dependencies
1177
      , let mpkg = PackageIndex.lookupUnitId
1178
1179
                     installedPackages ipkgid
      ]
1180
1181
1182
1183

    -- If we looked up a package specified by an installed package id
    -- (i.e. someone has written a hash) and didn't find it then it's
    -- an error.
1184
    badUnitIds =
1185
1186
      [ (pkgname, ipkgid)
      | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]
1187

1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
    -- If someone has written e.g.
    -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have
    -- probably made a mistake.
    badNames =
      [ (requestedPkgName, ipkgid)
      | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo
      , let foundPkgName = packageName pkg
      , requestedPkgName /= foundPkgName ]

    dispDependencies deps =
      hsep [    text "--dependency="
             <> quotes (disp pkgname <> char '=' <> disp ipkgid)
           | (pkgname, ipkgid) <- deps ]
1201

1202
1203
1204
-- -----------------------------------------------------------------------------
-- Configuring program dependencies

refold's avatar
refold committed
1205
1206
configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration
                             -> IO ProgramConfiguration
1207
1208
1209
configureRequiredPrograms verbosity deps conf =
  foldM (configureRequiredProgram verbosity) conf deps

refold's avatar
refold committed
1210
1211
1212
1213
configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency
                            -> IO ProgramConfiguration
configureRequiredProgram verbosity conf
  (Dependency (PackageName progName) verRange) =
1214
  case lookupKnownProgram progName conf of
Duncan Coutts's avatar
Duncan Coutts committed
1215
    Nothing -> die ("Unknown build tool " ++ progName)
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
    Just prog
      -- requireProgramVersion always requires the program have a version
      -- but if the user says "build-depends: foo" ie no version constraint
      -- then we should not fail if we cannot discover the program version.
      | verRange == anyVersion -> do
          (_, conf') <- requireProgram verbosity prog conf
          return conf'
      | otherwise -> do
          (_, _, conf') <- requireProgramVersion verbosity prog verRange conf
          return conf'
1226

1227
1228
1229
1230
1231
1232
1233
1234
1235
-- -----------------------------------------------------------------------------
-- Configuring pkg-config package dependencies

configurePkgconfigPackages :: Verbosity -> PackageDescription
                           -> ProgramConfiguration
                           -> IO (PackageDescription, ProgramConfiguration)
configurePkgconfigPackages verbosity pkg_descr conf
  | null allpkgs = return (pkg_descr, conf)
  | otherwise    = do
1236
1237
1238
    (_, _, conf') <- requireProgramVersion
                       (lessVerbose verbosity) pkgConfigProgram
                       (orLaterVersion $ Version [0,9,0] []) conf
1239
    mapM_ requirePkg allpkgs
1240
    libs' <- mapM addPkgConfigBILib (libraries pkg_descr)
1241
1242
1243
    exes' <- mapM addPkgConfigBIExe (executables pkg_descr)
    tests' <- mapM addPkgConfigBITest (testSuites pkg_descr)
    benches' <- mapM addPkgConfigBIBench (benchmarks pkg_descr)
1244
    let pkg_descr' = pkg_descr { libraries = libs', executables = exes',
1245
                                 testSuites = tests', benchmarks = benches' }
1246
    return (pkg_descr', conf')
1247
1248

  where
1249
1250
1251
1252
    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)
    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)
                  pkgConfigProgram conf