Configure.hs 19.4 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
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 60
         ( ConfigFlags(..)
         , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
61 62
import Distribution.Simple.PackageIndex
         ( InstalledPackageIndex, lookupPackageName )
63
import Distribution.Package
Francesco Gazzetta's avatar
Francesco Gazzetta committed
64
         ( Package(..), packageName, PackageId )
65 66
import Distribution.Types.Dependency
         ( Dependency(..), thisPackageVersion )
67 68
import Distribution.Types.GivenComponent
         ( GivenComponent(..) )
69
import qualified Distribution.PackageDescription as PkgDesc
70 71
import Distribution.PackageDescription.Parsec
         ( readGenericPackageDescription )
72
import Distribution.PackageDescription.Configuration
73
         ( finalizePD )
74
import Distribution.Version
75 76
         ( Version, mkVersion, anyVersion, thisVersion
         , VersionRange, orLaterVersion )
77
import Distribution.Simple.Utils as Utils
Francesco Gazzetta's avatar
Francesco Gazzetta committed
78 79
         ( warn, notice, debug, die'
         , defaultPackageDesc )
80
import Distribution.System
81
         ( Platform )
82
import Distribution.Text ( display )
83 84 85
import Distribution.Verbosity as Verbosity
         ( Verbosity )

ttuegel's avatar
ttuegel committed
86
import System.FilePath ( (</>) )
87

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

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

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

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

123 124
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
125

126
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
127
                               installedPkgIndex sourcePkgDb pkgConfigDb
128 129

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

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

152
      _ -> die' verbosity $ "internal error: configure install plan should have exactly "
153 154 155
              ++ "one local ready package."

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

174 175
    logMsg message rest = debug verbosity message >> rest

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

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

252
    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
253 254 255
    explicitSetupDeps = do
      -- Check if there is an explicit setup stanza.
      _buildInfo <- maybeSetupBuildInfo
256
      -- Return the setup dependencies computed by the solver
257
      ReadyPackage cpkg <- mpkg
258
      return [ ( cid, srcid )
259 260
             | ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) 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 <- readGenericPackageDescription verbosity =<<
301 302 303
            case flagToMaybe (configCabalFilePath configFlags) of
                Nothing -> defaultPackageDesc verbosity
                Just fp -> return fp
304 305
  solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
            (compilerInfo comp)
306 307

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

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

319
      resolverParams =
320
          removeLowerBounds
321
          (fromMaybe (AllowOlder mempty) $ configAllowOlder configExFlags)
322
        . removeUpperBounds
323
          (fromMaybe (AllowNewer mempty) $ configAllowNewer configExFlags)
324

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

        . addConstraints
            -- package flags from the config file or command line
339
            [ let pc = PackageConstraint
340
                       (scopeToplevel $ packageName pkg)
341
                       (PackagePropertyFlags $ configConfigurationsFlags configFlags)
342 343
              in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
            ]
344

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

355 356 357 358 359
            -- 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)

360 361
        . setSolverVerbosity verbosity

362
        $ standardInstallPolicy
363
            installedPkgIndex
364 365 366
            -- NB: We pass in an *empty* source package database,
            -- because cabal configure assumes that all dependencies
            -- have already been installed
367
            (SourcePackageDb mempty packagePrefs)
368
            [SpecificSourcePackage localPkg]
369

370
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
371

372

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

  setupWrapper verbosity
393
    scriptOptions (Just pkg) configureCommand configureFlags (const extraArgs)
394 395

  where
396
    gpkg = packageDescription spkg
397
    configureFlags   = filterConfigureFlags configFlags {
398 399 400 401
      configIPID = if isJust (flagToMaybe (configIPID configFlags))
                    -- Make sure cabal configure --ipid works.
                    then configIPID configFlags
                    else toFlag (display ipid),
402
      configConfigurationsFlags = flags,
403 404 405
      -- 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.
406
      configConstraints  = [ thisPackageVersion srcid
407 408
                           | ConfiguredId srcid (Just (PkgDesc.CLibName PkgDesc.LMainLibName)) _uid
                               <- CD.nonSetupDeps deps ],
409
      configDependencies = [ GivenComponent (packageName srcid) cname uid
410 411
                           | ConfiguredId srcid (Just (PkgDesc.CLibName cname)) uid
                               <- CD.nonSetupDeps deps ],
412 413
      -- Use '--exact-configuration' if supported.
      configExactConfiguration = toFlag True,
Mikhail Glushenkov's avatar
Mikhail Glushenkov committed
414
      configVerbosity          = toFlag verbosity,
415 416 417 418 419
      -- 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
420
      configTests              = toFlag (TestStanzas `elem` stanzas)
421
                                    `mappend` configTests configFlags
422 423
    }

424
    pkg = case finalizePD flags (enableStanzas stanzas)
425
           (const True)
426
           platform comp [] gpkg of
427
      Left _ -> error "finalizePD ReadyPackage failed"
428
      Right (desc, _) -> desc
ttuegel's avatar
ttuegel committed
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 456 457 458 459 460 461 462 463 464 465

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