Commit 6d39865f authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Implement the '--ignore-sandbox' option.

Fixes #1403.
parent 60409cb9
......@@ -190,8 +190,9 @@ sometimes can be more convenient. Example:
~~~~~~~~~~~~~~~
$ mkdir my/sandbox
$ cd my/sandbox
$ cabal sandbox init
$ cd my/project
$ cd /path/to/my/project
$ cabal --sandbox-config-file=/path/to/my/sandbox/cabal.sandbox.config install
# Uses the sandbox located at /path/to/my/sandbox/.cabal-sandbox
$ cd ~
......@@ -202,6 +203,17 @@ $ cabal --sandbox-config-file=/path/to/my/sandbox/cabal.sandbox.config install
The sandbox config file can be also specified via the `CABAL_SANDBOX_CONFIG`
environment variable.
Finally, the flag `--ignore-sandbox` lets you temporarily ignore an existing
sandbox:
~~~~~~~~~~~~~~~
$ mkdir my/sandbox
$ cd my/sandbox
$ cabal sandbox init
$ cabal --ignore-sandbox install text
# Installs 'text' in the user package database ('~/.cabal').
~~~~~~~~~~~~~~~
## Creating a binary package ##
When creating binary packages (e.g. for RedHat or Debian) one needs to
......
......@@ -484,10 +484,11 @@ loadConfigOrSandboxConfig :: Verbosity
loadConfigOrSandboxConfig verbosity globalFlags userInstallFlag = do
let configFileFlag = globalConfigFile globalFlags
sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
ignoreSandboxFlag = globalIgnoreSandbox globalFlags
pkgEnvDir <- getPkgEnvDir sandboxConfigFileFlag
pkgEnvType <- classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag
ignoreSandboxFlag
case pkgEnvType of
-- A @cabal.sandbox.config@ file (and possibly @cabal.config@) is present.
SandboxPackageEnvironment -> do
......
......@@ -44,7 +44,7 @@ import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
import Distribution.Simple.Program ( defaultProgramConfiguration )
import Distribution.Simple.Setup ( Flag(..), ConfigFlags(..)
, programConfigurationOptions
, fromFlagOrDefault, toFlag )
, fromFlagOrDefault, toFlag, flagToMaybe )
import Distribution.Simple.Utils ( die, info, notice, warn, lowercase )
import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..)
, commaListField
......@@ -53,8 +53,9 @@ import Distribution.ParseUtils ( FieldDescr(..), ParseResult(..)
, showPWarning, simpleField, syntaxError )
import Distribution.System ( Platform )
import Distribution.Verbosity ( Verbosity, normal )
import Control.Monad ( foldM, when, unless )
import Control.Monad ( foldM, liftM2, when, unless )
import Data.List ( partition )
import Data.Maybe ( isJust )
import Data.Monoid ( Monoid(..) )
import Distribution.Compat.Exception ( catchIO )
import System.Directory ( doesDirectoryExist, doesFileExist
......@@ -113,22 +114,23 @@ data PackageEnvironmentType =
-- | Is there a 'cabal.sandbox.config' or 'cabal.config' in this
-- directory?
classifyPackageEnvironment :: FilePath -> (Flag FilePath)
classifyPackageEnvironment :: FilePath -> Flag FilePath -> Flag Bool
-> IO PackageEnvironmentType
classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag =
case sandboxConfigFileFlag of
NoFlag -> doClassify
Flag _ -> return SandboxPackageEnvironment
where
doClassify = do
isSandbox <- configExists sandboxPackageEnvironmentFile
classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag ignoreSandboxFlag =
do isSandbox <- liftM2 (||) (return forceSandboxConfig)
(configExists sandboxPackageEnvironmentFile)
isUser <- configExists userPackageEnvironmentFile
case (isSandbox, isUser) of
(True, _) -> return SandboxPackageEnvironment
(False, True) -> return UserPackageEnvironment
(False, False) -> return AmbientPackageEnvironment
return (classify isSandbox isUser)
where
configExists fname = doesFileExist (pkgEnvDir </> fname)
ignoreSandbox = fromFlagOrDefault False ignoreSandboxFlag
forceSandboxConfig = isJust . flagToMaybe $ sandboxConfigFileFlag
classify :: Bool -> Bool -> PackageEnvironmentType
classify True _
| not ignoreSandbox = SandboxPackageEnvironment
classify _ True = UserPackageEnvironment
classify _ False = AmbientPackageEnvironment
-- | Defaults common to 'initialPackageEnvironment' and
-- 'commentPackageEnvironment'.
......
......@@ -113,7 +113,8 @@ data GlobalFlags = GlobalFlags {
globalLocalRepos :: [FilePath],
globalLogsDir :: Flag FilePath,
globalWorldFile :: Flag FilePath,
globalRequireSandbox :: Flag Bool
globalRequireSandbox :: Flag Bool,
globalIgnoreSandbox :: Flag Bool
}
defaultGlobalFlags :: GlobalFlags
......@@ -127,7 +128,8 @@ defaultGlobalFlags = GlobalFlags {
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty,
globalRequireSandbox = Flag False
globalRequireSandbox = Flag False,
globalIgnoreSandbox = Flag False
}
globalCommand :: CommandUI GlobalFlags
......@@ -147,7 +149,7 @@ globalCommand = CommandUI {
++ " " ++ pname ++ " update\n",
commandDefaultFlags = mempty,
commandOptions = \showOrParseArgs ->
(case showOrParseArgs of ShowArgs -> take 5; ParseArgs -> id)
(case showOrParseArgs of ShowArgs -> take 6; ParseArgs -> id)
[option ['V'] ["version"]
"Print version information"
globalVersion (\v flags -> flags { globalVersion = v })
......@@ -174,6 +176,11 @@ globalCommand = CommandUI {
globalRequireSandbox (\v flags -> flags { globalRequireSandbox = v })
(boolOpt' ([], ["require-sandbox"]) ([], ["no-require-sandbox"]))
,option [] ["ignore-sandbox"]
"Ignore any existing sandbox"
globalIgnoreSandbox (\v flags -> flags { globalIgnoreSandbox = v })
trueArg
,option [] ["remote-repo"]
"The name and url for a remote repository"
globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
......@@ -212,7 +219,8 @@ instance Monoid GlobalFlags where
globalLocalRepos = mempty,
globalLogsDir = mempty,
globalWorldFile = mempty,
globalRequireSandbox = mempty
globalRequireSandbox = mempty,
globalIgnoreSandbox = mempty
}
mappend a b = GlobalFlags {
globalVersion = combine globalVersion,
......@@ -224,7 +232,8 @@ instance Monoid GlobalFlags where
globalLocalRepos = combine globalLocalRepos,
globalLogsDir = combine globalLogsDir,
globalWorldFile = combine globalWorldFile,
globalRequireSandbox = combine globalRequireSandbox
globalRequireSandbox = combine globalRequireSandbox,
globalIgnoreSandbox = combine globalIgnoreSandbox
}
where combine field = field a `mappend` field b
......
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