Skip to content

GitLab

Commit e921b1d6 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files
Options

Add a global '--sandbox-config-file' option. 

Allows to specify an alternate location for the sandbox config file
(@cabal.sandbox.config@) instead of the current directory.

Usage: 'cabal --sandbox-config-file=/path/to/config build'.

Fixes #1356.
parent 6b3e9677
Hide whitespace changes
Inline Side-by-side
Showing with 178 additions and 148 deletions
cabal-install/Distribution/Client/Sandbox.hs
View file @ e921b1d6
......@@ -54,8 +54,8 @@ import Distribution.Client.Install ( InstallArgs,
processInstallPlan )
import Distribution.Client.Sandbox.PackageEnvironment
( PackageEnvironment(..), IncludeComments(..), PackageEnvironmentType(..)
, createPackageEnvironment, classifyPackageEnvironment
, tryLoadSandboxPackageEnvironment, loadUserConfig
, createPackageEnvironmentFile, classifyPackageEnvironment
, tryLoadSandboxPackageEnvironmentFile, loadUserConfig
, commentPackageEnvironment, showPackageEnvironmentWithComments
, sandboxPackageEnvironmentFile, userPackageEnvironmentFile )
import Distribution.Client.Sandbox.Types ( SandboxPackageInfo(..)
......@@ -76,7 +76,7 @@ import Distribution.Simple.Program ( ProgramConfiguration )
import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..)
, fromFlagOrDefault )
import Distribution.Simple.SrcDist ( prepareTree )
import Distribution.Simple.Utils ( die, debug, notice, info, warn
import Distribution.Simple.Utils ( die, debug, notice, warn
, debugNoWrap, defaultPackageDesc
, findPackageDesc
, intercalate, topHandlerWith
......@@ -110,7 +110,8 @@ import System.Directory ( createDirectory
, removeFile
, renameDirectory )
import System.FilePath ( (</>), getSearchPath
, searchPathSeparator )
, searchPathSeparator
, takeDirectory )
--
......@@ -152,21 +153,35 @@ sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""
-- * Basic sandbox functions.
--
-- | Load the default package environment file. In addition to a
-- @PackageEnvironment@, also return a canonical path to the sandbox. Exit with
-- error if the sandbox directory or the package environment file do not exist.
tryLoadSandboxConfig :: Verbosity -> Flag FilePath
-- | Return the path to the package environment directory - either the current
-- directory or the one that @--sandbox-config-file@ resides in.
getPkgEnvDir :: GlobalFlags -> IO FilePath
getPkgEnvDir globalFlags = do
let sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
case sandboxConfigFileFlag of
NoFlag -> getCurrentDirectory
Flag path -> tryCanonicalizePath . takeDirectory $ path
-- | Return the path to the sandbox config file - either the default or the one
-- specified with @--sandbox-config-file@.
getPkgEnvFilePath :: GlobalFlags -> IO FilePath
getPkgEnvFilePath globalFlags = do
let sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
case sandboxConfigFileFlag of
NoFlag -> do pkgEnvDir <- getCurrentDirectory
return (pkgEnvDir </> sandboxPackageEnvironmentFile)
Flag path -> return path
-- | Load the @cabal.sandbox.config@ file (and possibly the optional
-- @cabal.config@). In addition to a @PackageEnvironment@, also return a
-- canonical path to the sandbox. Exit with error if the sandbox directory or
-- the package environment file do not exist.
tryLoadSandboxConfig :: Verbosity -> GlobalFlags
-> IO (FilePath, PackageEnvironment)
tryLoadSandboxConfig verbosity configFileFlag = do
pkgEnvDir <- getCurrentDirectory
(sandboxDir, pkgEnv) <- tryLoadSandboxPackageEnvironment verbosity pkgEnvDir
configFileFlag
dirExists <- doesDirectoryExist sandboxDir
-- TODO: Also check for an initialised package DB?
unless dirExists $
die ("No sandbox exists at " ++ sandboxDir)
info verbosity $ "Using a sandbox located at " ++ sandboxDir
return (sandboxDir, pkgEnv)
tryLoadSandboxConfig verbosity globalFlags = do
path <- getPkgEnvFilePath globalFlags
tryLoadSandboxPackageEnvironmentFile verbosity path
(globalConfigFile globalFlags)
-- | Return the name of the package index file for this package environment.
tryGetIndexFilePath :: SavedConfig -> IO FilePath
......@@ -255,8 +270,7 @@ initPackageDBIfNeeded verbosity configFlags comp conf = do
-- | Entry point for the 'cabal dump-pkgenv' command.
dumpPackageEnvironment :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
dumpPackageEnvironment verbosity _sandboxFlags globalFlags = do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
(globalConfigFile globalFlags)
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
commentPkgEnv <- commentPackageEnvironment sandboxDir
putStrLn . showPackageEnvironmentWithComments (Just commentPkgEnv) $ pkgEnv
......@@ -285,11 +299,10 @@ sandboxInit verbosity sandboxFlags globalFlags = do
(comp, platform, _) <- configCompilerAux (savedConfigureFlags userConfig)
-- Create the package environment file.
pkgEnvDir <- getCurrentDirectory
createPackageEnvironment verbosity sandboxDir pkgEnvDir
pkgEnvFile <- getPkgEnvFilePath globalFlags
createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile
NoComments comp platform
(_, pkgEnv) <- tryLoadSandboxPackageEnvironment verbosity pkgEnvDir
(globalConfigFile globalFlags)
(_, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
-- Create the index file if it doesn't exist.
indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
......@@ -303,23 +316,30 @@ sandboxInit verbosity sandboxFlags globalFlags = do
-- | Entry point for the 'cabal sandbox-delete' command.
sandboxDelete :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
sandboxDelete verbosity _sandboxFlags globalFlags = do
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags) mempty
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
case useSandbox of
NoSandbox -> die "Not in a sandbox."
UseSandbox sandboxDir -> do
pkgEnvDir <- getCurrentDirectory
curDir <- getCurrentDirectory
pkgEnvFile <- getPkgEnvFilePath globalFlags
-- Remove the cabal.sandbox.config file
removeFile (pkgEnvDir </> sandboxPackageEnvironmentFile)
-- Remove the @cabal.sandbox.config@ file, unless it's in a non-standard
-- location.
let isNonDefaultConfigLocation =
pkgEnvFile /= (curDir </> sandboxPackageEnvironmentFile)
if isNonDefaultConfigLocation
then warn $ "Sandbox config file is in non-default location: '"
++ pkgEnvFile ++ "'.\n Please delete manually."
else removeFile pkgEnvFile
-- Remove the sandbox directory, unless we're using a shared sandbox.
let isNonDefaultLocation = sandboxDir /=
(pkgEnvDir </> defaultSandboxLocation)
let isNonDefaultSandboxLocation =
sandboxDir /= (curDir </> defaultSandboxLocation)
when isNonDefaultLocation $
when isNonDefaultSandboxLocation $
die $ "Non-default sandbox location used: '" ++ sandboxDir
++ "'\nAssuming a shared sandbox. Please delete '"
++ "'.\nAssuming a shared sandbox. Please delete '"
++ sandboxDir ++ "' manually."
notice verbosity $ "Deleting the sandbox located at " ++ sandboxDir
......@@ -350,8 +370,7 @@ doAddSource verbosity buildTreeRefs sandboxDir pkgEnv refType = do
sandboxAddSource :: Verbosity -> [FilePath] -> SandboxFlags -> GlobalFlags
-> IO ()
sandboxAddSource verbosity buildTreeRefs sandboxFlags globalFlags = do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
(globalConfigFile globalFlags)
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
if fromFlagOrDefault False (sandboxSnapshot sandboxFlags)
then sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv
......@@ -406,8 +425,7 @@ sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv = do
sandboxDeleteSource :: Verbosity -> [FilePath] -> SandboxFlags -> GlobalFlags
-> IO ()
sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
(globalConfigFile globalFlags)
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
withRemoveTimestamps sandboxDir $ do
......@@ -421,8 +439,7 @@ sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do
sandboxListSources :: Verbosity -> SandboxFlags -> GlobalFlags
-> IO ()
sandboxListSources verbosity _sandboxFlags globalFlags = do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
(globalConfigFile globalFlags)
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
indexFile <- tryGetIndexFilePath (pkgEnvSavedConfig pkgEnv)
refs <- Index.listBuildTreeRefs verbosity
......@@ -441,8 +458,7 @@ sandboxListSources verbosity _sandboxFlags globalFlags = do
-- sandbox.
sandboxHcPkg :: Verbosity -> SandboxFlags -> GlobalFlags -> [String] -> IO ()
sandboxHcPkg verbosity _sandboxFlags globalFlags extraArgs = do
(_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity
(globalConfigFile globalFlags)
(_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
let configFlags = savedConfigureFlags . pkgEnvSavedConfig $ pkgEnv
dbStack = configPackageDB' configFlags
(comp, _platform, conf) <- configCompilerAux' configFlags
......@@ -453,25 +469,35 @@ sandboxHcPkg verbosity _sandboxFlags globalFlags extraArgs = do
-- correctly-initialised @SavedConfig@ and a @UseSandbox@ value that indicates
-- whether we're working in a sandbox.
loadConfigOrSandboxConfig :: Verbosity
-> Flag FilePath -- ^ --config-file
-> Flag Bool -- ^ Ignored if we're in a sandbox.
-> GlobalFlags -- ^ For @--config-file@ and
-- @--sandbox-config-file@.
-> Flag Bool -- ^ Ignored if we're in a sandbox.
-> IO (UseSandbox, SavedConfig)
loadConfigOrSandboxConfig verbosity configFileFlag userInstallFlag = do
currentDir <- getCurrentDirectory
pkgEnvType <- classifyPackageEnvironment currentDir
loadConfigOrSandboxConfig verbosity globalFlags userInstallFlag = do
let configFileFlag = globalConfigFile globalFlags
sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
pkgEnvDir <- getPkgEnvDir globalFlags
pkgEnvType <- case sandboxConfigFileFlag of
NoFlag -> classifyPackageEnvironment pkgEnvDir
Flag _ -> return SandboxPackageEnvironment
case pkgEnvType of
-- A @cabal.sandbox.config@ file (and possibly @cabal.config@) is present.
SandboxPackageEnvironment -> do
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity configFileFlag
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags
-- ^ Prints an error message and exits on error.
let config = pkgEnvSavedConfig pkgEnv
return (UseSandbox sandboxDir, config)
-- Only @cabal.config@ is present.
UserPackageEnvironment -> do
config <- loadConfig verbosity configFileFlag userInstallFlag
userConfig <- loadUserConfig verbosity currentDir
userConfig <- loadUserConfig verbosity pkgEnvDir
return (NoSandbox, config `mappend` userConfig)
AmbientPackageEnvironment -> do
-- Neither @cabal.sandbox.config@ nor @cabal.config@ are present.
AmbientPackageEnvironment -> do
config <- loadConfig verbosity configFileFlag userInstallFlag
return (NoSandbox, config)
......@@ -621,36 +647,29 @@ maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' globalFlags' = do
AmbientPackageEnvironment -> return (NoSandbox, NoDepsReinstalled)
UserPackageEnvironment -> return (NoSandbox, NoDepsReinstalled)
SandboxPackageEnvironment -> do
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags') mempty
case useSandbox of
UseSandbox sandboxDir -> do
-- Actually reinstall the modified add-source deps.
let configFlags = mappendSomeSavedFlags configFlags' $
savedConfigureFlags config
configExFlags = defaultConfigExFlags
`mappend` savedConfigureExFlags config
installFlags' = defaultInstallFlags
`mappend` savedInstallFlags config
installFlags = installFlags' {
installNumJobs = installNumJobs installFlags'
`mappend` numJobsFlag
}
globalFlags = savedGlobalFlags config
-- This makes it possible to override things like
-- 'remote-repo-cache' from the command line. These options are
-- hidden, and are only useful for debugging, so this should be
-- fine.
`mappend` globalFlags'
depsReinstalled <- reinstallAddSourceDeps verbosity
configFlags configExFlags installFlags globalFlags
sandboxDir
return (useSandbox, depsReinstalled)
NoSandbox -> error $
"Distribution.Client.Sandbox.maybeReinstallAddSourceDeps: "
++ "can't happen."
(sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags'
-- Actually reinstall the modified add-source deps.
let config = pkgEnvSavedConfig pkgEnv
configFlags = mappendSomeSavedFlags configFlags' $
savedConfigureFlags config
configExFlags = defaultConfigExFlags
`mappend` savedConfigureExFlags config
installFlags' = defaultInstallFlags
`mappend` savedInstallFlags config
installFlags = installFlags' {
installNumJobs = installNumJobs installFlags'
`mappend` numJobsFlag
}
globalFlags = savedGlobalFlags config
-- This makes it possible to override things like 'remote-repo-cache'
-- from the command line. These options are hidden, and are only
-- useful for debugging, so this should be fine.
`mappend` globalFlags'
depsReinstalled <- reinstallAddSourceDeps verbosity
configFlags configExFlags installFlags globalFlags
sandboxDir
return (UseSandbox sandboxDir, depsReinstalled)
where
......
cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs
View file @ e921b1d6
......@@ -13,8 +13,8 @@ module Distribution.Client.Sandbox.PackageEnvironment (
, IncludeComments(..)
, PackageEnvironmentType(..)
, classifyPackageEnvironment
, createPackageEnvironment
, tryLoadSandboxPackageEnvironment
, createPackageEnvironmentFile
, tryLoadSandboxPackageEnvironmentFile
, readPackageEnvironmentFile
, showPackageEnvironment
, showPackageEnvironmentWithComments
......@@ -41,7 +41,7 @@ import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
, fromPathTemplate, toPathTemplate )
import Distribution.Simple.Setup ( Flag(..), ConfigFlags(..),
fromFlagOrDefault, toFlag )
import Distribution.Simple.Utils ( die, notice, warn, lowercase )
import Distribution.Simple.Utils ( die, info, notice, warn, lowercase )
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..),
commaListField,
liftField, lineNo, locatedErrorMsg,
......@@ -49,12 +49,13 @@ import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..),
showPWarning, simpleField, syntaxError )
import Distribution.System ( Platform )
import Distribution.Verbosity ( Verbosity, normal )
import Control.Monad ( foldM, when )
import Control.Monad ( foldM, when, unless )
import Data.List ( partition )
import Data.Monoid ( Monoid(..) )
import Distribution.Compat.Exception ( catchIO )
import System.Directory ( doesFileExist, renameFile )
import System.FilePath ( (<.>), (</>) )
import System.Directory ( doesDirectoryExist, doesFileExist,
renameFile )
import System.FilePath ( (<.>), (</>), takeDirectory )
import System.IO.Error ( isDoesNotExistError )
import Text.PrettyPrint ( ($+$) )
......@@ -287,16 +288,15 @@ handleParseResult verbosity path minp =
die $ "Error parsing package environment file " ++ path
++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg
-- | Try to load the package environment file (@cabal.sandbox.config@), exiting
-- with error if it doesn't exist. Also returns the path to the sandbox
-- directory. Note that the path parameter should be a name of an existing
-- directory.
tryLoadSandboxPackageEnvironment :: Verbosity -> FilePath -> (Flag FilePath)
-> IO (FilePath, PackageEnvironment)
tryLoadSandboxPackageEnvironment verbosity pkgEnvDir configFileFlag = do
let path = pkgEnvDir </> sandboxPackageEnvironmentFile
minp <- readPackageEnvironmentFile mempty path
pkgEnv <- handleParseResult verbosity path minp
-- | Try to load the given package environment file, exiting with error if it
-- doesn't exist. Also returns the path to the sandbox directory. The path
-- parameter should refer to an existing file.
tryLoadSandboxPackageEnvironmentFile :: Verbosity -> FilePath -> (Flag FilePath)
-> IO (FilePath, PackageEnvironment)
tryLoadSandboxPackageEnvironmentFile verbosity pkgEnvFile configFileFlag = do
let pkgEnvDir = takeDirectory pkgEnvFile
minp <- readPackageEnvironmentFile mempty pkgEnvFile
pkgEnv <- handleParseResult verbosity pkgEnvFile minp
-- Get the saved sandbox directory.
-- TODO: Use substPathTemplate with compilerTemplateEnv ++ platformTemplateEnv.
......@@ -304,6 +304,13 @@ tryLoadSandboxPackageEnvironment verbosity pkgEnvDir configFileFlag = do
. fmap fromPathTemplate . prefix . savedUserInstallDirs
. pkgEnvSavedConfig $ pkgEnv
-- Do some sanity checks
dirExists <- doesDirectoryExist sandboxDir
-- TODO: Also check for an initialised package DB?
unless dirExists $
die ("No sandbox exists at " ++ sandboxDir)
info verbosity $ "Using a sandbox located at " ++ sandboxDir
let base = basePackageEnvironment
let common = commonPackageEnvironment sandboxDir
user <- userPackageEnvironment verbosity pkgEnvDir
......@@ -323,19 +330,18 @@ data IncludeComments = IncludeComments | NoComments
-- | Create a new package environment file, replacing the existing one if it
-- exists. Note that the path parameters should point to existing directories.
createPackageEnvironment :: Verbosity -> FilePath -> FilePath
-> IncludeComments
-> Compiler
-> Platform
-> IO ()
createPackageEnvironment verbosity sandboxDir pkgEnvDir incComments
createPackageEnvironmentFile :: Verbosity -> FilePath -> FilePath
-> IncludeComments
-> Compiler
-> Platform
-> IO ()
createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile incComments
compiler platform = do
let path = pkgEnvDir </> sandboxPackageEnvironmentFile
notice verbosity $ "Writing default package environment to " ++ path
notice verbosity $ "Writing default package environment to " ++ pkgEnvFile
commentPkgEnv <- commentPackageEnvironment sandboxDir
initialPkgEnv <- initialPackageEnvironment sandboxDir compiler platform
writePackageEnvironmentFile path incComments commentPkgEnv initialPkgEnv
writePackageEnvironmentFile pkgEnvFile incComments commentPkgEnv initialPkgEnv
-- | Descriptions of all fields in the package environment file.
pkgEnvFieldDescrs :: [FieldDescr PackageEnvironment]
......
cabal-install/Distribution/Client/Setup.hs
View file @ e921b1d6
......@@ -99,26 +99,28 @@ import Network.URI
-- | Flags that apply at the top level, not to any sub-command.
data GlobalFlags = GlobalFlags {
globalVersion :: Flag Bool,
globalNumericVersion :: Flag Bool,
globalConfigFile :: Flag FilePath,
globalRemoteRepos :: [RemoteRepo], -- ^ Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: [FilePath],
globalLogsDir :: Flag FilePath,
globalWorldFile :: Flag FilePath
globalVersion :: Flag Bool,
globalNumericVersion :: Flag Bool,
globalConfigFile :: Flag FilePath,
globalSandboxConfigFile :: Flag FilePath,
globalRemoteRepos :: [RemoteRepo], -- ^ Available Hackage servers.
globalCacheDir :: Flag FilePath,
globalLocalRepos :: [FilePath],
globalLogsDir :: Flag FilePath,
globalWorldFile :: Flag FilePath
}
defaultGlobalFlags :: GlobalFlags
defaultGlobalFlags = GlobalFlags {
globalVersion = Flag False,
globalNumericVersion = Flag False,
globalConfigFile = mempty,
globalRemoteRepos = [],
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
globalVersion = Flag False,
globalNumericVersion = Flag False,
globalConfigFile = mempty,
globalSandboxConfigFile = mempty,
globalRemoteRepos = [],
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
}
globalCommand :: CommandUI GlobalFlags
......@@ -138,7 +140,7 @@ globalCommand = CommandUI {
++ " " ++ pname ++ " update\n",
commandDefaultFlags = defaultGlobalFlags,
commandOptions = \showOrParseArgs ->
(case showOrParseArgs of ShowArgs -> take 3; ParseArgs -> id)
(case showOrParseArgs of ShowArgs -> take 4; ParseArgs -> id)
[option ['V'] ["version"]
"Print version information"
globalVersion (\v flags -> flags { globalVersion = v })
......@@ -154,6 +156,12 @@ globalCommand = CommandUI {
globalConfigFile (\v flags -> flags { globalConfigFile = v })
(reqArgFlag "FILE")
,option [] ["sandbox-config-file"]
"Set an alternate location for the sandbox config file \
\(default: './cabal.sandbox.config')"
globalConfigFile (\v flags -> flags { globalSandboxConfigFile = v })
(reqArgFlag "FILE")
,option [] ["remote-repo"]
"The name and url for a remote repository"
globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
......@@ -183,24 +191,26 @@ globalCommand = CommandUI {
instance Monoid GlobalFlags where
mempty = GlobalFlags {
globalVersion = mempty,
globalNumericVersion = mempty,
globalConfigFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
globalVersion = mempty,
globalNumericVersion = mempty,
globalConfigFile = mempty,
globalSandboxConfigFile = mempty,
globalRemoteRepos = mempty,
globalCacheDir = mempty,
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty
}
mappend a b = GlobalFlags {
globalVersion = combine globalVersion,
globalNumericVersion = combine globalNumericVersion,
globalConfigFile = combine globalConfigFile,
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = combine globalLocalRepos,
globalLogsDir = combine globalLogsDir,
globalWorldFile = combine globalWorldFile
globalVersion = combine globalVersion,
globalNumericVersion = combine globalNumericVersion,
globalConfigFile = combine globalConfigFile,
globalSandboxConfigFile = combine globalConfigFile,
globalRemoteRepos = combine globalRemoteRepos,
globalCacheDir = combine globalCacheDir,
globalLocalRepos = combine globalLocalRepos,
globalLogsDir = combine globalLogsDir,
globalWorldFile = combine globalWorldFile
}
where combine field = field a `mappend` field b
......
cabal-install/Main.hs
View file @ e921b1d6
......@@ -221,8 +221,7 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do
let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags)
(configUserInstall configFlags)
globalFlags (configUserInstall configFlags)
let configFlags' = savedConfigureFlags config `mappend` configFlags
configExFlags' = savedConfigureExFlags config `mappend` configExFlags
globalFlags' = savedGlobalFlags config `mappend` globalFlags
......@@ -363,8 +362,7 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
$ msg ++ " Configuring with default flags." ++ configureManually
configureAction (defaultFlags, defaultConfigExFlags)
extraArgs globalFlags
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags) mempty
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
return useSandbox
-- Package has been configured, but the configuration may be out of
......@@ -384,7 +382,7 @@ reconfigure verbosity distPref addConfigFlags extraArgs globalFlags
maybeReinstallAddSourceDeps verbosity numJobsFlag flags globalFlags
SkipAddSourceDepsCheck -> do
(useSandbox, _) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags) mempty
globalFlags mempty
return (useSandbox, NoDepsReinstalled)
-- Determine what message, if any, to display to the user if
......@@ -456,8 +454,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
extraArgs globalFlags = do
let verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
(useSandbox, config) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags)
(configUserInstall configFlags)
globalFlags (configUserInstall configFlags)
targets <- readUserTargets verbosity extraArgs
-- TODO: It'd be nice if 'cabal install' picked up the '-w' flag passed to
......@@ -571,8 +568,7 @@ benchmarkAction (benchmarkFlags, buildExFlags) extraArgs globalFlags = do
listAction :: ListFlags -> [String] -> GlobalFlags -> IO ()
listAction listFlags extraArgs globalFlags = do
let verbosity = fromFlag (listVerbosity listFlags)
(_, config) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags) mempty
(_, config) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, _, conf) <- configCompilerAux' configFlags
......@@ -588,8 +584,7 @@ infoAction :: InfoFlags -> [String] -> GlobalFlags -> IO ()
infoAction infoFlags extraArgs globalFlags = do
let verbosity = fromFlag (infoVerbosity infoFlags)
targets <- readUserTargets verbosity extraArgs
(_, config) <- loadConfigOrSandboxConfig verbosity
(globalConfigFile globalFlags) mempty
(_, config) <- loadConfigOrSandboxConfig verbosity globalFlags mempty
let configFlags = savedConfigureFlags config
globalFlags' = savedGlobalFlags config `mappend` globalFlags
(comp, _, conf) <- configCompilerAux configFlags
......
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