Implement the '--ignore-sandbox' option.

Fixes #1403.

Cabal/doc/installing-packages.markdown

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

cabal-install/Distribution/Client/Sandbox.hs

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

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

@@ -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
+classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag ignoreSandboxFlag =
+  do isSandbox <- liftM2 (||) (return forceSandboxConfig)
+                  (configExists sandboxPackageEnvironmentFile)
+     isUser    <- configExists userPackageEnvironmentFile
+     return (classify isSandbox isUser)
   where
-    doClassify = do
-      isSandbox <- configExists sandboxPackageEnvironmentFile
-      isUser    <- configExists userPackageEnvironmentFile
-      case (isSandbox, isUser) of
-        (True,  _)     -> return SandboxPackageEnvironment
-        (False, True)  -> return UserPackageEnvironment
-        (False, False) -> return AmbientPackageEnvironment
-      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
 -- 'commentPackageEnvironment'.

cabal-install/Distribution/Client/Setup.hs

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