global constraints

cabal-install/Distribution/Client/Config.hs

@@ -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,

cabal-install/Distribution/Client/Freeze.hs

@@ -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 =

cabal-install/Distribution/Client/Sandbox.hs

@@ -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

cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs

@@ -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.

cabal-install/Distribution/Client/Setup.hs

@@ -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,