Configure.hs 18.7 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14
-----------------------------------------------------------------------------
-- |
-- 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,
15
    configureSetupScript,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
16
    chooseCabalVersion,
ttuegel's avatar
ttuegel committed
17 18 19 20 21
    checkConfigExFlags,
    -- * Saved configure flags
    readConfigFlagsFrom, readConfigFlags,
    cabalConfigFlagsFile,
    writeConfigFlagsTo, writeConfigFlags,
22 23
  ) where

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

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

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

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

ttuegel's avatar
ttuegel committed
88
import System.FilePath ( (</>) )
89

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

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

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

Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
121
  installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
Edsko de Vries's avatar
Edsko de Vries committed
122
  sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
123
  pkgConfigDb       <- readPkgConfigDb      verbosity progdb
124

125 126
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
127

128
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
129
                               installedPkgIndex sourcePkgDb pkgConfigDb
130 131

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

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

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

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

176 177
    logMsg message rest = debug verbosity message >> rest

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

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

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

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

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

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

312 313 314 315
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

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

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

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

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

350 351 352 353 354
            -- 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)

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

363
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
364

365

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

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

412
    pkg = case finalizePD flags (enableStanzas stanzas)
413
           (const True)
414
           platform comp [] gpkg of
415
      Left _ -> error "finalizePD ReadyPackage failed"
416
      Right (desc, _) -> desc
ttuegel's avatar
ttuegel committed
417 418 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

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