Commit bd014aef authored by U-CIQDEV\gbazerman's avatar U-CIQDEV\gbazerman

global constraints

parent 33958554
......@@ -215,6 +215,7 @@ instance Monoid SavedConfig where
globalNumericVersion = combine globalNumericVersion,
globalConfigFile = combine globalConfigFile,
globalSandboxConfigFile = combine globalSandboxConfigFile,
globalConstraintsFile = combine globalConstraintsFile,
globalRemoteRepos = lastNonEmptyNL globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = lastNonEmptyNL globalLocalRepos,
......
......@@ -216,7 +216,7 @@ pruneInstallPlan installPlan pkgSpecifiers =
freezePackages :: Package pkg => Verbosity -> [pkg] -> IO ()
freezePackages verbosity pkgs = do
pkgEnv <- fmap (createPkgEnv . addFrozenConstraints) $
loadUserConfig verbosity ""
loadUserConfig verbosity "" Nothing
writeFileAtomic userPackageEnvironmentFile $ showPkgEnv pkgEnv
where
addFrozenConstraints config =
......
......@@ -86,7 +86,7 @@ import Distribution.Simple.Configure ( configCompilerAuxEx
import Distribution.Simple.PreProcess ( knownSuffixHandlers )
import Distribution.Simple.Program ( ProgramConfiguration )
import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..)
, fromFlagOrDefault )
, fromFlagOrDefault, flagToMaybe )
import Distribution.Simple.SrcDist ( prepareTree )
import Distribution.Simple.Utils ( die, debug, notice, info, warn
, debugNoWrap, defaultPackageDesc
......@@ -522,7 +522,7 @@ loadConfigOrSandboxConfig :: Verbosity
loadConfigOrSandboxConfig verbosity globalFlags = do
let configFileFlag = globalConfigFile globalFlags
sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
ignoreSandboxFlag = globalIgnoreSandbox globalFlags
ignoreSandboxFlag = globalIgnoreSandbox globalFlags
pkgEnvDir <- getPkgEnvDir sandboxConfigFileFlag
pkgEnvType <- classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag
......@@ -538,7 +538,7 @@ loadConfigOrSandboxConfig verbosity globalFlags = do
-- Only @cabal.config@ is present.
UserPackageEnvironment -> do
config <- loadConfig verbosity configFileFlag
userConfig <- loadUserConfig verbosity pkgEnvDir
userConfig <- loadUserConfig verbosity pkgEnvDir Nothing
let config' = config `mappend` userConfig
dieIfSandboxRequired config'
return (NoSandbox, config')
......@@ -546,8 +546,11 @@ loadConfigOrSandboxConfig verbosity globalFlags = do
-- Neither @cabal.sandbox.config@ nor @cabal.config@ are present.
AmbientPackageEnvironment -> do
config <- loadConfig verbosity configFileFlag
let globalConstraintsOpt = flagToMaybe . globalConstraintsFile . savedGlobalFlags $ config
globalConstraintConfig <- loadUserConfig verbosity pkgEnvDir globalConstraintsOpt
let config' = config `mappend` globalConstraintConfig
dieIfSandboxRequired config
return (NoSandbox, config)
return (NoSandbox, config')
where
-- Return the path to the package environment directory - either the
......
......@@ -280,27 +280,30 @@ inheritedPackageEnvironment verbosity pkgEnv = do
return $ mempty { pkgEnvSavedConfig = conf }
-- | Load the user package environment if it exists (the optional "cabal.config"
-- file).
userPackageEnvironment :: Verbosity -> FilePath -> IO PackageEnvironment
userPackageEnvironment verbosity pkgEnvDir = do
let path = pkgEnvDir </> userPackageEnvironmentFile
minp <- readPackageEnvironmentFile ConstraintSourceUserConfig mempty path
case minp of
Nothing -> return mempty
Just (ParseOk warns parseResult) -> do
-- file). If it does not exist locally, attempt to load an optional global one.
userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath -> IO PackageEnvironment
userPackageEnvironment verbosity pkgEnvDir globalConfigLocation = do
let path = pkgEnvDir </> userPackageEnvironmentFile
minp <- readPackageEnvironmentFile ConstraintSourceUserConfig mempty path
case (minp, globalConfigLocation) of
(Just parseRes, _) -> processConfigParse path parseRes
(_, Just globalLoc) -> maybe (warn verbosity ("no constraints file found at " ++ path) >> return mempty) (processConfigParse globalLoc) =<< readPackageEnvironmentFile ConstraintSourceUserConfig mempty globalLoc
_ -> return mempty
where
processConfigParse path (ParseOk warns parseResult) = do
when (not $ null warns) $ warn verbosity $
unlines (map (showPWarning path) warns)
return parseResult
Just (ParseFailed err) -> do
processConfigParse path (ParseFailed err) = do
let (line, msg) = locatedErrorMsg err
warn verbosity $ "Error parsing user package environment file " ++ path
warn verbosity $ "Error parsing package environment file " ++ path
++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
return mempty
-- | Same as @userPackageEnvironmentFile@, but returns a SavedConfig.
loadUserConfig :: Verbosity -> FilePath -> IO SavedConfig
loadUserConfig verbosity pkgEnvDir = fmap pkgEnvSavedConfig
$ userPackageEnvironment verbosity pkgEnvDir
loadUserConfig :: Verbosity -> FilePath -> Maybe FilePath -> IO SavedConfig
loadUserConfig verbosity pkgEnvDir globalConfigLocation =
fmap pkgEnvSavedConfig $ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation
-- | Common error handling code used by 'tryLoadSandboxPackageEnvironment' and
-- 'updatePackageEnvironment'.
......@@ -347,7 +350,7 @@ tryLoadSandboxPackageEnvironmentFile verbosity pkgEnvFile configFileFlag = do
let base = basePackageEnvironment
let common = commonPackageEnvironment sandboxDir
user <- userPackageEnvironment verbosity pkgEnvDir
user <- userPackageEnvironment verbosity pkgEnvDir Nothing --TODO
inherited <- inheritedPackageEnvironment verbosity user
-- Layer the package environment settings over settings from ~/.cabal/config.
......
......@@ -120,6 +120,7 @@ data GlobalFlags = GlobalFlags {
globalNumericVersion :: Flag Bool,
globalConfigFile :: Flag FilePath,
globalSandboxConfigFile :: Flag FilePath,
globalConstraintsFile :: Flag FilePath,
globalRemoteRepos :: NubList RemoteRepo, -- ^ Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: NubList FilePath,
......@@ -136,6 +137,7 @@ defaultGlobalFlags = GlobalFlags {
globalNumericVersion = Flag False,
globalConfigFile = mempty,
globalSandboxConfigFile = mempty,
globalConstraintsFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty,
......@@ -262,7 +264,7 @@ globalCommand commands = CommandUI {
commandNotes = Nothing,
commandDefaultFlags = mempty,
commandOptions = \showOrParseArgs ->
(case showOrParseArgs of ShowArgs -> take 7; ParseArgs -> id)
(case showOrParseArgs of ShowArgs -> take 8; ParseArgs -> id)
[option ['V'] ["version"]
"Print version information"
globalVersion (\v flags -> flags { globalVersion = v })
......@@ -283,6 +285,11 @@ globalCommand commands = CommandUI {
globalConfigFile (\v flags -> flags { globalSandboxConfigFile = v })
(reqArgFlag "FILE")
,option [] ["constraints-file"]
"Set a location for a global constraints file for projects without their own cabal.config freeze file."
globalConfigFile (\v flags -> flags {globalConstraintsFile = v})
(reqArgFlag "FILE")
,option [] ["require-sandbox"]
"requiring the presence of a sandbox for sandbox-aware commands"
globalRequireSandbox (\v flags -> flags { globalRequireSandbox = v })
......@@ -331,6 +338,7 @@ instance Monoid GlobalFlags where
globalNumericVersion = mempty,
globalConfigFile = mempty,
globalSandboxConfigFile = mempty,
globalConstraintsFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty,
......@@ -345,6 +353,7 @@ instance Monoid GlobalFlags where
globalNumericVersion = combine globalNumericVersion,
globalConfigFile = combine globalConfigFile,
globalSandboxConfigFile = combine globalConfigFile,
globalConstraintsFile = combine globalConstraintsFile,
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = combine globalLocalRepos,
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment