Remove sandbox from GlobalFlags and Sandbox unit-tests

cabal-install/Distribution/Client/Config.hs

@@ -247,16 +247,13 @@ instance Semigroup SavedConfig where
         globalVersion           = combine globalVersion,
         globalNumericVersion    = combine globalNumericVersion,
         globalConfigFile        = combine globalConfigFile,
-        globalSandboxConfigFile = combine globalSandboxConfigFile,
         globalConstraintsFile   = combine globalConstraintsFile,
         globalRemoteRepos       = lastNonEmptyNL globalRemoteRepos,
         globalCacheDir          = combine globalCacheDir,
         globalLocalRepos        = lastNonEmptyNL globalLocalRepos,
         globalLocalNoIndexRepos = lastNonEmptyNL globalLocalNoIndexRepos,
         globalLogsDir           = combine globalLogsDir,
         globalWorldFile         = combine globalWorldFile,
-        globalRequireSandbox    = combine globalRequireSandbox,
-        globalIgnoreSandbox     = combine globalIgnoreSandbox,
         globalIgnoreExpiry      = combine globalIgnoreExpiry,
         globalHttpTransport     = combine globalHttpTransport,
         globalNix               = combine globalNix,

cabal-install/Distribution/Client/GlobalFlags.hs

@@ -59,16 +59,13 @@ data GlobalFlags = GlobalFlags {
     globalVersion           :: Flag Bool,
     globalNumericVersion    :: Flag Bool,
     globalConfigFile        :: Flag FilePath,
-    globalSandboxConfigFile :: Flag FilePath,
     globalConstraintsFile   :: Flag FilePath,
     globalRemoteRepos       :: NubList RemoteRepo,     -- ^ Available Hackage servers.
     globalCacheDir          :: Flag FilePath,
     globalLocalRepos        :: NubList FilePath,
     globalLocalNoIndexRepos :: NubList LocalRepo,
     globalLogsDir           :: Flag FilePath,
     globalWorldFile         :: Flag FilePath,
-    globalRequireSandbox    :: Flag Bool,
-    globalIgnoreSandbox     :: Flag Bool,
     globalIgnoreExpiry      :: Flag Bool,    -- ^ Ignore security expiry dates
     globalHttpTransport     :: Flag String,
     globalNix               :: Flag Bool,  -- ^ Integrate with Nix
@@ -81,16 +78,13 @@ defaultGlobalFlags  = GlobalFlags {
     globalVersion           = Flag False,
     globalNumericVersion    = Flag False,
     globalConfigFile        = mempty,
-    globalSandboxConfigFile = mempty,
     globalConstraintsFile   = mempty,
     globalRemoteRepos       = mempty,
     globalCacheDir          = mempty,
     globalLocalRepos        = mempty,
     globalLocalNoIndexRepos = mempty,
     globalLogsDir           = mempty,
     globalWorldFile         = mempty,
-    globalRequireSandbox    = Flag False,
-    globalIgnoreSandbox     = Flag False,
     globalIgnoreExpiry      = Flag False,
     globalHttpTransport     = mempty,
     globalNix               = Flag False,

cabal-install/Distribution/Client/ProjectConfig/Legacy.hs

@@ -333,7 +333,6 @@ convertLegacyAllPackageFlags globalFlags configFlags
   where
     GlobalFlags {
       globalConfigFile        = projectConfigConfigFile,
-      globalSandboxConfigFile = _, -- ??
       globalRemoteRepos       = projectConfigRemoteRepos,
       globalLocalRepos        = projectConfigLocalRepos,
       globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos,
@@ -567,16 +566,13 @@ convertToLegacySharedConfig
       globalVersion           = mempty,
       globalNumericVersion    = mempty,
       globalConfigFile        = projectConfigConfigFile,
-      globalSandboxConfigFile = mempty,
       globalConstraintsFile   = mempty,
       globalRemoteRepos       = projectConfigRemoteRepos,
       globalCacheDir          = projectConfigCacheDir,
       globalLocalRepos        = projectConfigLocalRepos,
       globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos,
       globalLogsDir           = projectConfigLogsDir,
       globalWorldFile         = mempty,
-      globalRequireSandbox    = mempty,
-      globalIgnoreSandbox     = mempty,
       globalIgnoreExpiry      = projectConfigIgnoreExpiry,
       globalHttpTransport     = projectConfigHttpTransport,
       globalNix               = mempty,

cabal-install/Distribution/Client/Sandbox.hs

@@ -70,7 +70,7 @@ import Distribution.Client.Sandbox.PackageEnvironment
   , createPackageEnvironmentFile, classifyPackageEnvironment
   , tryLoadSandboxPackageEnvironmentFile, loadUserConfig
   , commentPackageEnvironment, showPackageEnvironmentWithComments
-  , sandboxPackageEnvironmentFile, userPackageEnvironmentFile
+  , userPackageEnvironmentFile
   , sandboxPackageDBPath )
 import Distribution.Client.Sandbox.Types      ( SandboxPackageInfo(..)
                                               , UseSandbox(..) )
@@ -135,7 +135,7 @@ import System.FilePath                        ( (</>), equalFilePath
                                               , getSearchPath
                                               , searchPathSeparator
                                               , splitSearchPath
-                                              , takeDirectory )
+                                              )
 
 --
 -- * Constants
@@ -180,22 +180,12 @@ sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash ""
 -- value of the @CABAL_SANDBOX_CONFIG@ environment variable, or else to
 -- 'NoFlag'.
 updateSandboxConfigFileFlag :: GlobalFlags -> IO GlobalFlags
-updateSandboxConfigFileFlag globalFlags =
-  case globalSandboxConfigFile globalFlags of
-    Flag _ -> return globalFlags
-    NoFlag -> do
-      f' <- fmap (maybe NoFlag Flag) . lookupEnv $ "CABAL_SANDBOX_CONFIG"
-      return globalFlags { globalSandboxConfigFile = f' }
+updateSandboxConfigFileFlag = return
 
 -- | Return the path to the sandbox config file - either the default or the one
 -- specified with @--sandbox-config-file@.
 getSandboxConfigFilePath :: GlobalFlags -> IO FilePath
-getSandboxConfigFilePath globalFlags = do
-  let sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
-  case sandboxConfigFileFlag of
-    NoFlag -> do pkgEnvDir <- getCurrentDirectory
-                 return (pkgEnvDir </> sandboxPackageEnvironmentFile)
-    Flag path -> return path
+getSandboxConfigFilePath _ = return ""
 
 -- | Load the @cabal.sandbox.config@ file (and possibly the optional
 -- @cabal.config@). In addition to a @PackageEnvironment@, also return a
@@ -344,22 +334,14 @@ sandboxDelete :: Verbosity -> SandboxFlags -> GlobalFlags -> IO ()
 sandboxDelete verbosity _sandboxFlags globalFlags = do
   (useSandbox, _) <- loadConfigOrSandboxConfig
                        verbosity
-                       globalFlags { globalRequireSandbox = Flag False }
+                       globalFlags
   case useSandbox of
     NoSandbox -> warn verbosity "Not in a sandbox."
     UseSandbox sandboxDir -> do
       curDir     <- getCurrentDirectory
       pkgEnvFile <- getSandboxConfigFilePath globalFlags
 
-      -- Remove the @cabal.sandbox.config@ file, unless it's in a non-standard
-      -- location.
-      let isNonDefaultConfigLocation = not $ equalFilePath pkgEnvFile $
-                                       curDir </> sandboxPackageEnvironmentFile
-
-      if isNonDefaultConfigLocation
-        then warn verbosity $ "Sandbox config file is in non-default location: '"
-                    ++ pkgEnvFile ++ "'.\n Please delete manually."
-        else removeFile pkgEnvFile
+      removeFile pkgEnvFile
 
       -- Remove the sandbox directory, unless we're using a shared sandbox.
       let isNonDefaultSandboxLocation = not $ equalFilePath sandboxDir $
@@ -585,26 +567,15 @@ loadConfigOrSandboxConfig :: Verbosity
                           -> IO (UseSandbox, SavedConfig)
 loadConfigOrSandboxConfig verbosity globalFlags = do
   let configFileFlag        = globalConfigFile        globalFlags
-      sandboxConfigFileFlag = globalSandboxConfigFile globalFlags
-      ignoreSandboxFlag     = globalIgnoreSandbox     globalFlags
 
-  pkgEnvDir  <- getPkgEnvDir sandboxConfigFileFlag
-  pkgEnvType <- classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag
-                                           ignoreSandboxFlag
+  pkgEnvDir  <- getCurrentDirectory
+  pkgEnvType <- classifyPackageEnvironment pkgEnvDir
   case pkgEnvType of
-    -- A @cabal.sandbox.config@ file (and possibly @cabal.config@) is present.
-    SandboxPackageEnvironment -> do
-      (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
       userConfig <- loadUserConfig verbosity pkgEnvDir Nothing
       let config' = config `mappend` userConfig
-      dieIfSandboxRequired config'
       return (NoSandbox, config')
 
     -- Neither @cabal.sandbox.config@ nor @cabal.config@ are present.
@@ -615,31 +586,8 @@ loadConfigOrSandboxConfig verbosity globalFlags = do
       globalConstraintConfig <-
         loadUserConfig verbosity pkgEnvDir globalConstraintsOpt
       let config' = config `mappend` globalConstraintConfig
-      dieIfSandboxRequired config
       return (NoSandbox, config')
 
-  where
-    -- Return the path to the package environment directory - either the
-    -- current directory or the one that @--sandbox-config-file@ resides in.
-    getPkgEnvDir :: (Flag FilePath) -> IO FilePath
-    getPkgEnvDir sandboxConfigFileFlag = do
-      case sandboxConfigFileFlag of
-        NoFlag    -> getCurrentDirectory
-        Flag path -> tryCanonicalizePath . takeDirectory $ path
-
-    -- Die if @--require-sandbox@ was specified and we're not inside a sandbox.
-    dieIfSandboxRequired :: SavedConfig -> IO ()
-    dieIfSandboxRequired config = checkFlag flag
-      where
-        flag = (globalRequireSandbox . savedGlobalFlags $ config)
-               `mappend` (globalRequireSandbox globalFlags)
-        checkFlag (Flag True)  =
-          die' verbosity $ "'require-sandbox' is set to True, but no sandbox is present. "
-             ++ "Use '--no-require-sandbox' if you want to override "
-             ++ "'require-sandbox' temporarily."
-        checkFlag (Flag False) = return ()
-        checkFlag (NoFlag)     = return ()
-
 -- | Return the saved \"dist/\" prefix, or the default prefix.
 findSavedDistPref :: SavedConfig -> Flag FilePath -> IO FilePath
 findSavedDistPref config flagDistPref = do

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

@@ -26,7 +26,6 @@ module Distribution.Client.Sandbox.PackageEnvironment (
   , basePackageEnvironment
   , initialPackageEnvironment
   , commentPackageEnvironment
-  , sandboxPackageEnvironmentFile
   , userPackageEnvironmentFile
   ) where
 
@@ -49,20 +48,19 @@ import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate
                                        , fromPathTemplate, toPathTemplate )
 import Distribution.Simple.Setup       ( Flag(..)
                                        , ConfigFlags(..), HaddockFlags(..)
-                                       , fromFlagOrDefault, toFlag, flagToMaybe )
+                                       , fromFlagOrDefault, toFlag )
 import Distribution.Simple.Utils       ( die', info, notice, warn, debug )
 import Distribution.Solver.Types.ConstraintSource
 import Distribution.Deprecated.ParseUtils         ( FieldDescr(..), ParseResult(..)
                                        , commaListField, commaNewLineListField
                                        , liftField, lineNo, locatedErrorMsg
-                                       , parseFilePathQ, readFields
-                                       , showPWarning, simpleField
+                                       , readFields
+                                       , showPWarning 
                                        , syntaxError, warning )
 import Distribution.System             ( Platform )
 import Distribution.Verbosity          ( Verbosity, normal )
-import Control.Monad                   ( foldM, liftM2, unless )
+import Control.Monad                   ( foldM, unless )
 import Data.List                       ( partition, sortBy )
-import Data.Maybe                      ( isJust )
 import Data.Ord                        ( comparing )
 import Distribution.Compat.Exception   ( catchIO )
 import Distribution.Compat.Semigroup
@@ -73,7 +71,6 @@ import System.IO.Error                 ( isDoesNotExistError )
 import Text.PrettyPrint                ( ($+$) )
 
 import qualified Text.PrettyPrint          as Disp
-import qualified Distribution.Deprecated.ReadP as Parse
 import qualified Distribution.Deprecated.ParseUtils   as ParseUtils ( Field(..) )
 import qualified Distribution.Deprecated.Text         as Text
 import GHC.Generics ( Generic )
@@ -86,9 +83,6 @@ import GHC.Generics ( Generic )
 -- TODO: would be nice to remove duplication between
 -- D.C.Sandbox.PackageEnvironment and D.C.Config.
 data PackageEnvironment = PackageEnvironment {
-  -- The 'inherit' feature is not used ATM, but could be useful in the future
-  -- for constructing nested sandboxes (see discussion in #1196).
-  pkgEnvInherit       :: Flag FilePath,
   pkgEnvSavedConfig   :: SavedConfig
 } deriving Generic
 
@@ -99,41 +93,27 @@ instance Monoid PackageEnvironment where
 instance Semigroup PackageEnvironment where
   (<>) = gmappend
 
--- | The automatically-created package environment file that should not be
--- touched by the user.
-sandboxPackageEnvironmentFile :: FilePath
-sandboxPackageEnvironmentFile = "cabal.sandbox.config"
-
 -- | Optional package environment file that can be used to customize the default
 -- settings. Created by the user.
 userPackageEnvironmentFile :: FilePath
 userPackageEnvironmentFile = "cabal.config"
 
 -- | Type of the current package environment.
-data PackageEnvironmentType =
-  SandboxPackageEnvironment   -- ^ './cabal.sandbox.config'
-  | UserPackageEnvironment    -- ^ './cabal.config'
+data PackageEnvironmentType
+  = UserPackageEnvironment    -- ^ './cabal.config'
   | AmbientPackageEnvironment -- ^ '~/.cabal/config'
 
--- | Is there a 'cabal.sandbox.config' or 'cabal.config' in this
--- directory?
-classifyPackageEnvironment :: FilePath -> Flag FilePath -> Flag Bool
-                              -> IO PackageEnvironmentType
-classifyPackageEnvironment pkgEnvDir sandboxConfigFileFlag ignoreSandboxFlag =
-  do isSandbox <- liftM2 (||) (return forceSandboxConfig)
-                  (configExists sandboxPackageEnvironmentFile)
-     isUser    <- configExists userPackageEnvironmentFile
-     return (classify isSandbox isUser)
+-- | Is there a 'cabal.config' in this directory?
+classifyPackageEnvironment :: FilePath -> IO PackageEnvironmentType
+classifyPackageEnvironment pkgEnvDir = do
+     isUser <- configExists userPackageEnvironmentFile
+     return (classify 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
+    classify :: Bool -> PackageEnvironmentType
+    classify True    = UserPackageEnvironment
+    classify False   = AmbientPackageEnvironment
 
 -- | Defaults common to 'initialPackageEnvironment' and
 -- 'commentPackageEnvironment'.
@@ -245,8 +225,7 @@ overrideSandboxSettings pkgEnv0 pkgEnv =
        , savedInstallFlags = (savedInstallFlags mappendedConf) {
           installSummaryFile = installSummaryFile pkgEnvInstallFlags
           }
-       },
-    pkgEnvInherit = pkgEnvInherit pkgEnv0
+       }
     }
   where
     pkgEnvConf           = pkgEnvSavedConfig pkgEnv
@@ -264,17 +243,6 @@ commentPackageEnvironment sandboxDir = do
     pkgEnvSavedConfig = commentConf `mappend` baseConf
     }
 
--- | If this package environment inherits from some other package environment,
--- return that package environment; otherwise return mempty.
-inheritedPackageEnvironment :: Verbosity -> PackageEnvironment
-                               -> IO PackageEnvironment
-inheritedPackageEnvironment verbosity pkgEnv = do
-  case (pkgEnvInherit pkgEnv) of
-    NoFlag                -> return mempty
-    confPathFlag@(Flag _) -> do
-      conf <- loadConfig verbosity confPathFlag
-      return $ mempty { pkgEnvSavedConfig = conf }
-
 -- | Load the user package environment if it exists (the optional "cabal.config"
 -- file). If it does not exist locally, attempt to load an optional global one.
 userPackageEnvironment :: Verbosity -> FilePath -> Maybe FilePath
@@ -358,14 +326,13 @@ tryLoadSandboxPackageEnvironmentFile verbosity pkgEnvFile configFileFlag = do
   let base   = basePackageEnvironment
   let common = commonPackageEnvironment sandboxDir
   user      <- userPackageEnvironment verbosity pkgEnvDir Nothing --TODO
-  inherited <- inheritedPackageEnvironment verbosity user
 
   -- Layer the package environment settings over settings from ~/.cabal/config.
   cabalConfig <- fmap unsetSymlinkBinDir $ loadConfig verbosity configFileFlag
   return (sandboxDir,
           updateInstallDirs $
           (base `mappend` (toPkgEnv cabalConfig) `mappend`
-           common `mappend` inherited `mappend` user)
+           common `mappend` user)
           `overrideSandboxSettings` pkgEnv)
     where
       toPkgEnv config = mempty { pkgEnvSavedConfig = config }
@@ -405,12 +372,8 @@ createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile compiler platform =
 
 -- | Descriptions of all fields in the package environment file.
 pkgEnvFieldDescrs :: ConstraintSource -> [FieldDescr PackageEnvironment]
-pkgEnvFieldDescrs src = [
-  simpleField "inherit"
-    (fromFlagOrDefault Disp.empty . fmap Disp.text) (optional parseFilePathQ)
-    pkgEnvInherit (\v pkgEnv -> pkgEnv { pkgEnvInherit = v })
-
-  , commaNewLineListField "constraints"
+pkgEnvFieldDescrs src =
+  [ commaNewLineListField "constraints"
     (Text.disp . fst) ((\pc -> (pc, src)) `fmap` Text.parse)
     (sortConstraints . configExConstraints
      . savedConfigureExFlags . pkgEnvSavedConfig)
@@ -425,8 +388,6 @@ pkgEnvFieldDescrs src = [
   ]
   ++ map toPkgEnv configFieldDescriptions'
   where
-    optional = Parse.option mempty . fmap toFlag
-
     configFieldDescriptions' :: [FieldDescr SavedConfig]
     configFieldDescriptions' = filter
       (\(FieldDescr name _ _) -> name /= "preference" && name /= "constraint")