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