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