cabal-install/src/Distribution/Client/Configure.hs

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