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