Configure.hs 18.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 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.ConstraintSource
43
import           Distribution.Solver.Types.LabeledPackageConstraint
44 45 46 47 48 49 50
import           Distribution.Solver.Types.OptionalStanza
import           Distribution.Solver.Types.PackageIndex
                   ( PackageIndex, elemByPackageName )
import           Distribution.Solver.Types.PkgConfigDb
                   (PkgConfigDb, readPkgConfigDb)
import           Distribution.Solver.Types.SourcePackage

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

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

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

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

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

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

127 128
  checkConfigExFlags verbosity installedPkgIndex
                     (packageIndex sourcePkgDb) configExFlags
129

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

351
        $ standardInstallPolicy
352 353
            installedPkgIndex
            (SourcePackageDb mempty packagePrefs)
354
            [SpecificSourcePackage localPkg]
355

356
  return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
357

358

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

  setupWrapper verbosity
    scriptOptions (Just pkg) configureCommand configureFlags extraArgs

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

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

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