Configure.hs 19.3 KB
Newer Older
1
{-# LANGUAGE CPP #-}
2 3 4 5 6 7 8 9 10 11 12 13 14 15
-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Client.Configure
-- Copyright   :  (c) David Himmelstrup 2005,
--                    Duncan Coutts 2005
-- License     :  BSD-like
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- High level interface to configuring a package.
-----------------------------------------------------------------------------
module Distribution.Client.Configure (
    configure,
16
    configureSetupScript,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
17
    chooseCabalVersion,
ttuegel's avatar
ttuegel committed
18 19 20 21 22
    checkConfigExFlags,
    -- * Saved configure flags
    readConfigFlagsFrom, readConfigFlags,
    cabalConfigFlagsFile,
    writeConfigFlagsTo, writeConfigFlags,
23 24
  ) where

25 26 27
import Prelude ()
import Distribution.Client.Compat.Prelude

28 29
import Distribution.Client.Dependency
import qualified Distribution.Client.InstallPlan as InstallPlan
30
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
31
import Distribution.Client.IndexUtils as IndexUtils
32
         ( getSourcePackages, getInstalledPackages )
33
import Distribution.Client.Setup
ttuegel's avatar
ttuegel committed
34 35
         ( ConfigExFlags(..), RepoContext(..)
         , configureCommand, configureExCommand, filterConfigureFlags )
36
import Distribution.Client.Types as Source
37 38
import Distribution.Client.SetupWrapper
         ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
39
import Distribution.Client.Targets
40
         ( userToPackageConstraint, userConstraintPackageName )
41 42
import Distribution.Package (PackageId)
import Distribution.Client.JobControl (Lock)
43

44
import qualified Distribution.Solver.Types.ComponentDeps as CD
45
import           Distribution.Solver.Types.Settings
46
import           Distribution.Solver.Types.ConstraintSource
47
import           Distribution.Solver.Types.LabeledPackageConstraint
48 49 50 51 52 53 54
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PackageIndex
                   ( PackageIndex, elemByPackageName )
import           Distribution.Solver.Types.PkgConfigDb
                   (PkgConfigDb, readPkgConfigDb)
import           Distribution.Solver.Types.SourcePackage

55
import Distribution.Simple.Compiler
56
         ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
ttuegel's avatar
ttuegel committed
57 58
import Distribution.Simple.Program (ProgramDb)
import Distribution.Client.SavedFlags ( readCommandFlags, writeCommandFlags )
59
import Distribution.Simple.Setup
60
         ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..)
61
         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
62 63
import Distribution.Simple.PackageIndex
         ( InstalledPackageIndex, lookupPackageName )
64 65 66
import Distribution.Simple.Utils
         ( defaultPackageDesc )
import Distribution.Package
67 68 69
         ( Package(..), packageName )
import Distribution.Types.Dependency
         ( Dependency(..), thisPackageVersion )
70
import qualified Distribution.PackageDescription as PkgDesc
71 72 73 74
#ifdef CABAL_PARSEC
import Distribution.PackageDescription.Parsec
         ( readGenericPackageDescription )
#else
75
import Distribution.PackageDescription.Parse
76 77
         ( readGenericPackageDescription )
#endif
78
import Distribution.PackageDescription.Configuration
79
         ( finalizePD )
80
import Distribution.Version
81 82
         ( Version, mkVersion, anyVersion, thisVersion
         , VersionRange, orLaterVersion )
83
import Distribution.Simple.Utils as Utils
84
         ( warn, notice, debug, die )
85
import Distribution.Simple.Setup
86
         ( isRelaxDeps )
87
import Distribution.System
88
         ( Platform )
89
import Distribution.Text ( display )
90 91 92
import Distribution.Verbosity as Verbosity
         ( Verbosity )

ttuegel's avatar
ttuegel committed
93
import System.FilePath ( (</>) )
94

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
95 96
-- | Choose the Cabal version such that the setup scripts compiled against this
-- version will support the given command-line flags.
97 98
chooseCabalVersion :: ConfigFlags -> Maybe Version -> VersionRange
chooseCabalVersion configFlags maybeVersion =
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
99 100
  maybe defaultVersionRange thisVersion maybeVersion
  where
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
101 102
    -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
    -- for '--allow-newer' to work.
103 104
    allowNewer = isRelaxDeps
                 (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags)
105 106
    allowOlder = isRelaxDeps
                 (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configFlags)
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
107

108
    defaultVersionRange = if allowOlder || allowNewer
109
                          then orLaterVersion (mkVersion [1,19,2])
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
110 111
                          else anyVersion

112 113
-- | Configure the package found in the local directory
configure :: Verbosity
114
          -> PackageDBStack
Edsko de Vries's avatar
Edsko de Vries committed
115
          -> RepoContext
116
          -> Compiler
117
          -> Platform
118
          -> ProgramDb
119
          -> ConfigFlags
120
          -> ConfigExFlags
121 122
          -> [String]
          -> IO ()
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
123
configure verbosity packageDBs repoCtxt comp platform progdb
124 125
  configFlags configExFlags extraArgs = do

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
126
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
Edsko de Vries's avatar
Edsko de Vries committed
127
  sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
128
  pkgConfigDb       <- readPkgConfigDb      verbosity progdb
129

130 131
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
132

133
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
134
                               installedPkgIndex sourcePkgDb pkgConfigDb
135 136

  notice verbosity "Resolving dependencies..."
137 138
  maybePlan <- foldProgress logMsg (return . Left) (return . Right)
                            progress
139
  case maybePlan of
140
    Left message -> do
141 142
      warn verbosity $
           "solver failed to find a solution:\n"
143 144
        ++ message
        ++ "Trying configure anyway."
145 146
      setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
        Nothing configureCommand (const configFlags) extraArgs
147

148
    Right installPlan0 ->
149
     let installPlan = InstallPlan.configureInstallPlan installPlan0
150
     in case fst (InstallPlan.ready installPlan) of
151
      [pkg@(ReadyPackage
Edward Z. Yang's avatar
Edward Z. Yang committed
152
              (ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
153
                                 _ _ _))] -> do
154
        configurePackage verbosity
155
          platform (compilerInfo comp)
156
          (setupScriptOptions installedPkgIndex (Just pkg))
157 158 159 160 161 162
          configFlags pkg extraArgs

      _ -> die $ "internal error: configure install plan should have exactly "
              ++ "one local ready package."

  where
163
    setupScriptOptions :: InstalledPackageIndex
164
                       -> Maybe ReadyPackage
165
                       -> SetupScriptOptions
166 167 168 169 170
    setupScriptOptions =
      configureSetupScript
        packageDBs
        comp
        platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
171
        progdb
172 173 174 175
        (fromFlagOrDefault
           (useDistPref defaultSetupScriptOptions)
           (configDistPref configFlags))
        (chooseCabalVersion
176
           configFlags
177 178 179
           (flagToMaybe (configCabalVersion configExFlags)))
        Nothing
        False
180

181 182
    logMsg message rest = debug verbosity message >> rest

183 184 185
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
186
                     -> ProgramDb
187 188 189 190 191
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
192
                     -> Maybe ReadyPackage
193 194 195 196
                     -> SetupScriptOptions
configureSetupScript packageDBs
                     comp
                     platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
197
                     progdb
198 199 200 201 202 203 204
                     distPref
                     cabalVersion
                     lock
                     forceExternal
                     index
                     mpkg
  = SetupScriptOptions {
205 206 207 208 209 210
      useCabalVersion          = cabalVersion
    , useCabalSpecVersion      = Nothing
    , useCompiler              = Just comp
    , usePlatform              = Just platform
    , usePackageDB             = packageDBs'
    , usePackageIndex          = index'
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
211
    , useProgramDb             = progdb
212 213 214
    , useDistPref              = distPref
    , useLoggingHandle         = Nothing
    , useWorkingDir            = Nothing
215
    , useExtraPathEnv          = []
216 217
    , setupCacheLock           = lock
    , useWin32CleanHack        = False
218 219 220 221 222 223 224 225
    , forceExternalSetupMethod = forceExternal
      -- If we have explicit setup dependencies, list them; otherwise, we give
      -- the empty list of dependencies; ideally, we would fix the version of
      -- Cabal here, so that we no longer need the special case for that in
      -- `compileSetupExecutable` in `externalSetupMethod`, but we don't yet
      -- know the version of Cabal at this point, but only find this there.
      -- Therefore, for now, we just leave this blank.
    , useDependencies          = fromMaybe [] explicitSetupDeps
226 227
    , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
    , useVersionMacros         = not defaultSetupDeps && isJust explicitSetupDeps
228
    , isInteractive            = False
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245
    }
  where
    -- When we are compiling a legacy setup script without an explicit
    -- setup stanza, we typically want to allow the UserPackageDB for
    -- finding the Cabal lib when compiling any Setup.hs even if we're doing
    -- a global install. However we also allow looking in a specific package
    -- db.
    packageDBs' :: PackageDBStack
    index'      :: Maybe InstalledPackageIndex
    (packageDBs', index') =
      case packageDBs of
        (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
                              , Nothing <- explicitSetupDeps
            -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
        -- but if the user is using an odd db stack, don't touch it
        _otherwise -> (packageDBs, Just index)

246 247
    maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
    maybeSetupBuildInfo = do
248
      ReadyPackage cpkg <- mpkg
249
      let gpkg = packageDescription (confPkgSource cpkg)
250 251 252 253 254 255 256 257
      PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)

    -- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If
    -- so, 'setup-depends' must not be exclusive. See #3199.
    defaultSetupDeps :: Bool
    defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends
                       maybeSetupBuildInfo

258
    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
259 260 261
    explicitSetupDeps = do
      -- Check if there is an explicit setup stanza.
      _buildInfo <- maybeSetupBuildInfo
262
      -- Return the setup dependencies computed by the solver
263
      ReadyPackage cpkg <- mpkg
264 265
      return [ ( cid, srcid )
             | ConfiguredId srcid cid <- CD.setupDeps (confPkgDeps cpkg)
266 267
             ]

268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292
-- | Warn if any constraints or preferences name packages that are not in the
-- source package index or installed package index.
checkConfigExFlags :: Package pkg
                   => Verbosity
                   -> InstalledPackageIndex
                   -> PackageIndex pkg
                   -> ConfigExFlags
                   -> IO ()
checkConfigExFlags verbosity installedPkgIndex sourcePkgIndex flags = do
  unless (null unknownConstraints) $ warn verbosity $
             "Constraint refers to an unknown package: "
          ++ showConstraint (head unknownConstraints)
  unless (null unknownPreferences) $ warn verbosity $
             "Preference refers to an unknown package: "
          ++ display (head unknownPreferences)
  where
    unknownConstraints = filter (unknown . userConstraintPackageName . fst) $
                         configExConstraints flags
    unknownPreferences = filter (unknown . \(Dependency name _) -> name) $
                         configPreferences flags
    unknown pkg = null (lookupPackageName installedPkgIndex pkg)
               && not (elemByPackageName sourcePkgIndex pkg)
    showConstraint (uc, src) =
        display uc ++ " (" ++ showConstraintSource src ++ ")"

293 294 295 296
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
297
                 -> Platform
298
                 -> ConfigFlags -> ConfigExFlags
299
                 -> InstalledPackageIndex
300
                 -> SourcePackageDb
301
                 -> PkgConfigDb
302
                 -> IO (Progress String String SolverInstallPlan)
303
planLocalPackage verbosity comp platform configFlags configExFlags
304
  installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
305
  pkg <- readGenericPackageDescription verbosity =<<
306 307 308
            case flagToMaybe (configCabalFilePath configFlags) of
                Nothing -> defaultPackageDesc verbosity
                Just fp -> return fp
309 310
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
311 312

  let -- We create a local package and ask to resolve a dependency on it
313 314
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
315
        packageDescription        = pkg,
316 317
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
318
      }
319

320 321 322 323
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

324
      resolverParams =
325 326 327 328
          removeLowerBounds
          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags)
        . removeUpperBounds
          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags)
329

330
        . addPreferences
331 332 333 334 335 336
            -- preferences from the config file or command line
            [ PackageVersionPreference name ver
            | Dependency name ver <- configPreferences configExFlags ]

        . addConstraints
            -- version constraints from the config file or command line
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
337 338
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
339
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
340
            | (uc, src) <- configExConstraints configExFlags ]
341 342 343

        . addConstraints
            -- package flags from the config file or command line
344
            [ let pc = PackageConstraint
345
                       (scopeToplevel $ packageName pkg)
346
                       (PackagePropertyFlags $ configConfigurationsFlags configFlags)
347 348
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
349

350 351
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
352
            -- the config file or command line
353
            [ let pc = PackageConstraint (scopeToplevel $ packageName pkg) .
354
                       PackagePropertyStanzas $
355 356
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
357
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
358 359
            ]

360 361 362 363 364
            -- Don't solve for executables, since we use an empty source
            -- package database and executables never show up in the
            -- installed package index
        . setSolveExecutables (SolveExecutables False)

365 366
        . setSolverVerbosity verbosity

367
        $ standardInstallPolicy
368
            installedPkgIndex
369 370 371
            -- NB: We pass in an *empty* source package database,
            -- because cabal configure assumes that all dependencies
            -- have already been installed
372
            (SourcePackageDb mempty packagePrefs)
373
            [SpecificSourcePackage localPkg]
374

375
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
376

377

378
-- | Call an installer for an 'SourcePackage' but override the configure
379 380
-- flags with the ones given by the 'ReadyPackage'. In particular the
-- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
381 382 383
-- versioned package dependencies. So we ignore any previous partial flag
-- assignment or dependency constraints and use the new ones.
--
384 385
-- NB: when updating this function, don't forget to also update
-- 'installReadyPackage' in D.C.Install.
386
configurePackage :: Verbosity
387
                 -> Platform -> CompilerInfo
388
                 -> SetupScriptOptions
389
                 -> ConfigFlags
390
                 -> ReadyPackage
391 392
                 -> [String]
                 -> IO ()
393
configurePackage verbosity platform comp scriptOptions configFlags
Edward Z. Yang's avatar
Edward Z. Yang committed
394
                 (ReadyPackage (ConfiguredPackage ipid spkg flags stanzas deps))
395
                 extraArgs =
396 397 398 399 400

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
401
    gpkg = packageDescription spkg
402
    configureFlags   = filterConfigureFlags configFlags {
403 404 405 406
      configIPID = if isJust (flagToMaybe (configIPID configFlags))
                    -- Make sure cabal configure --ipid works.
                    then configIPID configFlags
                    else toFlag (display ipid),
407
      configConfigurationsFlags = flags,
408 409 410
      -- We generate the legacy constraints as well as the new style precise
      -- deps.  In the end only one set gets passed to Setup.hs configure,
      -- depending on the Cabal version we are talking to.
411 412 413 414
      configConstraints  = [ thisPackageVersion srcid
                           | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
      configDependencies = [ (packageName srcid, uid)
                           | ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
415 416
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
417
      configVerbosity          = toFlag verbosity,
418 419 420 421 422
      -- NB: if the user explicitly specified
      -- --enable-tests/--enable-benchmarks, always respect it.
      -- (But if they didn't, let solver decide.)
      configBenchmarks         = toFlag (BenchStanzas `elem` stanzas)
                                    `mappend` configBenchmarks configFlags,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
423
      configTests              = toFlag (TestStanzas `elem` stanzas)
424
                                    `mappend` configTests configFlags
425 426
    }

427
    pkg = case finalizePD flags (enableStanzas stanzas)
428
           (const True)
429
           platform comp [] gpkg of
430
      Left _ -> error "finalizePD ReadyPackage failed"
431
      Right (desc, _) -> desc
ttuegel's avatar
ttuegel committed
432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468

-- -----------------------------------------------------------------------------
-- * Saved configure environments and flags
-- -----------------------------------------------------------------------------

-- | Read saved configure flags and restore the saved environment from the
-- specified files.
readConfigFlagsFrom :: FilePath  -- ^ path to saved flags file
                    -> IO (ConfigFlags, ConfigExFlags)
readConfigFlagsFrom flags = do
  readCommandFlags flags configureExCommand

-- | The path (relative to @--build-dir@) where the arguments to @configure@
-- should be saved.
cabalConfigFlagsFile :: FilePath -> FilePath
cabalConfigFlagsFile dist = dist </> "cabal-config-flags"

-- | Read saved configure flags and restore the saved environment from the
-- usual location.
readConfigFlags :: FilePath  -- ^ @--build-dir@
                -> IO (ConfigFlags, ConfigExFlags)
readConfigFlags dist =
  readConfigFlagsFrom (cabalConfigFlagsFile dist)

-- | Save the configure flags and environment to the specified files.
writeConfigFlagsTo :: FilePath  -- ^ path to saved flags file
                   -> Verbosity -> (ConfigFlags, ConfigExFlags)
                   -> IO ()
writeConfigFlagsTo file verb flags = do
  writeCommandFlags verb file configureExCommand flags

-- | Save the build flags to the usual location.
writeConfigFlags :: Verbosity
                 -> FilePath  -- ^ @--build-dir@
                 -> (ConfigFlags, ConfigExFlags) -> IO ()
writeConfigFlags verb dist =
  writeConfigFlagsTo (cabalConfigFlagsFile dist) verb