Configure.hs 50.8 KB
Newer Older
1 2
-----------------------------------------------------------------------------
-- |
ijones's avatar
ijones committed
3
-- Module      :  Distribution.Simple.Configure
4
-- Copyright   :  Isaac Jones 2003-2005
5
--
Duncan Coutts's avatar
Duncan Coutts committed
6
-- Maintainer  :  cabal-devel@haskell.org
ijones's avatar
ijones committed
7
-- Portability :  portable
8
--
Duncan Coutts's avatar
Duncan Coutts committed
9 10 11 12 13 14 15 16
-- 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)
17
--
Duncan Coutts's avatar
Duncan Coutts committed
18 19 20 21
-- 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.
22

ijones's avatar
ijones committed
23
{- All rights reserved.
24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Isaac Jones nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}

ijones's avatar
ijones committed
53 54
module Distribution.Simple.Configure (configure,
                                      writePersistBuildConfig,
ijones's avatar
ijones committed
55
                                      getPersistBuildConfig,
56
                                      checkPersistBuildConfigOutdated,
57
                                      maybeGetPersistBuildConfig,
ijones's avatar
ijones committed
58
                                      localBuildInfoFile,
59
                                      getInstalledPackages,
60
                                      configCompiler, configCompilerAux,
61
                                      ccLdOptionsBuildInfo,
jpbernardy's avatar
jpbernardy committed
62
                                      tryGetConfigStateFile,
63
                                      checkForeignDeps,
64
                                      interpretPackageDbFlags,
ijones's avatar
ijones committed
65
                                     )
ijones's avatar
ijones committed
66
    where
67

68
import Distribution.Simple.Compiler
69
    ( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion
70 71
    , showCompilerId, unsupportedLanguages, unsupportedExtensions
    , PackageDB(..), PackageDBStack )
72
import Distribution.Package
73
    ( PackageName(PackageName), PackageIdentifier(..), PackageId
74
    , packageName, packageVersion, Package(..)
75 76
    , Dependency(Dependency), simplifyDependency
    , InstalledPackageId(..) )
77 78 79
import Distribution.InstalledPackageInfo as Installed
    ( InstalledPackageInfo, InstalledPackageInfo_(..)
    , emptyInstalledPackageInfo )
80 81
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (PackageIndex)
82
import Distribution.PackageDescription as PD
83
    ( PackageDescription(..), specVersion, GenericPackageDescription(..)
84
    , Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
85
    , HookedBuildInfo, updatePackageDescription, allBuildInfo
86
    , FlagName(..), TestSuite(..), Benchmark(..) )
87
import Distribution.PackageDescription.Configuration
88
    ( finalizePackageDescription, mapTreeData )
89
import Distribution.PackageDescription.Check
90
    ( PackageCheck(..), checkPackage, checkPackageFiles )
91
import Distribution.Simple.Hpc ( enableCoverage )
92
import Distribution.Simple.Program
93
    ( Program(..), ProgramLocation(..), ConfiguredProgram(..)
Duncan Coutts's avatar
Duncan Coutts committed
94
    , ProgramConfiguration, defaultProgramConfiguration
95
    , configureAllKnownPrograms, knownPrograms, lookupKnownProgram
96
    , userSpecifyArgss, userSpecifyPaths
97
    , requireProgram, requireProgramVersion
98
    , pkgConfigProgram, gccProgram, rawSystemProgramStdoutConf )
99
import Distribution.Simple.Setup
100
    ( ConfigFlags(..), CopyDest(..), fromFlag, fromFlagOrDefault, flagToMaybe )
101
import Distribution.Simple.InstallDirs
102
    ( InstallDirs(..), defaultInstallDirs, combineInstallDirs )
103
import Distribution.Simple.LocalBuildInfo
104
    ( LocalBuildInfo(..), ComponentLocalBuildInfo(..)
105 106
    , absoluteInstallDirs, prefixRelativeInstallDirs, inplacePackageId
    , allComponentsBy, Component(..), foldComponent, ComponentName(..) )
107 108
import Distribution.Simple.BuildPaths
    ( autogenModulesDir )
109
import Distribution.Simple.Utils
110
    ( die, warn, info, setupMessage, createDirectoryIfMissingVerbose
111
    , intercalate, cabalVersion
112
    , withFileContents, writeFileAtomic
113
    , withTempFile )
114
import Distribution.System
115
    ( OS(..), buildOS, Arch(..), buildArch, buildPlatform )
116
import Distribution.Version
117
         ( Version(..), anyVersion, orLaterVersion, withinRange, isAnyVersion )
118
import Distribution.Verbosity
119
    ( Verbosity, lessVerbose )
120

121 122
import qualified Distribution.Simple.GHC  as GHC
import qualified Distribution.Simple.JHC  as JHC
David Himmelstrup's avatar
David Himmelstrup committed
123
import qualified Distribution.Simple.LHC  as LHC
124 125
import qualified Distribution.Simple.NHC  as NHC
import qualified Distribution.Simple.Hugs as Hugs
Andres Loeh's avatar
Andres Loeh committed
126
import qualified Distribution.Simple.UHC  as UHC
127

128
import Control.Monad
129
    ( when, unless, foldM, filterM, forM )
130
import Data.List
131
    ( nub, partition, isPrefixOf, inits, find )
132
import Data.Maybe
133
    ( isNothing, catMaybes, mapMaybe )
134 135
import Data.Monoid
    ( Monoid(..) )
136 137
import Data.Graph
    ( SCC(..), graphFromEdges, transposeG, vertices, stronglyConnCompR )
138
import System.Directory
139
    ( doesFileExist, getModificationTime, createDirectoryIfMissing, getTemporaryDirectory )
140 141 142
import System.Exit
    ( ExitCode(..), exitWith )
import System.FilePath
143
    ( (</>), isAbsolute )
144
import qualified System.Info
145
    ( compilerName, compilerVersion )
146
import System.IO
147
    ( hPutStrLn, stderr, hClose )
148
import Distribution.Text
149
    ( Text(disp), display, simpleParse )
dterei's avatar
dterei committed
150
import Text.PrettyPrint
151
    ( comma, punctuate, render, nest, sep )
152
import Distribution.Compat.Exception ( catchExit, catchIO )
153

154 155
import qualified Data.ByteString.Lazy.Char8 as BS.Char8

156 157
tryGetConfigStateFile :: (Read a) => FilePath -> IO (Either String a)
tryGetConfigStateFile filename = do
158 159 160
  exists <- doesFileExist filename
  if not exists
    then return (Left missing)
161 162
    else withFileContents filename $ \str ->
      case lines str of
163
        [headder, rest] -> case checkHeader headder of
164
          Just msg -> return (Left msg)
165
          Nothing  -> case reads rest of
166 167 168
            [(bi,_)] -> return (Right bi)
            _        -> return (Left cantParse)
        _            -> return (Left cantParse)
169 170 171
  where
    checkHeader :: String -> Maybe String
    checkHeader header = case parseHeader header of
172
      Just (cabalId, compId)
173 174
        | cabalId
       == currentCabalId -> Nothing
175
        | otherwise      -> Just (badVersion cabalId compId)
176 177 178 179 180
      Nothing            -> Just cantParse

    missing   = "Run the 'configure' command first."
    cantParse = "Saved package config file seems to be corrupt. "
             ++ "Try re-running the 'configure' command."
181
    badVersion cabalId compId
182 183
              = "You need to re-run the 'configure' command. "
             ++ "The version of Cabal being used has changed (was "
184 185
             ++ display cabalId ++ ", now "
             ++ display currentCabalId ++ ")."
186 187 188
             ++ badcompiler compId
    badcompiler compId | compId == currentCompilerId = ""
                       | otherwise
189
              = " Additionally the compiler is different (was "
190
             ++ display compId ++ ", now "
191
             ++ display currentCompilerId
192
             ++ ") which is probably the cause of the problem."
193

194
-- internal function
195 196 197
tryGetPersistBuildConfig :: FilePath -> IO (Either String LocalBuildInfo)
tryGetPersistBuildConfig distPref
    = tryGetConfigStateFile (localBuildInfoFile distPref)
198

199 200 201
-- |Read the 'localBuildInfoFile'.  Error if it doesn't exist.  Also
-- fail if the file containing LocalBuildInfo is older than the .cabal
-- file, indicating that a re-configure is required.
202 203 204
getPersistBuildConfig :: FilePath -> IO LocalBuildInfo
getPersistBuildConfig distPref = do
  lbi <- tryGetPersistBuildConfig distPref
205 206
  either die return lbi

ijones's avatar
ijones committed
207
-- |Try to read the 'localBuildInfoFile'.
208 209 210
maybeGetPersistBuildConfig :: FilePath -> IO (Maybe LocalBuildInfo)
maybeGetPersistBuildConfig distPref = do
  lbi <- tryGetPersistBuildConfig distPref
211
  return $ either (const Nothing) Just lbi
ijones's avatar
ijones committed
212

ijones's avatar
ijones committed
213 214
-- |After running configure, output the 'LocalBuildInfo' to the
-- 'localBuildInfoFile'.
215 216
writePersistBuildConfig :: FilePath -> LocalBuildInfo -> IO ()
writePersistBuildConfig distPref lbi = do
Ross Paterson's avatar
Ross Paterson committed
217
  createDirectoryIfMissing False distPref
218
  writeFileAtomic (localBuildInfoFile distPref)
219
                  (BS.Char8.pack $ showHeader pkgid ++ '\n' : show lbi)
220 221 222 223 224
  where
    pkgid   = packageId (localPkgDescr lbi)

showHeader :: PackageIdentifier -> String
showHeader pkgid =
225 226 227
     "Saved package config for " ++ display pkgid
  ++ " written by " ++ display currentCabalId
  ++      " using " ++ display currentCompilerId
228 229 230
  where

currentCabalId :: PackageIdentifier
231
currentCabalId = PackageIdentifier (PackageName "Cabal") cabalVersion
232 233

currentCompilerId :: PackageIdentifier
Duncan Coutts's avatar
Duncan Coutts committed
234
currentCompilerId = PackageIdentifier (PackageName System.Info.compilerName)
235 236
                                      System.Info.compilerVersion

237
parseHeader :: String -> Maybe (PackageIdentifier, PackageIdentifier)
238 239 240
parseHeader header = case words header of
  ["Saved", "package", "config", "for", pkgid,
   "written", "by", cabalid, "using", compilerid]
241 242 243
    -> case (simpleParse pkgid :: Maybe PackageIdentifier,
             simpleParse cabalid,
             simpleParse compilerid) of
244 245 246 247 248
        (Just _,
         Just cabalid',
         Just compilerid') -> Just (cabalid', compilerid')
        _                  -> Nothing
  _                        -> Nothing
249

250 251
-- |Check that localBuildInfoFile is up-to-date with respect to the
-- .cabal file.
252 253
checkPersistBuildConfigOutdated :: FilePath -> FilePath -> IO Bool
checkPersistBuildConfigOutdated distPref pkg_descr_file = do
254
  t0 <- getModificationTime pkg_descr_file
255
  t1 <- getModificationTime $ localBuildInfoFile distPref
256
  return (t0 > t1)
257

Ross Paterson's avatar
Ross Paterson committed
258
-- |@dist\/setup-config@
259 260
localBuildInfoFile :: FilePath -> FilePath
localBuildInfoFile distPref = distPref </> "setup-config"
ijones's avatar
ijones committed
261

262
-- -----------------------------------------------------------------------------
ijones's avatar
ijones committed
263 264
-- * Configuration
-- -----------------------------------------------------------------------------
265

266 267
-- |Perform the \"@.\/setup configure@\" action.
-- Returns the @.setup-config@ file.
268
configure :: (GenericPackageDescription, HookedBuildInfo)
269
          -> ConfigFlags -> IO LocalBuildInfo
270
configure (pkg_descr0, pbi) cfg
271
  = do  let distPref = fromFlag (configDistPref cfg)
intractable's avatar
intractable committed
272
            buildDir' = distPref </> "build"
273
            verbosity = fromFlag (configVerbosity cfg)
274

Duncan Coutts's avatar
Duncan Coutts committed
275
        setupMessage verbosity "Configuring" (packageId pkg_descr0)
276

277
        createDirectoryIfMissingVerbose (lessVerbose verbosity) True distPref
278

279 280 281
        let programsConfig = userSpecifyArgss (configProgramArgs cfg)
                           . userSpecifyPaths (configProgramPaths cfg)
                           $ configPrograms cfg
282
            userInstall = fromFlag (configUserInstall cfg)
283 284
            packageDbs  = interpretPackageDbFlags userInstall
                            (configPackageDBs cfg)
285

286 287
        -- detect compiler
        (comp, programsConfig') <- configCompiler
288 289 290
          (flagToMaybe $ configHcFlavor cfg)
          (flagToMaybe $ configHcPath cfg) (flagToMaybe $ configHcPkg cfg)
          programsConfig (lessVerbose verbosity)
291 292
        let version = compilerVersion comp
            flavor  = compilerFlavor comp
293

294
        -- Create a PackageIndex that makes *any libraries that might be*
295 296 297 298 299 300 301 302 303 304 305 306 307 308
        -- 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.
309
        let pid = packageId pkg_descr0
310 311 312 313 314 315 316 317 318
            internalPackage = emptyInstalledPackageInfo {
                --TODO: should use a per-compiler method to map the source
                --      package ID into an installed package id we can use
                --      for the internal package set. The open-codes use of
                --      InstalledPackageId . display here is a hack.
                Installed.installedPackageId = InstalledPackageId $ display $ pid,
                Installed.sourcePackageId = pid
              }
            internalPackageSet = PackageIndex.fromList [internalPackage]
319
        installedPackageSet <- getInstalledPackages (lessVerbose verbosity) comp
320
                                      packageDbs programsConfig'
321

322
        let -- Constraint test function for the solver
323 324 325 326
            dependencySatisfiable =
                not . null . PackageIndex.lookupDependency pkgs'
              where
                pkgs' = PackageIndex.insert internalPackage installedPackageSet
327 328 329
            enableTest t = t { testEnabled = fromFlag (configTests cfg) }
            flaggedTests = map (\(n, t) -> (n, mapTreeData enableTest t))
                               (condTestSuites pkg_descr0)
330 331 332 333 334
            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 }
335

336
        (pkg_descr0', flags) <-
337
                case finalizePackageDescription
338
                       (configConfigurationsFlags cfg)
339 340
                       dependencySatisfiable
                       Distribution.System.buildPlatform
341
                       (compilerId comp)
342
                       (configConstraints cfg)
ttuegel's avatar
ttuegel committed
343
                       pkg_descr0''
344
                of Right r -> return r
345
                   Left missing ->
346
                       die $ "At least the following dependencies are missing:\n"
347 348 349
                         ++ (render . nest 4 . sep . punctuate comma
                                    . map (disp . simplifyDependency)
                                    $ missing)
350

351 352
        -- add extra include/lib dirs as specified in cfg
        -- we do it here so that those get checked too
353 354 355
        let pkg_descr =
                enableCoverage (fromFlag (configLibCoverage cfg)) distPref
                $ addExtraIncludeLibDirs pkg_descr0'
356

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

362
        checkPackageProblems verbosity pkg_descr0
363
          (updatePackageDescription pbi pkg_descr)
364

365
        let selectDependencies =
366 367 368
                (\xs -> ([ x | Left x <- xs ], [ x | Right x <- xs ]))
              . map (selectDependency internalPackageSet installedPackageSet)

369
            (failedDeps, allPkgDeps) = selectDependencies (buildDepends pkg_descr)
370 371 372

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

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

381 382
        reportFailedDependencies failedDeps
        reportSelectedDependencies verbosity allPkgDeps
383

384
        packageDependsIndex <-
385 386
          case PackageIndex.dependencyClosure installedPackageSet
                  (map Installed.installedPackageId externalPkgDeps) of
387 388 389
            Left packageDependsIndex -> return packageDependsIndex
            Right broken ->
              die $ "The following installed packages are broken because other"
390 391
                 ++ " packages they depend on are missing. These broken "
                 ++ "packages must be rebuilt before they can be used.\n"
392
                 ++ unlines [ "package "
393
                           ++ display (packageId pkg)
394
                           ++ " is broken due to missing package "
395
                           ++ intercalate ", " (map display deps)
396 397
                            | (pkg, deps) <- broken ]

398
        let pseudoTopPkg = emptyInstalledPackageInfo {
399
                Installed.installedPackageId = InstalledPackageId (display (packageId pkg_descr)),
400
                Installed.sourcePackageId = packageId pkg_descr,
401
                Installed.depends = map Installed.installedPackageId externalPkgDeps
402
              }
403
        case PackageIndex.dependencyInconsistencies
Duncan Coutts's avatar
Duncan Coutts committed
404
           . PackageIndex.insert pseudoTopPkg
405
           $ packageDependsIndex of
406 407 408
          [] -> return ()
          inconsistencies ->
            warn verbosity $
409
                 "This package indirectly depends on multiple versions of the same "
410
              ++ "package. This is highly likely to cause a compile failure.\n"
411 412
              ++ unlines [ "package " ++ display pkg ++ " requires "
                        ++ display (PackageIdentifier name ver)
413 414
                         | (name, uses) <- inconsistencies
                         , (pkg, ver) <- uses ]
Simon Marlow's avatar
Simon Marlow committed
415

416 417 418
        -- installation directories
        defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
        let installDirs = combineInstallDirs fromFlagOrDefault
419
                            defaultDirs (configInstallDirs cfg)
420

421 422 423 424 425 426 427 428
        -- 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)
429
        let extlist = nub $ concatMap allExtensions (allBuildInfo pkg_descr)
430
        let exts = unsupportedExtensions comp extlist
431 432 433 434 435
        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)
436

437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452
        -- 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'
453
          >>= configureRequiredPrograms verbosity requiredBuildTools
intractable's avatar
intractable committed
454

455 456
        (pkg_descr', programsConfig''') <-
          configurePkgconfigPackages verbosity pkg_descr programsConfig''
457

458 459 460 461 462 463
        split_objs <-
           if not (fromFlag $ configSplitObjs cfg)
                then return False
                else case flavor of
                            GHC | version >= Version [6,5] [] -> return True
                            _ -> do warn verbosity
Ian Lynagh's avatar
Ian Lynagh committed
464
                                         ("this compiler does not support " ++
465 466 467
                                          "--enable-split-objs; ignoring")
                                    return False

468
        -- The allPkgDeps contains all the package deps for the whole package
469 470 471 472 473
        -- but we need to select the subset for this specific component.
        -- we just take the subset for the package names this component
        -- needs. Note, this only works because we cannot yet depend on two
        -- versions of the same package.
        let configLib lib = configComponent (libBuildInfo lib)
474
            configExe exe = (exeName exe, configComponent (buildInfo exe))
475 476
            configTest test = (testName test,
                    configComponent(testBuildInfo test))
477 478
            configBenchmark bm = (benchmarkName bm,
                    configComponent(benchmarkBuildInfo bm))
479
            configComponent bi = ComponentLocalBuildInfo {
480
              componentPackageDeps =
481
                if newPackageDepsBehaviour pkg_descr'
482
                  then [ (installedPackageId pkg, packageId pkg)
483
                       | pkg <- selectSubset bi externalPkgDeps ]
484
                    ++ [ (inplacePackageId pkgid, pkgid)
485
                       | pkgid <- selectSubset bi internalPkgDeps ]
486
                  else [ (installedPackageId pkg, packageId pkg)
487
                       | pkg <- externalPkgDeps ]
488
            }
489 490
            selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg]
            selectSubset bi pkgs =
491 492 493 494
                [ pkg | pkg <- pkgs, packageName pkg `elem` names ]
              where
                names = [ name | Dependency name _ <- targetBuildDepends bi ]

495 496 497 498 499
        -- Obtains the intrapackage dependencies for the given component
        let ipDeps component =
                 mapMaybe exeDepToComp (buildTools bi)
              ++ mapMaybe libDepToComp (targetBuildDepends bi)
              where
500 501
                bi = foldComponent libBuildInfo buildInfo testBuildInfo
                     benchmarkBuildInfo component
502 503 504 505 506 507 508 509 510 511 512 513
                exeDepToComp (Dependency (PackageName name) _) =
                  CExe `fmap` find ((==) name . exeName)
                                (executables pkg_descr')
                libDepToComp (Dependency pn _)
                  | pn `elem` map packageName internalPkgDeps =
                    CLib `fmap` library pkg_descr'
                libDepToComp _ = Nothing

        let sccs = (stronglyConnCompR . map lkup . vertices . transposeG) g
              where (g, lkup, _) = graphFromEdges
                                 $ allComponentsBy pkg_descr'
                                 $ \c -> (c, key c, map key (ipDeps c))
514 515
                    key          = foldComponent (const "library") exeName
                                   testName benchmarkName
516 517 518

        -- check for cycles in the dependency graph
        buildOrder <- forM sccs $ \scc -> case scc of
519 520 521
          AcyclicSCC (c,_,_) -> return (foldComponent (const CLibName)
                                                      (CExeName . exeName)
                                                      (CTestName . testName)
522
                                                      (CBenchName . benchmarkName)
523
                                                      c)
524 525 526 527 528 529
          CyclicSCC vs ->
            die $ "Found cycle in intrapackage dependency graph:\n  "
                ++ intercalate " depends on "
                     (map (\(_,k,_) -> "'" ++ k ++ "'") (vs ++ [head vs]))

        let lbi = LocalBuildInfo {
530
                    configFlags         = cfg,
531 532 533
                    extraConfigArgs     = [],  -- Currently configure does not
                                               -- take extra args, but if it
                                               -- did they would go here.
534 535
                    installDirTemplates = installDirs,
                    compiler            = comp,
536
                    buildDir            = buildDir',
537
                    scratchDir          = fromFlagOrDefault
538 539
                                            (distPref </> "scratch")
                                            (configScratchDir cfg),
540 541
                    libraryConfig       = configLib `fmap` library pkg_descr',
                    executableConfigs   = configExe `fmap` executables pkg_descr',
542
                    testSuiteConfigs    = configTest `fmap` testSuites pkg_descr',
543
                    benchmarkConfigs    = configBenchmark `fmap` benchmarks pkg_descr',
544
                    compBuildOrder      = buildOrder,
545
                    installedPkgs       = packageDependsIndex,
546
                    pkgDescrFile        = Nothing,
547
                    localPkgDescr       = pkg_descr',
548
                    withPrograms        = programsConfig''',
549 550 551
                    withVanillaLib      = fromFlag $ configVanillaLib cfg,
                    withProfLib         = fromFlag $ configProfLib cfg,
                    withSharedLib       = fromFlag $ configSharedLib cfg,
552
                    withDynExe          = fromFlag $ configDynExe cfg,
553 554 555 556
                    withProfExe         = fromFlag $ configProfExe cfg,
                    withOptimization    = fromFlag $ configOptimization cfg,
                    withGHCiLib         = fromFlag $ configGHCiLib cfg,
                    splitObjs           = split_objs,
557
                    stripExes           = fromFlag $ configStripExes cfg,
558
                    withPackageDB       = packageDbs,
559 560
                    progPrefix          = fromFlag $ configProgPrefix cfg,
                    progSuffix          = fromFlag $ configProgSuffix cfg
Duncan Coutts's avatar
Duncan Coutts committed
561
                  }
ijones's avatar
ijones committed
562

563
        let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest
564
            relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi
565

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

569 570
        info verbosity $ "Using " ++ display currentCabalId
                      ++ " compiled by " ++ display currentCompilerId
571 572
        info verbosity $ "Using compiler: " ++ showCompilerId comp
        info verbosity $ "Using install prefix: " ++ prefix dirs
573

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

582 583 584 585 586 587 588
        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)

        sequence_ [ reportProgram verbosity prog configuredProg
589
                  | (prog, configuredProg) <- knownPrograms programsConfig''' ]
590

591
        return lbi
592

593 594 595
    where
      addExtraIncludeLibDirs pkg_descr =
          let extraBi = mempty { extraLibDirs = configExtraLibDirs cfg
Malcolm.Wallace's avatar
Malcolm.Wallace committed
596
                               , PD.includeDirs = configExtraIncludeDirs cfg}
597 598 599 600
              modifyLib l        = l{ libBuildInfo = libBuildInfo l `mappend` extraBi }
              modifyExecutable e = e{ buildInfo    = buildInfo e    `mappend` extraBi}
          in pkg_descr{ library     = modifyLib        `fmap` library pkg_descr
                      , executables = modifyExecutable  `map` executables pkg_descr}
601

602 603 604
-- -----------------------------------------------------------------------------
-- Configuring package dependencies

605 606 607 608 609
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
610 611 612 613 614
    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 -> ""
615
            Just v  -> " version " ++ display v
ijones's avatar
ijones committed
616

617
hackageUrl :: String
618 619 620 621 622 623 624
hackageUrl = "http://hackage.haskell.org/package/"

data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo
                        | InternalDependency Dependency PackageId -- should be a lib name

data FailedDependency = DependencyNotExists PackageName
                      | DependencyNoVersion Dependency
625

ijones's avatar
ijones committed
626
-- | Test for a package dependency and record the version we have installed.
627
selectDependency :: PackageIndex  -- ^ Internally defined packages
Duncan Coutts's avatar
Duncan Coutts committed
628
                 -> PackageIndex  -- ^ Installed packages
629
                 -> Dependency
630 631 632
                 -> Either FailedDependency ResolvedDependency
selectDependency internalIndex installedIndex
  dep@(Dependency pkgname vr) =
633 634 635 636 637 638 639 640 641 642 643 644 645 646
  -- 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.
647 648 649 650
  case PackageIndex.lookupPackageName internalIndex pkgname of
    [(_,[pkg])] | packageVersion pkg `withinRange` vr
           -> Right $ InternalDependency dep (packageId pkg)

651
    _      -> case PackageIndex.lookupDependency installedIndex dep of
652 653 654 655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671 672 673
      []   -> Left  $ DependencyNotExists pkgname
      pkgs -> Right $ ExternalDependency dep $
                -- by default we just pick the latest
                case last pkgs of
                  (_ver, instances) -> head instances -- the first preference

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))

674
  where
675 676 677 678 679 680 681
    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
682

683 684
getInstalledPackages :: Verbosity -> Compiler
                     -> PackageDBStack -> ProgramConfiguration
685
                     -> IO PackageIndex
686
getInstalledPackages verbosity comp packageDBs progconf = do
687 688 689 690 691
  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."

692
  info verbosity "Reading installed packages..."
693
  case compilerFlavor comp of
694 695 696 697 698
    GHC -> GHC.getInstalledPackages verbosity packageDBs progconf
    Hugs->Hugs.getInstalledPackages verbosity packageDBs progconf
    JHC -> JHC.getInstalledPackages verbosity packageDBs progconf
    LHC -> LHC.getInstalledPackages verbosity packageDBs progconf
    NHC -> NHC.getInstalledPackages verbosity packageDBs progconf
699
    UHC -> UHC.getInstalledPackages verbosity comp packageDBs progconf
700 701
    flv -> die $ "don't know how to find the installed packages for "
              ++ display flv
ekarttun's avatar
ekarttun committed
702

703 704 705 706
-- | 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.
707
--
708 709 710
interpretPackageDbFlags :: Bool -> [Maybe PackageDB] -> PackageDBStack
interpretPackageDbFlags userInstall specificDBs =
    extra initialStack specificDBs
711
  where
712 713 714 715 716 717
    initialStack | userInstall = [GlobalPackageDB, UserPackageDB]
                 | otherwise   = [GlobalPackageDB]

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

719 720 721 722 723 724 725 726 727
newPackageDepsBehaviourMinVersion :: Version
newPackageDepsBehaviourMinVersion = Version { versionBranch = [1,7,1], versionTags = [] }

-- 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
728 729
newPackageDepsBehaviour pkg =
   specVersion pkg >= newPackageDepsBehaviourMinVersion
730

731 732 733 734 735 736 737 738
-- -----------------------------------------------------------------------------
-- Configuring program dependencies

configureRequiredPrograms :: Verbosity -> [Dependency] -> ProgramConfiguration -> IO ProgramConfiguration
configureRequiredPrograms verbosity deps conf =
  foldM (configureRequiredProgram verbosity) conf deps

configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency -> IO ProgramConfiguration
Duncan Coutts's avatar
Duncan Coutts committed
739
configureRequiredProgram verbosity conf (Dependency (PackageName progName) verRange) =
740
  case lookupKnownProgram progName conf of
Duncan Coutts's avatar
Duncan Coutts committed
741
    Nothing -> die ("Unknown build tool " ++ progName)
742 743 744 745 746 747 748 749 750 751
    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'
752

753 754 755 756 757 758 759 760 761
-- -----------------------------------------------------------------------------
-- 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
762 763 764
    (_, _, conf') <- requireProgramVersion
                       (lessVerbose verbosity) pkgConfigProgram
                       (orLaterVersion $ Version [0,9,0] []) conf
765 766 767 768 769
    mapM_ requirePkg allpkgs
    lib'  <- updateLibrary (library pkg_descr)
    exes' <- mapM updateExecutable (executables pkg_descr)
    let pkg_descr' = pkg_descr { library = lib', executables = exes' }
    return (pkg_descr', conf')
770 771

  where
772 773 774 775
    allpkgs = concatMap pkgconfigDepends (allBuildInfo pkg_descr)
    pkgconfig = rawSystemProgramStdoutConf (lessVerbose verbosity)
                  pkgConfigProgram conf

Duncan Coutts's avatar
Duncan Coutts committed
776
    requirePkg dep@(Dependency (PackageName pkg) range) = do
777
      version <- pkgconfig ["--modversion", pkg]
778 779
                 `catchIO`   (\_ -> die notFound)
                 `catchExit` (\_ -> die notFound)
780
      case simpleParse version of
781 782
        Nothing -> die "parsing output of pkg-config --modversion failed"
        Just v | not (withinRange v range) -> die (badVersion v)
783
               | otherwise                 -> info verbosity (depSatisfied v)
784
      where