Skip to content

Commit

Permalink
Merge pull request #6747 from phadej/remove-sandbox
Browse files Browse the repository at this point in the history 
Remove sandbox
  • Loading branch information
@phadej
phadej authored May 6, 2020
2 parents e140e42 + 6248c74 commit a6aa0bb
Show file tree
Hide file tree
Showing 88 changed files with 202 additions and 3,332 deletions.
12 changes: 3 additions & 9 deletions cabal-install/Distribution/Client/CmdLegacy.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -39,7 +39,7 @@ wrapperAction command verbosityFlag distPrefFlag =
let verbosity' = Setup.fromFlagOrDefault normal (verbosityFlag flags)

load <- try (loadConfigOrSandboxConfig verbosity' globalFlags)
let config = either (\(SomeException _) -> mempty) snd load
let config = either (\(SomeException _) -> mempty) id load
distPref <- findSavedDistPref config (distPrefFlag flags)
let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref }

Expand All @@ -59,8 +59,8 @@ instance HasVerbosity (Setup.Flag Verbosity) where
instance (HasVerbosity a) => HasVerbosity (a, b) where
verbosity (a, _) = verbosity a

instance (HasVerbosity b) => HasVerbosity (a, b, c) where
verbosity (_ , b, _) = verbosity b
instance (HasVerbosity a) => HasVerbosity (a, b, c) where
verbosity (a , _, _) = verbosity a

instance (HasVerbosity a) => HasVerbosity (a, b, c, d) where
verbosity (a, _, _, _) = verbosity a
Expand Down Expand Up @@ -95,12 +95,6 @@ instance HasVerbosity Client.UpdateFlags where
instance HasVerbosity Setup.CleanFlags where
verbosity = verbosity . Setup.cleanVerbosity

instance HasVerbosity Client.SDistFlags where
verbosity = verbosity . Client.sDistVerbosity

instance HasVerbosity Client.SandboxFlags where
verbosity = verbosity . Client.sandboxVerbosity

instance HasVerbosity Setup.DoctestFlags where
verbosity = verbosity . Setup.doctestVerbosity

Expand Down
5 changes: 1 addition & 4 deletions cabal-install/Distribution/Client/Config.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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,
Expand Down Expand Up @@ -890,7 +887,7 @@ configFieldDescriptions src =

toSavedConfig liftGlobalFlag
(commandOptions (globalCommand []) ParseArgs)
["version", "numeric-version", "config-file", "sandbox-config-file"] []
["version", "numeric-version", "config-file"] []

++ toSavedConfig liftConfigFlag
(configureOptions ParseArgs)
Expand Down
47 changes: 0 additions & 47 deletions cabal-install/Distribution/Client/Dependency.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -34,9 +34,6 @@ module Distribution.Client.Dependency (
standardInstallPolicy,
PackageSpecifier(..),

-- ** Sandbox policy
applySandboxInstallPolicy,

-- ** Extra policy options
upgradeDependencies,
reinstallTargets,
Expand Down Expand Up @@ -83,8 +80,6 @@ import Distribution.Client.Types
import Distribution.Client.Dependency.Types
( PreSolver(..), Solver(..)
, PackagesPreferenceDefault(..) )
import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )
import Distribution.Package
( PackageName, mkPackageName, PackageIdentifier(PackageIdentifier), PackageId
, Package(..), packageName, packageVersion )
Expand Down Expand Up @@ -686,48 +681,6 @@ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers
alwaysTrue (PD.Lit True) = True
alwaysTrue _ = False


applySandboxInstallPolicy :: SandboxPackageInfo
-> DepResolverParams
-> DepResolverParams
applySandboxInstallPolicy
(SandboxPackageInfo modifiedDeps otherDeps allSandboxPkgs _allDeps)
params

= addPreferences [ PackageInstalledPreference n PreferInstalled
| n <- installedNotModified ]

. addTargets installedNotModified

. addPreferences
[ PackageVersionPreference (packageName pkg)
(thisVersion (packageVersion pkg)) | pkg <- otherDeps ]

. addConstraints
[ let pc = PackageConstraint
(scopeToplevel $ packageName pkg)
(PackagePropertyVersion $ thisVersion (packageVersion pkg))
in LabeledPackageConstraint pc ConstraintSourceModifiedAddSourceDep
| pkg <- modifiedDeps ]

. addTargets [ packageName pkg | pkg <- modifiedDeps ]

. hideInstalledPackagesSpecificBySourcePackageId
[ packageId pkg | pkg <- modifiedDeps ]

-- We don't need to add source packages for add-source deps to the
-- 'installedPkgIndex' since 'getSourcePackages' did that for us.

$ params

where
installedPkgIds =
map fst . InstalledPackageIndex.allPackagesBySourcePackageId
$ allSandboxPkgs
modifiedPkgIds = map packageId modifiedDeps
installedNotModified = [ packageName pkg | pkg <- installedPkgIds,
pkg `notElem` modifiedPkgIds ]

-- ------------------------------------------------------------
-- * Interface to the standard resolver
-- ------------------------------------------------------------
Expand Down
133 changes: 8 additions & 125 deletions cabal-install/Distribution/Client/Exec.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,44 +14,29 @@ module Distribution.Client.Exec ( exec
import Prelude ()
import Distribution.Client.Compat.Prelude

import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS

import Distribution.Client.Sandbox (getSandboxConfigFilePath)
import Distribution.Client.Sandbox.PackageEnvironment (sandboxPackageDBPath)
import Distribution.Client.Sandbox.Types (UseSandbox (..))

import Distribution.Simple.Compiler (Compiler, CompilerFlavor(..), compilerFlavor)
import Distribution.Simple.Program (ghcProgram, ghcjsProgram, lookupProgram)
import Distribution.Simple.Compiler (Compiler)
import Distribution.Simple.Program.Db (ProgramDb, requireProgram, modifyProgramSearchPath)
import Distribution.Simple.Program.Find (ProgramSearchPathEntry(..))
import Distribution.Simple.Program.Run (programInvocation, runProgramInvocation)
import Distribution.Simple.Program.Types ( simpleProgram, ConfiguredProgram(..) )
import Distribution.Simple.Utils (die', warn)
import Distribution.Simple.Utils (die')

import Distribution.System (Platform(..), OS(..), buildOS)
import Distribution.System (Platform(..))
import Distribution.Verbosity (Verbosity)

import System.Directory ( doesDirectoryExist )
import System.Environment (lookupEnv)
import System.FilePath (searchPathSeparator, (</>))


-- | Execute the given command in the package's environment.
--
-- The given command is executed with GHC configured to use the correct
-- package database and with the sandbox bin directory added to the PATH.
exec :: Verbosity
-> UseSandbox
-> Compiler
-> Platform
-> ProgramDb
-> [String]
-> IO ()
exec verbosity useSandbox comp platform programDb extraArgs =
exec verbosity _comp _platform programDb extraArgs =
case extraArgs of
(exe:args) -> do
program <- requireProgram' verbosity useSandbox programDb exe
program <- requireProgram' verbosity programDb exe
env <- environmentOverrides (programOverrideEnv program)
let invocation = programInvocation
program { programOverrideEnv = env }
Expand All @@ -60,122 +45,20 @@ exec verbosity useSandbox comp platform programDb extraArgs =

[] -> die' verbosity "Please specify an executable to run"
where
environmentOverrides env =
case useSandbox of
NoSandbox -> return env
(UseSandbox sandboxDir) ->
sandboxEnvironment verbosity sandboxDir comp platform programDb env


-- | Return the package's sandbox environment.
--
-- The environment sets GHC_PACKAGE_PATH so that GHC will use the sandbox.
sandboxEnvironment :: Verbosity
-> FilePath
-> Compiler
-> Platform
-> ProgramDb
-> [(String, Maybe String)] -- environment overrides so far
-> IO [(String, Maybe String)]
sandboxEnvironment verbosity sandboxDir comp platform programDb iEnv =
case compilerFlavor comp of
GHC -> env GHC.getGlobalPackageDB ghcProgram "GHC_PACKAGE_PATH"
GHCJS -> env GHCJS.getGlobalPackageDB ghcjsProgram "GHCJS_PACKAGE_PATH"
_ -> die' verbosity "exec only works with GHC and GHCJS"
where
(Platform _ os) = platform
ldPath = case os of
OSX -> "DYLD_LIBRARY_PATH"
Windows -> "PATH"
_ -> "LD_LIBRARY_PATH"
env getGlobalPackageDB hcProgram packagePathEnvVar = do
let program = fromMaybe (error "failed to find hcProgram") $ lookupProgram hcProgram programDb
gDb <- getGlobalPackageDB verbosity program
sandboxConfigFilePath <- getSandboxConfigFilePath mempty
let sandboxPackagePath = sandboxPackageDBPath sandboxDir comp platform
compilerPackagePaths = prependToSearchPath gDb sandboxPackagePath
-- Packages database must exist, otherwise things will start
-- failing in mysterious ways.
exists <- doesDirectoryExist sandboxPackagePath
unless exists $ warn verbosity $ "Package database is not a directory: "
++ sandboxPackagePath
-- MASSIVE HACK. We need this to be synchronized with installLibDir
-- in defaultInstallDirs' in Distribution.Simple.InstallDirs,
-- which has a special case for Windows (WHY? Who knows; it's been
-- around as long as Windows exists.) The sane thing to do here
-- would be to read out the actual install dirs that were associated
-- with the package in question, but that's not a well-formed question
-- here because there is not actually install directory for the
-- "entire" sandbox. Since we want to kill this code in favor of
-- new-build, I decided it wasn't worth fixing this "properly."
-- Also, this doesn't handle LHC correctly but I don't care -- ezyang
let extraLibPath =
case buildOS of
Windows -> sandboxDir
_ -> sandboxDir </> "lib"
-- 2016-11-26 Apologies for the spaghetti code here.
-- Essentially we just want to add the sandbox's lib/ dir to
-- whatever the library search path environment variable is:
-- this allows running existing executables against foreign
-- libraries (meaning Haskell code with a bunch of foreign
-- exports). However, on Windows this variable is equal to the
-- executable search path env var. And we try to keep not only
-- what was already set in the environment, but also the
-- additional directories we add below in requireProgram'. So
-- the strategy is that we first take the environment
-- overrides from requireProgram' below. If the library search
-- path env is overridden (e.g. because we're on windows), we
-- prepend the lib/ dir to the relevant override. If not, we
-- want to avoid wiping the user's own settings, so we first
-- read the env var's current value, and then prefix ours if
-- the user had any set.
iEnv' <-
if any ((==ldPath) . fst) iEnv
then return $ updateLdPath extraLibPath iEnv
else do
currentLibraryPath <- lookupEnv ldPath
let updatedLdPath =
case currentLibraryPath of
Nothing -> Just extraLibPath
Just paths ->
Just $ extraLibPath ++ [searchPathSeparator] ++ paths
return $ (ldPath, updatedLdPath) : iEnv

-- Build the environment
return $ [ (packagePathEnvVar, Just compilerPackagePaths)
, ("CABAL_SANDBOX_PACKAGE_PATH", Just compilerPackagePaths)
, ("CABAL_SANDBOX_CONFIG", Just sandboxConfigFilePath)
] ++ iEnv'

prependToSearchPath path newValue =
newValue ++ [searchPathSeparator] ++ path

updateLdPath path = map update
where
update (name, Just current)
| name == ldPath = (ldPath, Just $ path ++ [searchPathSeparator] ++ current)
update (name, Nothing)
| name == ldPath = (ldPath, Just path)
update x = x

environmentOverrides env = return env

-- | Check that a program is configured and available to be run. If
-- a sandbox is available check in the sandbox's directory.
requireProgram' :: Verbosity
-> UseSandbox
-> ProgramDb
-> String
-> IO ConfiguredProgram
requireProgram' verbosity useSandbox programDb exe = do
requireProgram' verbosity programDb exe = do
(program, _) <- requireProgram
verbosity
(simpleProgram exe)
updateSearchPath
return program
where
updateSearchPath =
flip modifyProgramSearchPath programDb $ \searchPath ->
case useSandbox of
NoSandbox -> searchPath
UseSandbox sandboxDir ->
ProgramSearchPathDir (sandboxDir </> "bin") : searchPath
flip modifyProgramSearchPath programDb $ \searchPath -> searchPath
17 changes: 5 additions & 12 deletions cabal-install/Distribution/Client/Freeze.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -33,8 +33,6 @@ import Distribution.Client.Setup
import Distribution.Client.Sandbox.PackageEnvironment
( loadUserConfig, pkgEnvSavedConfig, showPackageEnvironment,
userPackageEnvironmentFile )
import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )

import Distribution.Solver.Types.ConstraintSource
import Distribution.Solver.Types.LabeledPackageConstraint
Expand Down Expand Up @@ -77,15 +75,14 @@ freeze :: Verbosity
-> Compiler
-> Platform
-> ProgramDb
-> Maybe SandboxPackageInfo
-> GlobalFlags
-> FreezeFlags
-> IO ()
freeze verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
freeze verbosity packageDBs repoCtxt comp platform progdb
globalFlags freezeFlags = do

pkgs <- getFreezePkgs
verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
verbosity packageDBs repoCtxt comp platform progdb
globalFlags freezeFlags

if null pkgs
Expand All @@ -109,11 +106,10 @@ getFreezePkgs :: Verbosity
-> Compiler
-> Platform
-> ProgramDb
-> Maybe SandboxPackageInfo
-> GlobalFlags
-> FreezeFlags
-> IO [SolverPlanPackage]
getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb
globalFlags freezeFlags = do

installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
Expand All @@ -127,7 +123,7 @@ getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo

sanityCheck pkgSpecifiers
planPackages
verbosity comp platform mSandboxPkgInfo freezeFlags
verbosity comp platform freezeFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers
where
sanityCheck pkgSpecifiers = do
Expand All @@ -141,14 +137,13 @@ getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo
planPackages :: Verbosity
-> Compiler
-> Platform
-> Maybe SandboxPackageInfo
-> FreezeFlags
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO [SolverPlanPackage]
planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
planPackages verbosity comp platform freezeFlags
installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers = do

solver <- chooseSolver verbosity
Expand Down Expand Up @@ -196,8 +191,6 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
in LabeledPackageConstraint pc ConstraintSourceFreeze
| pkgSpecifier <- pkgSpecifiers ]

. maybe id applySandboxInstallPolicy mSandboxPkgInfo

$ standardInstallPolicy installedPkgIndex sourcePkgDb pkgSpecifiers

logMsg message rest = debug verbosity message >> rest
Expand Down
Loading

0 comments on commit a6aa0bb

Please sign in to comment.