Configure.hs 18.8 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 25 26
  ) where

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

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

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

86
import Control.Monad (unless)
87
#if !MIN_VERSION_base(4,8,0)
88
import Data.Monoid (Monoid(..))
89
#endif
90
import Data.Maybe (isJust, fromMaybe)
ttuegel's avatar
ttuegel committed
91
import System.FilePath ( (</>) )
92

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

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

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

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

128 129
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
130

131
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
132
                               installedPkgIndex sourcePkgDb pkgConfigDb
133 134

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

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

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

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

179 180
    logMsg message rest = debug verbosity message >> rest

181 182 183
configureSetupScript :: PackageDBStack
                     -> Compiler
                     -> Platform
184
                     -> ProgramDb
185 186 187 188 189
                     -> FilePath
                     -> VersionRange
                     -> Maybe Lock
                     -> Bool
                     -> InstalledPackageIndex
190
                     -> Maybe ReadyPackage
191 192 193 194
                     -> SetupScriptOptions
configureSetupScript packageDBs
                     comp
                     platform
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
195
                     progdb
196 197 198 199 200 201 202
                     distPref
                     cabalVersion
                     lock
                     forceExternal
                     index
                     mpkg
  = SetupScriptOptions {
203 204 205 206 207 208
      useCabalVersion          = cabalVersion
    , useCabalSpecVersion      = Nothing
    , useCompiler              = Just comp
    , usePlatform              = Just platform
    , usePackageDB             = packageDBs'
    , usePackageIndex          = index'
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
209
    , useProgramDb             = progdb
210 211 212
    , useDistPref              = distPref
    , useLoggingHandle         = Nothing
    , useWorkingDir            = Nothing
213
    , useExtraPathEnv          = []
214 215
    , setupCacheLock           = lock
    , useWin32CleanHack        = False
216 217 218 219 220 221 222 223
    , 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
224 225
    , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
    , useVersionMacros         = not defaultSetupDeps && isJust explicitSetupDeps
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
    }
  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)

243 244
    maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
    maybeSetupBuildInfo = do
245
      ReadyPackage cpkg <- mpkg
246
      let gpkg = packageDescription (confPkgSource cpkg)
247 248 249 250 251 252 253 254
      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

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

265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289
-- | 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 ++ ")"

290 291 292 293
-- | Make an 'InstallPlan' for the unpacked package in the current directory,
-- and all its dependencies.
--
planLocalPackage :: Verbosity -> Compiler
294
                 -> Platform
295
                 -> ConfigFlags -> ConfigExFlags
296
                 -> InstalledPackageIndex
297
                 -> SourcePackageDb
298
                 -> PkgConfigDb
299
                 -> IO (Progress String String SolverInstallPlan)
300
planLocalPackage verbosity comp platform configFlags configExFlags
301
  installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
302
  pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
303 304
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
305 306

  let -- We create a local package and ask to resolve a dependency on it
307 308
      localPkg = SourcePackage {
        packageInfoId             = packageId pkg,
309
        packageDescription        = pkg,
310 311
        packageSource             = LocalUnpackedPackage ".",
        packageDescrOverride      = Nothing
312
      }
313

314 315 316 317
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

318
      resolverParams =
319 320 321 322
          removeLowerBounds
          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags)
        . removeUpperBounds
          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags)
323

324
        . addPreferences
325 326 327 328 329 330
            -- 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
331 332
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
333
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
334
            | (uc, src) <- configExConstraints configExFlags ]
335 336 337

        . addConstraints
            -- package flags from the config file or command line
338 339
            [ let pc = PackageConstraintFlags (packageName pkg)
                       (configConfigurationsFlags configFlags)
340 341
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
342

343 344
        . addConstraints
            -- '--enable-tests' and '--enable-benchmarks' constraints from
345
            -- the config file or command line
346 347 348
            [ let pc = PackageConstraintStanzas (packageName pkg) $
                       [ TestStanzas  | testsEnabled ] ++
                       [ BenchStanzas | benchmarksEnabled ]
349
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
350 351
            ]

352 353 354 355 356
            -- 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)

357
        $ standardInstallPolicy
358
            installedPkgIndex
359 360 361
            -- NB: We pass in an *empty* source package database,
            -- because cabal configure assumes that all dependencies
            -- have already been installed
362
            (SourcePackageDb mempty packagePrefs)
363
            [SpecificSourcePackage localPkg]
364

365
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
366

367

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

  where
391
    gpkg = packageDescription spkg
392
    configureFlags   = filterConfigureFlags configFlags {
Edward Z. Yang's avatar
Edward Z. Yang committed
393
      configIPID = toFlag (display ipid),
394
      configConfigurationsFlags = flags,
395 396 397
      -- 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.
398 399 400 401
      configConstraints  = [ thisPackageVersion srcid
                           | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
      configDependencies = [ (packageName srcid, uid)
                           | ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
402 403
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
404
      configVerbosity          = toFlag verbosity,
405 406 407 408 409
      -- 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
410
      configTests              = toFlag (TestStanzas `elem` stanzas)
411
                                    `mappend` configTests configFlags
412 413
    }

414
    pkg = case finalizePD flags (enableStanzas stanzas)
415
           (const True)
416
           platform comp [] gpkg of
417
      Left _ -> error "finalizePD ReadyPackage failed"
418
      Right (desc, _) -> desc
ttuegel's avatar
ttuegel committed
419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455

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