Configure.hs 19.5 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
import qualified Distribution.PackageDescription as PkgDesc
68 69 70 71
#ifdef CABAL_PARSEC
import Distribution.PackageDescription.Parsec
         ( readGenericPackageDescription )
#else
72
import Distribution.PackageDescription.Parse
73 74
         ( readGenericPackageDescription )
#endif
75
import Distribution.PackageDescription.Configuration
76
         ( finalizePD )
77
import Distribution.Version
78 79
         ( Version, mkVersion, anyVersion, thisVersion
         , VersionRange, orLaterVersion )
80
import Distribution.Simple.Utils as Utils
Francesco Gazzetta's avatar
Francesco Gazzetta committed
81 82
         ( warn, notice, debug, die'
         , defaultPackageDesc )
83
import Distribution.System
84
         ( Platform )
85
import Distribution.Text ( display )
86 87 88
import Distribution.Verbosity as Verbosity
         ( Verbosity )

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

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

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

108 109 110 111 112 113
-- | Convert 'RelaxDeps' to a boolean.
isRelaxDeps :: RelaxDeps -> Bool
isRelaxDeps RelaxDepsNone     = False
isRelaxDeps (RelaxDepsSome _) = True
isRelaxDeps RelaxDepsAll      = True

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

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

132 133
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
134

135
  progress <- planLocalPackage verbosity comp platform configFlags configExFlags
136
                               installedPkgIndex sourcePkgDb pkgConfigDb
137 138

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

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

161
      _ -> die' verbosity $ "internal error: configure install plan should have exactly "
162 163 164
              ++ "one local ready package."

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

183 184
    logMsg message rest = debug verbosity message >> rest

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

248 249
    maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
    maybeSetupBuildInfo = do
250
      ReadyPackage cpkg <- mpkg
251
      let gpkg = packageDescription (confPkgSource cpkg)
252 253 254 255 256 257 258 259
      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

260
    explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
261 262 263
    explicitSetupDeps = do
      -- Check if there is an explicit setup stanza.
      _buildInfo <- maybeSetupBuildInfo
264
      -- Return the setup dependencies computed by the solver
265
      ReadyPackage cpkg <- mpkg
266
      return [ ( cid, srcid )
267
             | ConfiguredId srcid (Just PkgDesc.CLibName) cid <- CD.setupDeps (confPkgDeps cpkg)
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 293 294
-- | 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 ++ ")"

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

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

322 323 324 325
      testsEnabled = fromFlagOrDefault False $ configTests configFlags
      benchmarksEnabled =
        fromFlagOrDefault False $ configBenchmarks configFlags

326
      resolverParams =
327
          removeLowerBounds
328
          (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configExFlags)
329
        . removeUpperBounds
330
          (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configExFlags)
331

332
        . addPreferences
333 334 335 336 337 338
            -- 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
339 340
            -- TODO: should warn or error on constraints that are not on direct
            -- deps or flag constraints not on the package in question.
341
            [ LabeledPackageConstraint (userToPackageConstraint uc) src
342
            | (uc, src) <- configExConstraints configExFlags ]
343 344 345

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

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

362 363 364 365 366
            -- 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)

367 368
        . setSolverVerbosity verbosity

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

377
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
378

379

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

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

429
    pkg = case finalizePD flags (enableStanzas stanzas)
430
           (const True)
431
           platform comp [] gpkg of
432
      Left _ -> error "finalizePD ReadyPackage failed"
433
      Right (desc, _) -> desc
ttuegel's avatar
ttuegel committed
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 469 470

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