cabal-install/Distribution/Client/Configure.hs

   1 -----------------------------------------------------------------------------
   2 -- |
   3 -- Module      :  Distribution.Client.Configure
   4 -- Copyright   :  (c) David Himmelstrup 2005,
   5 --                    Duncan Coutts 2005
   6 -- License     :  BSD-like
   7 --
   8 -- Maintainer  :  cabal-devel@haskell.org
   9 -- Portability :  portable
  10 --
  11 -- High level interface to configuring a package.
  12 -----------------------------------------------------------------------------
  13 module Distribution.Client.Configure (
  14     configure,
  15     configureSetupScript,
  16     chooseCabalVersion,
  17     checkConfigExFlags,
  18     -- * Saved configure flags
  19     readConfigFlagsFrom, readConfigFlags,
  20     cabalConfigFlagsFile,
  21     writeConfigFlagsTo, writeConfigFlags,
  22   ) where
  23
  24 import Prelude ()
  25 import Distribution.Client.Compat.Prelude
  26
  27 import Distribution.Client.Dependency
  28 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
  33          ( ConfigExFlags(..), RepoContext(..)
  34          , configureCommand, configureExCommand, filterConfigureFlags )
  35 import Distribution.Client.Types as Source
  36 import Distribution.Client.SetupWrapper
  37          ( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
  38 import Distribution.Client.Targets
  39          ( userToPackageConstraint, userConstraintPackageName )
  40 import Distribution.Package (PackageId)
  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 import           Distribution.Solver.Types.OptionalStanza
  48 import           Distribution.Solver.Types.PackageIndex
  49                    ( PackageIndex, elemByPackageName )
  50 import           Distribution.Solver.Types.PkgConfigDb
  51                    (PkgConfigDb, readPkgConfigDb)
  52 import           Distribution.Solver.Types.SourcePackage
  53
  54 import Distribution.Simple.Compiler
  55          ( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
  56 import Distribution.Simple.Program (ProgramDb)
  57 import Distribution.Client.SavedFlags ( readCommandFlags, writeCommandFlags )
  58 import Distribution.Simple.Setup
  59          ( ConfigFlags(..), AllowNewer(..), AllowOlder(..), RelaxDeps(..)
  60          , fromFlag, toFlag, flagToMaybe, fromFlagOrDefault )
  61 import Distribution.Simple.PackageIndex
  62          ( InstalledPackageIndex, lookupPackageName )
  63 import Distribution.Simple.Utils
  64          ( defaultPackageDesc )
  65 import Distribution.Package
  66          ( Package(..), packageName )
  67 import Distribution.Types.Dependency
  68          ( Dependency(..), thisPackageVersion )
  69 import qualified Distribution.PackageDescription as PkgDesc
  70 import Distribution.PackageDescription.Parse
  71          ( readPackageDescription )
  72 import Distribution.PackageDescription.Configuration
  73          ( finalizePD )
  74 import Distribution.Version
  75          ( Version, mkVersion, anyVersion, thisVersion
  76          , VersionRange, orLaterVersion )
  77 import Distribution.Simple.Utils as Utils
  78          ( warn, notice, debug, die )
  79 import Distribution.Simple.Setup
  80          ( isRelaxDeps )
  81 import Distribution.System
  82          ( Platform )
  83 import Distribution.Text ( display )
  84 import Distribution.Verbosity as Verbosity
  85          ( Verbosity )
  86
  87 import System.FilePath ( (</>) )
  88
  89 -- | Choose the Cabal version such that the setup scripts compiled against this
  90 -- version will support the given command-line flags.
  91 chooseCabalVersion :: ConfigFlags -> Maybe Version -> VersionRange
  92 chooseCabalVersion configFlags maybeVersion =
  93   maybe defaultVersionRange thisVersion maybeVersion
  94   where
  95     -- Cabal < 1.19.2 doesn't support '--exact-configuration' which is needed
  96     -- for '--allow-newer' to work.
  97     allowNewer = isRelaxDeps
  98                  (maybe RelaxDepsNone unAllowNewer $ configAllowNewer configFlags)
  99     allowOlder = isRelaxDeps
 100                  (maybe RelaxDepsNone unAllowOlder $ configAllowOlder configFlags)
 101
 102     defaultVersionRange = if allowOlder || allowNewer
 103                           then orLaterVersion (mkVersion [1,19,2])
 104                           else anyVersion
 105
 106 -- | Configure the package found in the local directory
 107 configure :: Verbosity
 108           -> PackageDBStack
 109           -> RepoContext
 110           -> Compiler
 111           -> Platform
 112           -> ProgramDb
 113           -> ConfigFlags
 114           -> ConfigExFlags
 115           -> [String]
 116           -> IO ()
 117 configure verbosity packageDBs repoCtxt comp platform progdb
 118   configFlags configExFlags extraArgs = do
 119
 120   installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
 121   sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
 122   pkgConfigDb       <- readPkgConfigDb      verbosity progdb
 123
 124   checkConfigExFlags verbosity installedPkgIndex
 125                      (packageIndex sourcePkgDb) configExFlags
 126
 127   progress <- planLocalPackage verbosity comp platform configFlags configExFlags
 128                                installedPkgIndex sourcePkgDb pkgConfigDb
 129
 130   notice verbosity "Resolving dependencies..."
 131   maybePlan <- foldProgress logMsg (return . Left) (return . Right)
 132                             progress
 133   case maybePlan of
 134     Left message -> do
 135       warn verbosity $
 136            "solver failed to find a solution:\n"
 137         ++ message
 138         ++ "Trying configure anyway."
 139       setupWrapper verbosity (setupScriptOptions installedPkgIndex Nothing)
 140         Nothing configureCommand (const configFlags) extraArgs
 141
 142     Right installPlan0 ->
 143      let installPlan = InstallPlan.configureInstallPlan installPlan0
 144      in case fst (InstallPlan.ready installPlan) of
 145       [pkg@(ReadyPackage
 146               (ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
 147                                  _ _ _))] -> do
 148         configurePackage verbosity
 149           platform (compilerInfo comp)
 150           (setupScriptOptions installedPkgIndex (Just pkg))
 151           configFlags pkg extraArgs
 152
 153       _ -> die $ "internal error: configure install plan should have exactly "
 154               ++ "one local ready package."
 155
 156   where
 157     setupScriptOptions :: InstalledPackageIndex
 158                        -> Maybe ReadyPackage
 159                        -> SetupScriptOptions
 160     setupScriptOptions =
 161       configureSetupScript
 162         packageDBs
 163         comp
 164         platform
 165         progdb
 166         (fromFlagOrDefault
 167            (useDistPref defaultSetupScriptOptions)
 168            (configDistPref configFlags))
 169         (chooseCabalVersion
 170            configFlags
 171            (flagToMaybe (configCabalVersion configExFlags)))
 172         Nothing
 173         False
 174
 175     logMsg message rest = debug verbosity message >> rest
 176
 177 configureSetupScript :: PackageDBStack
 178                      -> Compiler
 179                      -> Platform
 180                      -> ProgramDb
 181                      -> FilePath
 182                      -> VersionRange
 183                      -> Maybe Lock
 184                      -> Bool
 185                      -> InstalledPackageIndex
 186                      -> Maybe ReadyPackage
 187                      -> SetupScriptOptions
 188 configureSetupScript packageDBs
 189                      comp
 190                      platform
 191                      progdb
 192                      distPref
 193                      cabalVersion
 194                      lock
 195                      forceExternal
 196                      index
 197                      mpkg
 198   = SetupScriptOptions {
 199       useCabalVersion          = cabalVersion
 200     , useCabalSpecVersion      = Nothing
 201     , useCompiler              = Just comp
 202     , usePlatform              = Just platform
 203     , usePackageDB             = packageDBs'
 204     , usePackageIndex          = index'
 205     , useProgramDb             = progdb
 206     , useDistPref              = distPref
 207     , useLoggingHandle         = Nothing
 208     , useWorkingDir            = Nothing
 209     , useExtraPathEnv          = []
 210     , setupCacheLock           = lock
 211     , useWin32CleanHack        = False
 212     , forceExternalSetupMethod = forceExternal
 213       -- If we have explicit setup dependencies, list them; otherwise, we give
 214       -- the empty list of dependencies; ideally, we would fix the version of
 215       -- Cabal here, so that we no longer need the special case for that in
 216       -- `compileSetupExecutable` in `externalSetupMethod`, but we don't yet
 217       -- know the version of Cabal at this point, but only find this there.
 218       -- Therefore, for now, we just leave this blank.
 219     , useDependencies          = fromMaybe [] explicitSetupDeps
 220     , useDependenciesExclusive = not defaultSetupDeps && isJust explicitSetupDeps
 221     , useVersionMacros         = not defaultSetupDeps && isJust explicitSetupDeps
 222     , isInteractive            = False
 223     }
 224   where
 225     -- When we are compiling a legacy setup script without an explicit
 226     -- setup stanza, we typically want to allow the UserPackageDB for
 227     -- finding the Cabal lib when compiling any Setup.hs even if we're doing
 228     -- a global install. However we also allow looking in a specific package
 229     -- db.
 230     packageDBs' :: PackageDBStack
 231     index'      :: Maybe InstalledPackageIndex
 232     (packageDBs', index') =
 233       case packageDBs of
 234         (GlobalPackageDB:dbs) | UserPackageDB `notElem` dbs
 235                               , Nothing <- explicitSetupDeps
 236             -> (GlobalPackageDB:UserPackageDB:dbs, Nothing)
 237         -- but if the user is using an odd db stack, don't touch it
 238         _otherwise -> (packageDBs, Just index)
 239
 240     maybeSetupBuildInfo :: Maybe PkgDesc.SetupBuildInfo
 241     maybeSetupBuildInfo = do
 242       ReadyPackage cpkg <- mpkg
 243       let gpkg = packageDescription (confPkgSource cpkg)
 244       PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
 245
 246     -- Was a default 'custom-setup' stanza added by 'cabal-install' itself? If
 247     -- so, 'setup-depends' must not be exclusive. See #3199.
 248     defaultSetupDeps :: Bool
 249     defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends
 250                        maybeSetupBuildInfo
 251
 252     explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
 253     explicitSetupDeps = do
 254       -- Check if there is an explicit setup stanza.
 255       _buildInfo <- maybeSetupBuildInfo
 256       -- Return the setup dependencies computed by the solver
 257       ReadyPackage cpkg <- mpkg
 258       return [ ( cid, srcid )
 259              | ConfiguredId srcid cid <- CD.setupDeps (confPkgDeps cpkg)
 260              ]
 261
 262 -- | Warn if any constraints or preferences name packages that are not in the
 263 -- source package index or installed package index.
 264 checkConfigExFlags :: Package pkg
 265                    => Verbosity
 266                    -> InstalledPackageIndex
 267                    -> PackageIndex pkg
 268                    -> ConfigExFlags
 269                    -> IO ()
 270 checkConfigExFlags verbosity installedPkgIndex sourcePkgIndex flags = do
 271   unless (null unknownConstraints) $ warn verbosity $
 272              "Constraint refers to an unknown package: "
 273           ++ showConstraint (head unknownConstraints)
 274   unless (null unknownPreferences) $ warn verbosity $
 275              "Preference refers to an unknown package: "
 276           ++ display (head unknownPreferences)
 277   where
 278     unknownConstraints = filter (unknown . userConstraintPackageName . fst) $
 279                          configExConstraints flags
 280     unknownPreferences = filter (unknown . \(Dependency name _) -> name) $
 281                          configPreferences flags
 282     unknown pkg = null (lookupPackageName installedPkgIndex pkg)
 283                && not (elemByPackageName sourcePkgIndex pkg)
 284     showConstraint (uc, src) =
 285         display uc ++ " (" ++ showConstraintSource src ++ ")"
 286
 287 -- | Make an 'InstallPlan' for the unpacked package in the current directory,
 288 -- and all its dependencies.
 289 --
 290 planLocalPackage :: Verbosity -> Compiler
 291                  -> Platform
 292                  -> ConfigFlags -> ConfigExFlags
 293                  -> InstalledPackageIndex
 294                  -> SourcePackageDb
 295                  -> PkgConfigDb
 296                  -> IO (Progress String String SolverInstallPlan)
 297 planLocalPackage verbosity comp platform configFlags configExFlags
 298   installedPkgIndex (SourcePackageDb _ packagePrefs) pkgConfigDb = do
 299   pkg <- readPackageDescription verbosity =<<
 300             case flagToMaybe (configCabalFilePath configFlags) of
 301                 Nothing -> defaultPackageDesc verbosity
 302                 Just fp -> return fp
 303   solver <- chooseSolver verbosity (fromFlag $ configSolver configExFlags)
 304             (compilerInfo comp)
 305
 306   let -- We create a local package and ask to resolve a dependency on it
 307       localPkg = SourcePackage {
 308         packageInfoId             = packageId pkg,
 309         packageDescription        = pkg,
 310         packageSource             = LocalUnpackedPackage ".",
 311         packageDescrOverride      = Nothing
 312       }
 313
 314       testsEnabled = fromFlagOrDefault False $ configTests configFlags
 315       benchmarksEnabled =
 316         fromFlagOrDefault False $ configBenchmarks configFlags
 317
 318       resolverParams =
 319           removeLowerBounds
 320           (fromMaybe (AllowOlder RelaxDepsNone) $ configAllowOlder configFlags)
 321         . removeUpperBounds
 322           (fromMaybe (AllowNewer RelaxDepsNone) $ configAllowNewer configFlags)
 323
 324         . addPreferences
 325             -- preferences from the config file or command line
 326             [ PackageVersionPreference name ver
 327             | Dependency name ver <- configPreferences configExFlags ]
 328
 329         . addConstraints
 330             -- version constraints from the config file or command line
 331             -- TODO: should warn or error on constraints that are not on direct
 332             -- deps or flag constraints not on the package in question.
 333             [ LabeledPackageConstraint (userToPackageConstraint uc) src
 334             | (uc, src) <- configExConstraints configExFlags ]
 335
 336         . addConstraints
 337             -- package flags from the config file or command line
 338             [ let pc = PackageConstraint
 339                        (unqualified $ packageName pkg)
 340                        (PackagePropertyFlags $ configConfigurationsFlags configFlags)
 341               in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
 342             ]
 343
 344         . addConstraints
 345             -- '--enable-tests' and '--enable-benchmarks' constraints from
 346             -- the config file or command line
 347             [ let pc = PackageConstraint (unqualified $ packageName pkg) .
 348                        PackagePropertyStanzas $
 349                        [ TestStanzas  | testsEnabled ] ++
 350                        [ BenchStanzas | benchmarksEnabled ]
 351               in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget
 352             ]
 353
 354             -- Don't solve for executables, since we use an empty source
 355             -- package database and executables never show up in the
 356             -- installed package index
 357         . setSolveExecutables (SolveExecutables False)
 358
 359         $ standardInstallPolicy
 360             installedPkgIndex
 361             -- NB: We pass in an *empty* source package database,
 362             -- because cabal configure assumes that all dependencies
 363             -- have already been installed
 364             (SourcePackageDb mempty packagePrefs)
 365             [SpecificSourcePackage localPkg]
 366
 367   return (resolveDependencies platform (compilerInfo comp) pkgConfigDb solver resolverParams)
 368
 369
 370 -- | Call an installer for an 'SourcePackage' but override the configure
 371 -- flags with the ones given by the 'ReadyPackage'. In particular the
 372 -- 'ReadyPackage' specifies an exact 'FlagAssignment' and exactly
 373 -- versioned package dependencies. So we ignore any previous partial flag
 374 -- assignment or dependency constraints and use the new ones.
 375 --
 376 -- NB: when updating this function, don't forget to also update
 377 -- 'installReadyPackage' in D.C.Install.
 378 configurePackage :: Verbosity
 379                  -> Platform -> CompilerInfo
 380                  -> SetupScriptOptions
 381                  -> ConfigFlags
 382                  -> ReadyPackage
 383                  -> [String]
 384                  -> IO ()
 385 configurePackage verbosity platform comp scriptOptions configFlags
 386                  (ReadyPackage (ConfiguredPackage ipid spkg flags stanzas deps))
 387                  extraArgs =
 388
 389   setupWrapper verbosity
 390     scriptOptions (Just pkg) configureCommand configureFlags extraArgs
 391
 392   where
 393     gpkg = packageDescription spkg
 394     configureFlags   = filterConfigureFlags configFlags {
 395       configIPID = if isJust (flagToMaybe (configIPID configFlags))
 396                     -- Make sure cabal configure --ipid works.
 397                     then configIPID configFlags
 398                     else toFlag (display ipid),
 399       configConfigurationsFlags = flags,
 400       -- We generate the legacy constraints as well as the new style precise
 401       -- deps.  In the end only one set gets passed to Setup.hs configure,
 402       -- depending on the Cabal version we are talking to.
 403       configConstraints  = [ thisPackageVersion srcid
 404                            | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
 405       configDependencies = [ (packageName srcid, uid)
 406                            | ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
 407       -- Use '--exact-configuration' if supported.
 408       configExactConfiguration = toFlag True,
 409       configVerbosity          = toFlag verbosity,
 410       -- NB: if the user explicitly specified
 411       -- --enable-tests/--enable-benchmarks, always respect it.
 412       -- (But if they didn't, let solver decide.)
 413       configBenchmarks         = toFlag (BenchStanzas `elem` stanzas)
 414                                     `mappend` configBenchmarks configFlags,
 415       configTests              = toFlag (TestStanzas `elem` stanzas)
 416                                     `mappend` configTests configFlags
 417     }
 418
 419     pkg = case finalizePD flags (enableStanzas stanzas)
 420            (const True)
 421            platform comp [] gpkg of
 422       Left _ -> error "finalizePD ReadyPackage failed"
 423       Right (desc, _) -> desc
 424
 425 -- -----------------------------------------------------------------------------
 426 -- * Saved configure environments and flags
 427 -- -----------------------------------------------------------------------------
 428
 429 -- | Read saved configure flags and restore the saved environment from the
 430 -- specified files.
 431 readConfigFlagsFrom :: FilePath  -- ^ path to saved flags file
 432                     -> IO (ConfigFlags, ConfigExFlags)
 433 readConfigFlagsFrom flags = do
 434   readCommandFlags flags configureExCommand
 435
 436 -- | The path (relative to @--build-dir@) where the arguments to @configure@
 437 -- should be saved.
 438 cabalConfigFlagsFile :: FilePath -> FilePath
 439 cabalConfigFlagsFile dist = dist </> "cabal-config-flags"
 440
 441 -- | Read saved configure flags and restore the saved environment from the
 442 -- usual location.
 443 readConfigFlags :: FilePath  -- ^ @--build-dir@
 444                 -> IO (ConfigFlags, ConfigExFlags)
 445 readConfigFlags dist =
 446   readConfigFlagsFrom (cabalConfigFlagsFile dist)
 447
 448 -- | Save the configure flags and environment to the specified files.
 449 writeConfigFlagsTo :: FilePath  -- ^ path to saved flags file
 450                    -> Verbosity -> (ConfigFlags, ConfigExFlags)
 451                    -> IO ()
 452 writeConfigFlagsTo file verb flags = do
 453   writeCommandFlags verb file configureExCommand flags
 454
 455 -- | Save the build flags to the usual location.
 456 writeConfigFlags :: Verbosity
 457                  -> FilePath  -- ^ @--build-dir@
 458                  -> (ConfigFlags, ConfigExFlags) -> IO ()
 459 writeConfigFlags verb dist =
 460   writeConfigFlagsTo (cabalConfigFlagsFile dist) verb