From 6248c74280a54382f85079f58a1ea40ba0db9476 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Fri, 1 May 2020 10:55:42 +0300 Subject: [PATCH] Remove sandboxes. Removes command and cleanups cabal-testsuite. The tests for #3199 #4099 #3436 are removed, but they seem to be sandbox specific issues. Removes Sandbox.Types, Sandbox.Index and Sandbox.Timestamp modules. The Sandbox and Sandbox.PackageEnvironment are still there as some configuration in v1-commands happens through them (~/.cabal/config vs ./cabal.config). BuildExFlags contained only sandbox specific parameter, so it's removed as well. Remove sandbox support from cabal-testsuite Remove sandbox from GlobalFlags and Sandbox unit-tests --- .../Distribution/Client/CmdLegacy.hs | 12 +- cabal-install/Distribution/Client/Config.hs | 5 +- .../Distribution/Client/Dependency.hs | 47 -- cabal-install/Distribution/Client/Exec.hs | 133 +-- cabal-install/Distribution/Client/Freeze.hs | 17 +- .../Distribution/Client/GenBounds.hs | 9 +- .../Distribution/Client/GlobalFlags.hs | 6 - .../Distribution/Client/IndexUtils.hs | 8 - cabal-install/Distribution/Client/Install.hs | 91 +- cabal-install/Distribution/Client/Nix.hs | 18 - .../Distribution/Client/ProjectConfig.hs | 3 - .../Client/ProjectConfig/Legacy.hs | 4 - .../Distribution/Client/Reconfigure.hs | 60 +- cabal-install/Distribution/Client/Sandbox.hs | 787 +----------------- .../Distribution/Client/Sandbox/Index.hs | 285 ------- .../Client/Sandbox/PackageEnvironment.hs | 337 +------- .../Distribution/Client/Sandbox/Timestamp.hs | 272 ------ .../Distribution/Client/Sandbox/Types.hs | 65 -- cabal-install/Distribution/Client/Setup.hs | 307 +------ cabal-install/cabal-install.cabal | 3 - cabal-install/cabal-install.cabal.pp | 5 - cabal-install/main/Main.hs | 306 ++----- cabal-install/tests/UnitTests.hs | 6 - .../UnitTests/Distribution/Client/Sandbox.hs | 28 - .../Distribution/Client/Sandbox/Timestamp.hs | 63 -- .../PackageTests/CustomDep/sandbox.out | 5 - .../PackageTests/CustomDep/sandbox.test.hs | 22 - .../PackageTests/Exec/T4049/UseLib.c | 9 - .../Exec/T4049/csrc/MyForeignLibWrapper.c | 23 - .../Exec/T4049/my-foreign-lib.cabal | 19 - .../PackageTests/Exec/T4049/sandbox.out | 12 - .../PackageTests/Exec/T4049/sandbox.test.hs | 20 - .../Exec/T4049/src/MyForeignLib/Hello.hs | 10 - .../T4049/src/MyForeignLib/SomeBindings.hsc | 10 - .../PackageTests/Exec/sandbox-ghc-pkg.out | 16 - .../PackageTests/Exec/sandbox-ghc-pkg.test.hs | 12 - .../PackageTests/Exec/sandbox-hc-pkg.out | 16 - .../PackageTests/Exec/sandbox-hc-pkg.test.hs | 26 - .../PackageTests/Exec/sandbox-path.out | 16 - .../PackageTests/Exec/sandbox-path.test.hs | 8 - cabal-testsuite/PackageTests/Exec/sandbox.out | 16 - .../PackageTests/Exec/sandbox.test.hs | 7 - .../PackageTests/Freeze/freeze.test.hs | 2 - .../InternalLibraries/sandbox-shadow.out | 18 - .../InternalLibraries/sandbox-shadow.test.hs | 6 - .../InternalLibraries/sandbox.out | 17 - .../InternalLibraries/sandbox.test.hs | 5 - .../Regression/T3199/Cabal/Cabal.cabal | 8 - .../PackageTests/Regression/T3199/Main.hs | 4 - .../PackageTests/Regression/T3199/Setup.hs | 2 - .../PackageTests/Regression/T3199/sandbox.out | 8 - .../Regression/T3199/sandbox.test.hs | 11 - .../Regression/T3199/test-3199.cabal | 27 - .../Regression/T3436/Cabal-1.2/Cabal.cabal | 8 - .../T3436/Cabal-1.2/CabalMessage.hs | 3 - .../Regression/T3436/Cabal-2.0/Cabal.cabal | 8 - .../T3436/Cabal-2.0/CabalMessage.hs | 3 - .../PackageTests/Regression/T3436/cabal.out | 9 - .../Regression/T3436/cabal.project | 1 - .../Regression/T3436/custom-setup/Setup.hs | 5 - .../T3436/custom-setup/custom-setup.cabal | 10 - .../PackageTests/Regression/T3436/sandbox.out | 22 - .../Regression/T3436/sandbox.test.hs | 21 - .../Sandbox/MultipleSources/cabal.out | 12 - .../Sandbox/MultipleSources/cabal.test.hs | 6 - .../Sandbox/MultipleSources/p/LICENSE | 0 .../Sandbox/MultipleSources/p/Setup.hs | 2 - .../Sandbox/MultipleSources/p/p.cabal | 11 - .../Sandbox/MultipleSources/q/LICENSE | 0 .../Sandbox/MultipleSources/q/Setup.hs | 2 - .../Sandbox/MultipleSources/q/q.cabal | 11 - .../PackageTests/Sandbox/Reinstall/p/Main.hs | 7 - .../PackageTests/Sandbox/Reinstall/p/p.cabal | 8 - .../PackageTests/Sandbox/Reinstall/q/Q.hs | 4 - .../PackageTests/Sandbox/Reinstall/q/Q.hs.in2 | 4 - .../PackageTests/Sandbox/Reinstall/q/q.cabal | 8 - .../Sandbox/Reinstall/sandbox.out | 15 - .../Sandbox/Reinstall/sandbox.test.hs | 9 - .../PackageTests/Sandbox/Sources/p/LICENSE | 0 .../PackageTests/Sandbox/Sources/p/Setup.hs | 2 - .../PackageTests/Sandbox/Sources/p/p.cabal | 11 - .../PackageTests/Sandbox/Sources/q/LICENSE | 0 .../PackageTests/Sandbox/Sources/q/Setup.hs | 2 - .../PackageTests/Sandbox/Sources/q/q.cabal | 11 - .../PackageTests/Sandbox/Sources/sandbox.out | 15 - .../Sandbox/Sources/sandbox.test.hs | 7 - cabal-testsuite/src/Test/Cabal/Monad.hs | 13 - cabal-testsuite/src/Test/Cabal/Prelude.hs | 52 +- 88 files changed, 202 insertions(+), 3332 deletions(-) delete mode 100644 cabal-install/Distribution/Client/Sandbox/Index.hs delete mode 100644 cabal-install/Distribution/Client/Sandbox/Timestamp.hs delete mode 100644 cabal-install/Distribution/Client/Sandbox/Types.hs delete mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs delete mode 100644 cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs delete mode 100644 cabal-testsuite/PackageTests/CustomDep/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/CustomDep/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/UseLib.c delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/csrc/MyForeignLibWrapper.c delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/my-foreign-lib.cabal delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/Hello.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/SomeBindings.hsc delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.out delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.test.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.out delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-path.out delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox-path.test.hs delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Exec/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out delete mode 100644 cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.test.hs delete mode 100644 cabal-testsuite/PackageTests/InternalLibraries/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/InternalLibraries/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/Cabal/Cabal.cabal delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/Main.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3199/test-3199.cabal delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/Cabal.cabal delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/CabalMessage.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/Cabal.cabal delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/CabalMessage.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/cabal.out delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/cabal.project delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/custom-setup/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/custom-setup/custom-setup.cabal delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Regression/T3436/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.out delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.test.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/LICENSE delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/p.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/LICENSE delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/q.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/p/Main.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/p/p.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs.in2 delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/q/q.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.test.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/p/LICENSE delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/p/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/p/p.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/q/LICENSE delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/q/Setup.hs delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/q/q.cabal delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.out delete mode 100644 cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.test.hs diff --git a/cabal-install/Distribution/Client/CmdLegacy.hs b/cabal-install/Distribution/Client/CmdLegacy.hs index 8b2d5e95503..532ff47a540 100644 --- a/cabal-install/Distribution/Client/CmdLegacy.hs +++ b/cabal-install/Distribution/Client/CmdLegacy.hs @@ -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 } @@ -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 @@ -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 diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 3ca2678fea3..f5613ba9e74 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -247,7 +247,6 @@ 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, @@ -255,8 +254,6 @@ instance Semigroup SavedConfig where globalLocalNoIndexRepos = lastNonEmptyNL globalLocalNoIndexRepos, globalLogsDir = combine globalLogsDir, globalWorldFile = combine globalWorldFile, - globalRequireSandbox = combine globalRequireSandbox, - globalIgnoreSandbox = combine globalIgnoreSandbox, globalIgnoreExpiry = combine globalIgnoreExpiry, globalHttpTransport = combine globalHttpTransport, globalNix = combine globalNix, @@ -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) diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index f73f2e46086..5010b6f8135 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -34,9 +34,6 @@ module Distribution.Client.Dependency ( standardInstallPolicy, PackageSpecifier(..), - -- ** Sandbox policy - applySandboxInstallPolicy, - -- ** Extra policy options upgradeDependencies, reinstallTargets, @@ -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 ) @@ -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 -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/Exec.hs b/cabal-install/Distribution/Client/Exec.hs index a7767112de2..8a21ac4cf04 100644 --- a/cabal-install/Distribution/Client/Exec.hs +++ b/cabal-install/Distribution/Client/Exec.hs @@ -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 } @@ -60,113 +45,15 @@ 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) @@ -174,8 +61,4 @@ requireProgram' verbosity useSandbox programDb exe = do return program where updateSearchPath = - flip modifyProgramSearchPath programDb $ \searchPath -> - case useSandbox of - NoSandbox -> searchPath - UseSandbox sandboxDir -> - ProgramSearchPathDir (sandboxDir "bin") : searchPath + flip modifyProgramSearchPath programDb $ \searchPath -> searchPath diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs index 99694ed9d3b..fe319f53317 100644 --- a/cabal-install/Distribution/Client/Freeze.hs +++ b/cabal-install/Distribution/Client/Freeze.hs @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 @@ -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 diff --git a/cabal-install/Distribution/Client/GenBounds.hs b/cabal-install/Distribution/Client/GenBounds.hs index 454a9cfad72..e6f9fcb6334 100644 --- a/cabal-install/Distribution/Client/GenBounds.hs +++ b/cabal-install/Distribution/Client/GenBounds.hs @@ -23,8 +23,6 @@ import Distribution.Client.Init ( incVersion ) import Distribution.Client.Freeze ( getFreezePkgs ) -import Distribution.Client.Sandbox.Types - ( SandboxPackageInfo(..) ) import Distribution.Client.Setup ( GlobalFlags(..), FreezeFlags(..), RepoContext ) import Distribution.Package @@ -103,13 +101,10 @@ genBounds -> Compiler -> Platform -> ProgramDb - -> Maybe SandboxPackageInfo -> GlobalFlags -> FreezeFlags -> IO () -genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo - globalFlags freezeFlags = do - +genBounds verbosity packageDBs repoCtxt comp platform progdb globalFlags freezeFlags = do let cinfo = compilerInfo comp cwd <- getCurrentDirectory @@ -133,7 +128,7 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo go needBounds = do pkgs <- getFreezePkgs verbosity packageDBs repoCtxt comp platform progdb - mSandboxPkgInfo globalFlags freezeFlags + globalFlags freezeFlags putStrLn boundsNeededMsg diff --git a/cabal-install/Distribution/Client/GlobalFlags.hs b/cabal-install/Distribution/Client/GlobalFlags.hs index 9df50bdfee5..7bf5cb54c91 100644 --- a/cabal-install/Distribution/Client/GlobalFlags.hs +++ b/cabal-install/Distribution/Client/GlobalFlags.hs @@ -59,7 +59,6 @@ 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, @@ -67,8 +66,6 @@ data GlobalFlags = GlobalFlags { 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,7 +78,6 @@ defaultGlobalFlags = GlobalFlags { globalVersion = Flag False, globalNumericVersion = Flag False, globalConfigFile = mempty, - globalSandboxConfigFile = mempty, globalConstraintsFile = mempty, globalRemoteRepos = mempty, globalCacheDir = mempty, @@ -89,8 +85,6 @@ defaultGlobalFlags = GlobalFlags { globalLocalNoIndexRepos = mempty, globalLogsDir = mempty, globalWorldFile = mempty, - globalRequireSandbox = Flag False, - globalIgnoreSandbox = Flag False, globalIgnoreExpiry = Flag False, globalHttpTransport = mempty, globalNix = Flag False, diff --git a/cabal-install/Distribution/Client/IndexUtils.hs b/cabal-install/Distribution/Client/IndexUtils.hs index cdb5d7a0595..50b030e2c4c 100644 --- a/cabal-install/Distribution/Client/IndexUtils.hs +++ b/cabal-install/Distribution/Client/IndexUtils.hs @@ -37,7 +37,6 @@ module Distribution.Client.IndexUtils ( updatePackageIndexCacheFile, writeIndexTimestamp, currentIndexTimestamp, - readCacheStrict, -- only used by soon-to-be-obsolete sandbox code BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType ) where @@ -328,13 +327,6 @@ instance Monoid RepoData where mempty = RepoData mempty mempty mempty mappend = (<>) -readCacheStrict :: NFData pkg => Verbosity -> Index -> (PackageEntry -> pkg) -> IO ([pkg], [Dependency]) -readCacheStrict verbosity index mkPkg = do - updateRepoIndexCache verbosity index - cache <- readIndexCache verbosity index - withFile (indexFile index) ReadMode $ \indexHnd -> - evaluate . force =<< packageListFromCache verbosity mkPkg indexHnd cache - -- | Read a repository index from disk, from the local file specified by -- the 'Repo'. -- diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 56349c9afed..bc855272c9d 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -35,7 +35,6 @@ import Distribution.Utils.Generic(safeLast) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map -import qualified Data.Set as S import Control.Exception as Exception ( Exception(toException), bracket, catches , Handler(Handler), handleJust, IOException, SomeException ) @@ -84,11 +83,6 @@ import Distribution.Client.Setup , filterTestFlags ) import Distribution.Client.Config ( getCabalDir, defaultUserInstall ) -import Distribution.Client.Sandbox.Timestamp - ( withUpdateTimestamps ) -import Distribution.Client.Sandbox.Types - ( SandboxPackageInfo(..), UseSandbox(..), isUseSandbox - , whenUsingSandbox ) import Distribution.Client.Tar (extractTarGzFile) import Distribution.Client.Types as Source import Distribution.Client.BuildReports.Types @@ -167,7 +161,7 @@ import Distribution.Simple.Utils as Utils , withTempDirectory ) import Distribution.Client.Utils ( determineNumJobs, logDirChange, mergeBy, MergeResult(..) - , tryCanonicalizePath, ProgressPhase(..), progressMessage ) + , ProgressPhase(..), progressMessage ) import Distribution.System ( Platform, OS(Windows), buildOS, buildPlatform ) import Distribution.Verbosity as Verbosity @@ -201,8 +195,6 @@ install -> Compiler -> Platform -> ProgramDb - -> UseSandbox - -> Maybe SandboxPackageInfo -> GlobalFlags -> ConfigFlags -> ConfigExFlags @@ -212,7 +204,7 @@ install -> BenchmarkFlags -> [UserTarget] -> IO () -install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgInfo +install verbosity packageDBs repos comp platform progdb globalFlags configFlags configExFlags installFlags haddockFlags testFlags benchmarkFlags userTargets0 = do @@ -222,7 +214,6 @@ install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgIn ++ " (if you didn't type --root-cmd, comment out root-cmd" ++ " in your ~/.cabal/config file)" let userOrSandbox = fromFlag (configUserInstall configFlags) - || isUseSandbox useSandbox unless userOrSandbox $ warn verbosity $ "the --global flag is deprecated -- " ++ "it is generally considered a bad idea to install packages " @@ -240,18 +231,12 @@ install verbosity packageDBs repos comp platform progdb useSandbox mSandboxPkgIn processInstallPlan verbosity args installContext installPlan where args :: InstallArgs - args = (packageDBs, repos, comp, platform, progdb, useSandbox, - mSandboxPkgInfo, globalFlags, configFlags, configExFlags, + args = (packageDBs, repos, comp, platform, progdb, + globalFlags, configFlags, configExFlags, installFlags, haddockFlags, testFlags, benchmarkFlags) - die'' message = die' verbosity (message ++ if isUseSandbox useSandbox - then installFailedInSandbox else []) - -- TODO: use a better error message, remove duplication. - installFailedInSandbox = - "\nNote: when using a sandbox, all packages are required to have " - ++ "consistent dependencies. " - ++ "Try reinstalling/unregistering the offending packages or " - ++ "recreating the sandbox." + die'' = die' verbosity + logMsg message rest = debugNoWrap verbosity message >> rest -- TODO: Make InstallContext a proper data type with documented fields. @@ -269,8 +254,6 @@ type InstallArgs = ( PackageDBStack , Compiler , Platform , ProgramDb - , UseSandbox - , Maybe SandboxPackageInfo , GlobalFlags , ConfigFlags , ConfigExFlags @@ -283,7 +266,7 @@ type InstallArgs = ( PackageDBStack makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget] -> IO InstallContext makeInstallContext verbosity - (packageDBs, repoCtxt, comp, _, progdb,_,_, + (packageDBs, repoCtxt, comp, _, progdb, globalFlags, _, configExFlags, installFlags, _, _, _) mUserTargets = do let idxState = flagToMaybe (installIndexState installFlags) @@ -321,7 +304,7 @@ makeInstallContext verbosity makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext -> IO (Progress String String SolverInstallPlan) makeInstallPlan verbosity - (_, _, comp, platform, _, _, mSandboxPkgInfo, + (_, _, comp, platform,_, _, configFlags, configExFlags, installFlags, _, _, _) (installedPkgIndex, sourcePkgDb, pkgConfigDb, @@ -330,7 +313,7 @@ makeInstallPlan verbosity solver <- chooseSolver verbosity (fromFlag (configSolver configExFlags)) (compilerInfo comp) notice verbosity "Resolving dependencies..." - return $ planPackages verbosity comp platform mSandboxPkgInfo solver + return $ planPackages verbosity comp platform solver configFlags configExFlags installFlags installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers @@ -339,7 +322,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext -> SolverInstallPlan -> IO () processInstallPlan verbosity - args@(_,_, _, _, _, _, _, _, configFlags, _, installFlags, _, _, _) + args@(_,_, _, _, _, _, configFlags, _, installFlags, _, _, _) (installedPkgIndex, sourcePkgDb, _, userTargets, pkgSpecifiers, _) installPlan0 = do @@ -362,7 +345,6 @@ processInstallPlan verbosity planPackages :: Verbosity -> Compiler -> Platform - -> Maybe SandboxPackageInfo -> Solver -> ConfigFlags -> ConfigExFlags @@ -372,7 +354,7 @@ planPackages :: Verbosity -> PkgConfigDb -> [PackageSpecifier UnresolvedSourcePackage] -> Progress String String SolverInstallPlan -planPackages verbosity comp platform mSandboxPkgInfo solver +planPackages verbosity comp platform solver configFlags configExFlags installFlags installedPkgIndex sourcePkgDb pkgConfigDb pkgSpecifiers = @@ -445,8 +427,6 @@ planPackages verbosity comp platform mSandboxPkgInfo solver in LabeledPackageConstraint pc ConstraintSourceConfigFlagOrTarget | pkgSpecifier <- pkgSpecifiers ] - . maybe id applySandboxInstallPolicy mSandboxPkgInfo - . (if reinstall then reinstallTargets else id) -- Don't solve for executables, the legacy install codepath @@ -762,7 +742,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String -> IO () reportPlanningFailure verbosity - (_, _, comp, platform, _, _, _ + (_, _, comp, platform, _ ,_, configFlags, _, installFlags, _, _, _) (_, sourcePkgDb, _, _, pkgSpecifiers, _) message = do @@ -842,13 +822,10 @@ postInstallActions :: Verbosity -> BuildOutcomes -> IO () postInstallActions verbosity - (packageDBs, _, comp, platform, progdb, useSandbox, mSandboxPkgInfo + (packageDBs, _, comp, platform, progdb ,globalFlags, configFlags, _, installFlags, _, _, _) targets installPlan buildOutcomes = do - updateSandboxTimestampsFile verbosity useSandbox mSandboxPkgInfo - comp platform installPlan buildOutcomes - unless oneShot $ World.insert verbosity worldFile --FIXME: does not handle flags @@ -866,7 +843,7 @@ postInstallActions verbosity when (reportingLevel == DetailedReports) $ storeDetailedBuildReports verbosity logsDir buildReports - regenerateHaddockIndex verbosity packageDBs comp platform progdb useSandbox + regenerateHaddockIndex verbosity packageDBs comp platform progdb configFlags installFlags buildOutcomes symlinkBinaries verbosity platform comp configFlags installFlags @@ -919,12 +896,11 @@ regenerateHaddockIndex :: Verbosity -> Compiler -> Platform -> ProgramDb - -> UseSandbox -> ConfigFlags -> InstallFlags -> BuildOutcomes -> IO () -regenerateHaddockIndex verbosity packageDBs comp platform progdb useSandbox +regenerateHaddockIndex verbosity packageDBs comp platform progdb configFlags installFlags buildOutcomes | haddockIndexFileIsRequested && shouldRegenerateHaddockIndex = do @@ -952,8 +928,7 @@ regenerateHaddockIndex verbosity packageDBs comp platform progdb useSandbox -- installed. Since the index can be only per-user or per-sandbox (see -- #1337), we don't do it for global installs or special cases where we're -- installing into a specific db. - shouldRegenerateHaddockIndex = (isUseSandbox useSandbox || normalUserInstall) - && someDocsWereInstalled buildOutcomes + shouldRegenerateHaddockIndex = normalUserInstall && someDocsWereInstalled buildOutcomes where someDocsWereInstalled = any installedDocs . Map.elems installedDocs (Right (BuildResult DocsOk _ _)) = True @@ -1051,33 +1026,6 @@ printBuildFailures verbosity buildOutcomes = onExitFailure _ = "" #endif - --- | If we're working inside a sandbox and some add-source deps were installed, --- update the timestamps of those deps. -updateSandboxTimestampsFile :: Verbosity -> UseSandbox -> Maybe SandboxPackageInfo - -> Compiler -> Platform - -> InstallPlan - -> BuildOutcomes - -> IO () -updateSandboxTimestampsFile verbosity (UseSandbox sandboxDir) - (Just (SandboxPackageInfo _ _ _ allAddSourceDeps)) - comp platform installPlan buildOutcomes = - withUpdateTimestamps verbosity sandboxDir (compilerId comp) platform $ \_ -> do - let allInstalled = [ pkg - | InstallPlan.Configured pkg - <- InstallPlan.toList installPlan - , case InstallPlan.lookupBuildOutcome pkg buildOutcomes of - Just (Right _success) -> True - _ -> False - ] - allSrcPkgs = [ confPkgSource cpkg | cpkg <- allInstalled ] - allPaths = [ pth | LocalUnpackedPackage pth - <- map packageSource allSrcPkgs] - allPathsCanonical <- mapM tryCanonicalizePath allPaths - return $! filter (`S.member` allAddSourceDeps) allPathsCanonical - -updateSandboxTimestampsFile _ _ _ _ _ _ _ = return () - -- ------------------------------------------------------------ -- * Actually do the installations -- ------------------------------------------------------------ @@ -1096,16 +1044,11 @@ performInstallations :: Verbosity -> InstallPlan -> IO BuildOutcomes performInstallations verbosity - (packageDBs, repoCtxt, comp, platform, progdb, useSandbox, _, + (packageDBs, repoCtxt, comp, platform, progdb, globalFlags, configFlags, configExFlags, installFlags, haddockFlags, testFlags, _) installedPkgIndex installPlan = do - -- With 'install -j' it can be a bit hard to tell whether a sandbox is used. - whenUsingSandbox useSandbox $ \sandboxDir -> - when parallelInstall $ - notice verbosity $ "Notice: installing into a sandbox located at " - ++ sandboxDir info verbosity $ "Number of threads used: " ++ (show numJobs) ++ "." jobControl <- if parallelInstall then newParallelJobControl numJobs diff --git a/cabal-install/Distribution/Client/Nix.hs b/cabal-install/Distribution/Client/Nix.hs index 5c8b9a7cd46..fbe89834572 100644 --- a/cabal-install/Distribution/Client/Nix.hs +++ b/cabal-install/Distribution/Client/Nix.hs @@ -6,7 +6,6 @@ module Distribution.Client.Nix , inNixShell , nixInstantiate , nixShell - , nixShellIfSandboxed ) where import Distribution.Client.Compat.Prelude @@ -36,7 +35,6 @@ import Distribution.Simple.Utils (debug, existsAndIsMoreRecentThan) import Distribution.Client.Config (SavedConfig(..)) import Distribution.Client.GlobalFlags (GlobalFlags(..)) -import Distribution.Client.Sandbox.Types (UseSandbox(..)) configureOneProgram :: Verbosity -> Program -> IO ProgramDb @@ -184,19 +182,3 @@ removeGCRoots verb dist = do when exists $ do debug verb ("removing Nix gcroots from " ++ tgt) removeDirectoryRecursive tgt - - -nixShellIfSandboxed - :: Verbosity - -> FilePath - -> GlobalFlags - -> SavedConfig - -> UseSandbox - -> IO () - -- ^ The action to perform inside a nix-shell. This is also the action - -- that will be performed immediately if Nix is disabled. - -> IO () -nixShellIfSandboxed verb dist globalFlags config useSandbox go = - case useSandbox of - NoSandbox -> go - UseSandbox _ -> nixShell verb dist globalFlags config go diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index 09c3a84f132..c3c8f63c321 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -438,9 +438,6 @@ findProjectRoot mstartdir mprojectFile = do then return (Right (ProjectRootExplicit dir projectFileName)) else go (takeDirectory dir) - --TODO: [nice to have] add compat support for old style sandboxes - - -- | Errors returned by 'findProjectRoot'. -- data BadProjectRoot = BadProjectRootExplicitFile FilePath diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 834e2400e16..35818df8ea6 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/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,7 +566,6 @@ convertToLegacySharedConfig globalVersion = mempty, globalNumericVersion = mempty, globalConfigFile = projectConfigConfigFile, - globalSandboxConfigFile = mempty, globalConstraintsFile = mempty, globalRemoteRepos = projectConfigRemoteRepos, globalCacheDir = projectConfigCacheDir, @@ -575,8 +573,6 @@ convertToLegacySharedConfig globalLocalNoIndexRepos = projectConfigLocalNoIndexRepos, globalLogsDir = projectConfigLogsDir, globalWorldFile = mempty, - globalRequireSandbox = mempty, - globalIgnoreSandbox = mempty, globalIgnoreExpiry = projectConfigIgnoreExpiry, globalHttpTransport = projectConfigHttpTransport, globalNix = mempty, diff --git a/cabal-install/Distribution/Client/Reconfigure.hs b/cabal-install/Distribution/Client/Reconfigure.hs index 115d16c4854..ced89b37a1f 100644 --- a/cabal-install/Distribution/Client/Reconfigure.hs +++ b/cabal-install/Distribution/Client/Reconfigure.hs @@ -15,16 +15,11 @@ import Distribution.Simple.Utils import Distribution.Client.Config ( SavedConfig(..) ) import Distribution.Client.Configure ( readConfigFlags ) import Distribution.Client.Nix ( findNixExpr, inNixShell, nixInstantiate ) -import Distribution.Client.Sandbox - ( WereDepsReinstalled(..), findSavedDistPref, getSandboxConfigFilePath - , maybeReinstallAddSourceDeps, updateInstallDirs ) +import Distribution.Client.Sandbox ( findSavedDistPref, updateInstallDirs ) import Distribution.Client.Sandbox.PackageEnvironment ( userPackageEnvironmentFile ) -import Distribution.Client.Sandbox.Types ( UseSandbox(..) ) import Distribution.Client.Setup - ( ConfigFlags(..), ConfigExFlags, GlobalFlags(..) - , SkipAddSourceDepsCheck(..) ) - + ( ConfigFlags(..), ConfigExFlags, GlobalFlags(..) ) -- | @Check@ represents a function to check some condition on type @a@. The -- returned 'Any' is 'True' if any part of the condition failed. @@ -82,10 +77,6 @@ reconfigure -- ^ Verbosity setting -> FilePath -- ^ \"dist\" prefix - -> UseSandbox - -> SkipAddSourceDepsCheck - -- ^ Should we skip the timestamp check for modified - -- add-source dependencies? -> Flag (Maybe Int) -- ^ -j flag for reinstalling add-source deps. -> Check (ConfigFlags, ConfigExFlags) @@ -100,9 +91,7 @@ reconfigure configureAction verbosity dist - useSandbox - skipAddSourceDepsCheck - numJobsFlag + _numJobsFlag check extraArgs globalFlags @@ -137,13 +126,9 @@ reconfigure <> checkDist <> checkOutdated <> check - <> checkAddSourceDeps (Any force, flags@(configFlags, _)) <- runCheck checks mempty savedFlags - let (_, config') = - updateInstallDirs - (configUserInstall configFlags) - (useSandbox, config) + let config' = updateInstallDirs (configUserInstall configFlags) config when force $ configureAction flags extraArgs globalFlags return config' @@ -174,13 +159,6 @@ reconfigure configured <- doesFileExist buildConfig unless configured $ info verbosity "package has never been configured" - -- Is the configuration older than the sandbox configuration file? - -- If so, reconfiguration is required. - sandboxConfig <- getSandboxConfigFilePath globalFlags - sandboxConfigNewer <- existsAndIsMoreRecentThan sandboxConfig buildConfig - when sandboxConfigNewer $ - info verbosity "sandbox was created after the package was configured" - -- Is the @cabal.config@ file newer than @dist/setup.config@? Then we need -- to force reconfigure. Note that it's possible to use @cabal.config@ -- even without sandboxes. @@ -199,35 +177,5 @@ reconfigure let failed = Any outdated <> Any userPackageEnvironmentFileModified - <> Any sandboxConfigNewer <> Any (not configured) return (failed, flags) - - checkAddSourceDeps = Check $ \(Any force') flags@(configFlags, _) -> do - let (_, config') = - updateInstallDirs - (configUserInstall configFlags) - (useSandbox, config) - - skipAddSourceDepsCheck' - | force' = SkipAddSourceDepsCheck - | otherwise = skipAddSourceDepsCheck - - when (skipAddSourceDepsCheck' == SkipAddSourceDepsCheck) $ - info verbosity "skipping add-source deps check" - - -- Were any add-source dependencies reinstalled in the sandbox? - depsReinstalled <- - case skipAddSourceDepsCheck' of - DontSkipAddSourceDepsCheck -> - maybeReinstallAddSourceDeps - verbosity numJobsFlag configFlags globalFlags - (useSandbox, config') - SkipAddSourceDepsCheck -> do - return NoDepsReinstalled - - case depsReinstalled of - NoDepsReinstalled -> return (mempty, flags) - ReinstalledSomeDeps -> do - info verbosity "some add-source dependencies were reinstalled" - return (Any True, flags) diff --git a/cabal-install/Distribution/Client/Sandbox.hs b/cabal-install/Distribution/Client/Sandbox.hs index 2e18f9fe450..c5ddf1b8d97 100644 --- a/cabal-install/Distribution/Client/Sandbox.hs +++ b/cabal-install/Distribution/Client/Sandbox.hs @@ -10,33 +10,9 @@ ----------------------------------------------------------------------------- module Distribution.Client.Sandbox ( - sandboxInit, - sandboxDelete, - sandboxAddSource, - sandboxAddSourceSnapshot, - sandboxDeleteSource, - sandboxListSources, - sandboxHcPkg, - dumpPackageEnvironment, - withSandboxBinDirOnSearchPath, - - getSandboxConfigFilePath, loadConfigOrSandboxConfig, findSavedDistPref, - initPackageDBIfNeeded, - maybeWithSandboxDirOnSearchPath, - - WereDepsReinstalled(..), - reinstallAddSourceDeps, - maybeReinstallAddSourceDeps, - SandboxPackageInfo(..), - maybeWithSandboxPackageInfo, - - tryGetIndexFilePath, - sandboxBuildDir, - getInstalledPackagesInSandbox, - updateSandboxConfigFileFlag, updateInstallDirs, getPersistOrConfigCompiler @@ -44,529 +20,42 @@ module Distribution.Client.Sandbox ( import Prelude () import Distribution.Client.Compat.Prelude -import Distribution.Utils.Generic(safeLast) import Distribution.Client.Setup - ( SandboxFlags(..), ConfigFlags(..), ConfigExFlags(..), InstallFlags(..) - , GlobalFlags(..), configCompilerAux', configPackageDB' - , defaultConfigExFlags, defaultInstallFlags - , defaultSandboxLocation, withRepoContext ) -import Distribution.Client.Sandbox.Timestamp ( listModifiedDeps - , maybeAddCompilerTimestampRecord - , withAddTimestamps - , removeTimestamps ) + ( ConfigFlags(..), GlobalFlags(..), configCompilerAux' ) import Distribution.Client.Config ( SavedConfig(..), defaultUserInstall, loadConfig ) -import Distribution.Client.Dependency ( foldProgress ) -import Distribution.Client.IndexUtils ( BuildTreeRefType(..) ) -import Distribution.Client.Install ( InstallArgs, - makeInstallContext, - makeInstallPlan, - processInstallPlan ) -import Distribution.Utils.NubList ( fromNubList ) import Distribution.Client.Sandbox.PackageEnvironment - ( PackageEnvironment(..), PackageEnvironmentType(..) - , createPackageEnvironmentFile, classifyPackageEnvironment - , tryLoadSandboxPackageEnvironmentFile, loadUserConfig - , commentPackageEnvironment, showPackageEnvironmentWithComments - , sandboxPackageEnvironmentFile, userPackageEnvironmentFile - , sandboxPackageDBPath ) -import Distribution.Client.Sandbox.Types ( SandboxPackageInfo(..) - , UseSandbox(..) ) + ( PackageEnvironmentType(..) + , classifyPackageEnvironment + , loadUserConfig + ) import Distribution.Client.SetupWrapper ( SetupScriptOptions(..), defaultSetupScriptOptions ) -import Distribution.Client.Types ( PackageLocation(..) ) -import Distribution.Client.Utils ( inDir, tryCanonicalizePath - , tryFindAddSourcePackageDesc) -import Distribution.PackageDescription.Configuration - ( flattenPackageDescription ) -import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) -import Distribution.Simple.Compiler ( Compiler(..), PackageDB(..) ) -import Distribution.Simple.Configure ( configCompilerAuxEx - , getPackageDBContents - , maybeGetPersistBuildConfig +import Distribution.Simple.Compiler ( Compiler(..) ) +import Distribution.Simple.Configure ( maybeGetPersistBuildConfig , findDistPrefOrDefault , findDistPref ) import qualified Distribution.Simple.LocalBuildInfo as LocalBuildInfo -import Distribution.Simple.PreProcess ( knownSuffixHandlers ) import Distribution.Simple.Program ( ProgramDb ) -import Distribution.Simple.Setup ( Flag(..), HaddockFlags(..) - , emptyTestFlags, emptyBenchmarkFlags +import Distribution.Simple.Setup ( Flag(..) , fromFlagOrDefault, flagToMaybe ) -import Distribution.Simple.SrcDist ( prepareTree ) -import Distribution.Simple.Utils ( die', debug, notice, info, warn - , debugNoWrap, defaultPackageDesc - , topHandlerWith - , createDirectoryIfMissingVerbose ) -import Distribution.Package ( Package(..) ) import Distribution.System ( Platform ) -import Distribution.Deprecated.Text ( display ) import Distribution.Verbosity ( Verbosity ) -import Distribution.Compat.Environment ( lookupEnv, setEnv ) -import Distribution.Client.Compat.FilePerms ( setFileHidden ) -import qualified Distribution.Client.Sandbox.Index as Index -import Distribution.Simple.PackageIndex ( InstalledPackageIndex ) -import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex -import qualified Distribution.Simple.Register as Register - -import Distribution.Solver.Types.SourcePackage -import qualified Data.Map as M -import qualified Data.Set as S -import Data.Either (partitionEithers) -import Control.Exception ( assert, bracket_ ) -import Control.Monad ( forM, mapM, mapM_ ) -import Data.Bits ( shiftL, shiftR, xor ) -import Data.IORef ( newIORef, writeIORef, readIORef ) -import Data.List ( delete - , groupBy ) -import Data.Maybe ( fromJust ) -import Numeric ( showHex ) -import System.Directory ( canonicalizePath - , createDirectory - , doesDirectoryExist - , doesFileExist - , getCurrentDirectory - , removeDirectoryRecursive - , removeFile - , renameDirectory ) -import System.FilePath ( (), equalFilePath - , getSearchPath - , searchPathSeparator - , splitSearchPath - , takeDirectory ) - --- --- * Constants --- +import System.Directory ( getCurrentDirectory ) --- | The name of the sandbox subdirectory where we keep snapshots of add-source --- dependencies. -snapshotDirectoryName :: FilePath -snapshotDirectoryName = "snapshots" --- | Non-standard build dir that is used for building add-source deps instead of --- "dist". Fixes surprising behaviour in some cases (see issue #1281). -sandboxBuildDir :: FilePath -> FilePath -sandboxBuildDir sandboxDir = "dist/dist-sandbox-" ++ showHex sandboxDirHash "" - where - sandboxDirHash = jenkins sandboxDir - - -- See http://en.wikipedia.org/wiki/Jenkins_hash_function - jenkins :: String -> Word32 - jenkins str = loop_finish $ foldl' loop 0 str - where - loop :: Word32 -> Char -> Word32 - loop hash key_i' = hash''' - where - key_i = toEnum . ord $ key_i' - hash' = hash + key_i - hash'' = hash' + (shiftL hash' 10) - hash''' = hash'' `xor` (shiftR hash'' 6) - - loop_finish :: Word32 -> Word32 - loop_finish hash = hash''' - where - hash' = hash + (shiftL hash 3) - hash'' = hash' `xor` (shiftR hash' 11) - hash''' = hash'' + (shiftL hash'' 15) - --- -- * Basic sandbox functions. -- --- | If @--sandbox-config-file@ wasn't given on the command-line, set it to the --- 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' } - --- | 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 - --- | Load the @cabal.sandbox.config@ file (and possibly the optional --- @cabal.config@). In addition to a @PackageEnvironment@, also return a --- canonical path to the sandbox. Exit with error if the sandbox directory or --- the package environment file do not exist. -tryLoadSandboxConfig :: Verbosity -> GlobalFlags - -> IO (FilePath, PackageEnvironment) -tryLoadSandboxConfig verbosity globalFlags = do - path <- getSandboxConfigFilePath globalFlags - tryLoadSandboxPackageEnvironmentFile verbosity path - (globalConfigFile globalFlags) - --- | Return the name of the package index file for this package environment. -tryGetIndexFilePath :: Verbosity -> SavedConfig -> IO FilePath -tryGetIndexFilePath verbosity config = tryGetIndexFilePath' verbosity (savedGlobalFlags config) - --- | The same as 'tryGetIndexFilePath', but takes 'GlobalFlags' instead of --- 'SavedConfig'. -tryGetIndexFilePath' :: Verbosity -> GlobalFlags -> IO FilePath -tryGetIndexFilePath' verbosity globalFlags = do - let paths = fromNubList $ globalLocalRepos globalFlags - case safeLast paths of - Nothing -> die' verbosity $ "Distribution.Client.Sandbox.tryGetIndexFilePath: " ++ - "no local repos found. " ++ checkConfiguration - Just lp -> return $ lp Index.defaultIndexFileName - where - checkConfiguration = "Please check your configuration ('" - ++ userPackageEnvironmentFile ++ "')." - --- | Try to extract a 'PackageDB' from 'ConfigFlags'. Gives a better error --- message than just pattern-matching. -getSandboxPackageDB :: Verbosity -> ConfigFlags -> IO PackageDB -getSandboxPackageDB verbosity configFlags = do - case configPackageDBs configFlags of - [Just sandboxDB@(SpecificPackageDB _)] -> return sandboxDB - -- TODO: should we allow multiple package DBs (e.g. with 'inherit')? - - [] -> - die' verbosity $ "Sandbox package DB is not specified. " ++ sandboxConfigCorrupt - [_] -> - die' verbosity $ "Unexpected contents of the 'package-db' field. " - ++ sandboxConfigCorrupt - _ -> - die' verbosity $ "Too many package DBs provided. " ++ sandboxConfigCorrupt - - where - sandboxConfigCorrupt = "Your 'cabal.sandbox.config' is probably corrupt." - - --- | Which packages are installed in the sandbox package DB? -getInstalledPackagesInSandbox :: Verbosity -> ConfigFlags - -> Compiler -> ProgramDb - -> IO InstalledPackageIndex -getInstalledPackagesInSandbox verbosity configFlags comp progdb = do - sandboxDB <- getSandboxPackageDB verbosity configFlags - getPackageDBContents verbosity comp sandboxDB progdb - --- | Temporarily add $SANDBOX_DIR/bin to $PATH. -withSandboxBinDirOnSearchPath :: FilePath -> IO a -> IO a -withSandboxBinDirOnSearchPath sandboxDir = bracket_ addBinDir rmBinDir - where - -- TODO: Instead of modifying the global process state, it'd be better to - -- set the environment individually for each subprocess invocation. This - -- will have to wait until the Shell monad is implemented; without it the - -- required changes are too intrusive. - addBinDir :: IO () - addBinDir = do - mbOldPath <- lookupEnv "PATH" - let newPath = maybe sandboxBin ((++) sandboxBin . (:) searchPathSeparator) - mbOldPath - setEnv "PATH" newPath - - rmBinDir :: IO () - rmBinDir = do - oldPath <- getSearchPath - let newPath = intercalate [searchPathSeparator] - (delete sandboxBin oldPath) - setEnv "PATH" newPath - - sandboxBin = sandboxDir "bin" - --- | Initialise a package DB for this compiler if it doesn't exist. -initPackageDBIfNeeded :: Verbosity -> ConfigFlags - -> Compiler -> ProgramDb - -> IO () -initPackageDBIfNeeded verbosity configFlags comp progdb = do - SpecificPackageDB dbPath <- getSandboxPackageDB verbosity configFlags - packageDBExists <- doesDirectoryExist dbPath - unless packageDBExists $ - Register.initPackageDB verbosity comp progdb dbPath - when packageDBExists $ - debug verbosity $ "The package database already exists: " ++ dbPath - --- | Entry point for the 'cabal sandbox dump-pkgenv' command. -dumpPackageEnvironment :: Verbosity -> SandboxFlags -> GlobalFlags -> IO () -dumpPackageEnvironment verbosity _sandboxFlags globalFlags = do - (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - commentPkgEnv <- commentPackageEnvironment sandboxDir - putStrLn . showPackageEnvironmentWithComments (Just commentPkgEnv) $ pkgEnv - --- | Entry point for the 'cabal sandbox init' command. -sandboxInit :: Verbosity -> SandboxFlags -> GlobalFlags -> IO () -sandboxInit verbosity sandboxFlags globalFlags = do - -- Warn if there's a 'cabal-dev' sandbox. - isCabalDevSandbox <- liftM2 (&&) (doesDirectoryExist "cabal-dev") - (doesFileExist $ "cabal-dev" "cabal.config") - when isCabalDevSandbox $ - warn verbosity $ - "You are apparently using a legacy (cabal-dev) sandbox. " - ++ "Legacy sandboxes may interact badly with native Cabal sandboxes. " - ++ "You may want to delete the 'cabal-dev' directory to prevent issues." - - -- Create the sandbox directory. - let sandboxDir' = fromFlagOrDefault defaultSandboxLocation - (sandboxLocation sandboxFlags) - createDirectoryIfMissingVerbose verbosity True sandboxDir' - sandboxDir <- tryCanonicalizePath sandboxDir' - setFileHidden sandboxDir - - -- Determine which compiler to use (using the value from ~/.cabal/config). - userConfig <- loadConfig verbosity (globalConfigFile globalFlags) - (comp, platform, progdb) <- configCompilerAuxEx (savedConfigureFlags userConfig) - - -- Create the package environment file. - pkgEnvFile <- getSandboxConfigFilePath globalFlags - createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile comp platform - (_sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - let config = pkgEnvSavedConfig pkgEnv - configFlags = savedConfigureFlags config - - -- Create the index file if it doesn't exist. - indexFile <- tryGetIndexFilePath verbosity config - indexFileExists <- doesFileExist indexFile - if indexFileExists - then notice verbosity $ "Using an existing sandbox located at " ++ sandboxDir - else notice verbosity $ "Creating a new sandbox at " ++ sandboxDir - Index.createEmpty verbosity indexFile - - -- Create the package DB for the default compiler. - initPackageDBIfNeeded verbosity configFlags comp progdb - maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile - (compilerId comp) platform - --- | Entry point for the 'cabal sandbox delete' command. -sandboxDelete :: Verbosity -> SandboxFlags -> GlobalFlags -> IO () -sandboxDelete verbosity _sandboxFlags globalFlags = do - (useSandbox, _) <- loadConfigOrSandboxConfig - verbosity - globalFlags { globalRequireSandbox = Flag False } - 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 - - -- Remove the sandbox directory, unless we're using a shared sandbox. - let isNonDefaultSandboxLocation = not $ equalFilePath sandboxDir $ - curDir defaultSandboxLocation - - when isNonDefaultSandboxLocation $ - die' verbosity $ "Non-default sandbox location used: '" ++ sandboxDir - ++ "'.\nAssuming a shared sandbox. Please delete '" - ++ sandboxDir ++ "' manually." - - absSandboxDir <- canonicalizePath sandboxDir - notice verbosity $ "Deleting the sandbox located at " ++ absSandboxDir - removeDirectoryRecursive absSandboxDir - - let - pathInsideSandbox = isPrefixOf absSandboxDir - - -- Warn the user if deleting the sandbox deleted a package database - -- referenced in the current environment. - checkPackagePaths var = do - let - checkPath path = do - absPath <- canonicalizePath path - (when (pathInsideSandbox absPath) . warn verbosity) - (var ++ " refers to package database " ++ path - ++ " inside the deleted sandbox.") - liftM (maybe [] splitSearchPath) (lookupEnv var) >>= mapM_ checkPath - - checkPackagePaths "CABAL_SANDBOX_PACKAGE_PATH" - checkPackagePaths "GHC_PACKAGE_PATH" - checkPackagePaths "GHCJS_PACKAGE_PATH" - --- Common implementation of 'sandboxAddSource' and 'sandboxAddSourceSnapshot'. -doAddSource :: Verbosity -> [FilePath] -> FilePath -> PackageEnvironment - -> BuildTreeRefType - -> IO () -doAddSource verbosity buildTreeRefs sandboxDir pkgEnv refType = do - let savedConfig = pkgEnvSavedConfig pkgEnv - indexFile <- tryGetIndexFilePath verbosity savedConfig - - -- If we're running 'sandbox add-source' for the first time for this compiler, - -- we need to create an initial timestamp record. - (comp, platform, _) <- configCompilerAuxEx . savedConfigureFlags $ savedConfig - maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile - (compilerId comp) platform - - withAddTimestamps verbosity sandboxDir $ do - -- Path canonicalisation is done in addBuildTreeRefs, but we do it - -- twice because of the timestamps file. - buildTreeRefs' <- mapM tryCanonicalizePath buildTreeRefs - Index.addBuildTreeRefs verbosity indexFile buildTreeRefs' refType - return buildTreeRefs' - --- | Entry point for the 'cabal sandbox add-source' command. -sandboxAddSource :: Verbosity -> [FilePath] -> SandboxFlags -> GlobalFlags - -> IO () -sandboxAddSource verbosity buildTreeRefs sandboxFlags globalFlags = do - (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - - if fromFlagOrDefault False (sandboxSnapshot sandboxFlags) - then sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv - else doAddSource verbosity buildTreeRefs sandboxDir pkgEnv LinkRef - --- | Entry point for the 'cabal sandbox add-source --snapshot' command. -sandboxAddSourceSnapshot :: Verbosity -> [FilePath] -> FilePath - -> PackageEnvironment - -> IO () -sandboxAddSourceSnapshot verbosity buildTreeRefs sandboxDir pkgEnv = do - let snapshotDir = sandboxDir snapshotDirectoryName - - -- Use 'D.S.SrcDist.prepareTree' to copy each package's files to our private - -- location. - createDirectoryIfMissingVerbose verbosity True snapshotDir - - -- Collect the package descriptions first, so that if some path does not refer - -- to a cabal package, we fail immediately. - pkgs <- forM buildTreeRefs $ \buildTreeRef -> - inDir (Just buildTreeRef) $ - return . flattenPackageDescription - =<< readGenericPackageDescription verbosity - =<< defaultPackageDesc verbosity - - -- Copy the package sources to "snapshots/$PKGNAME-$VERSION-tmp". If - -- 'prepareTree' throws an error at any point, the old snapshots will still be - -- in consistent state. - tmpDirs <- forM (zip buildTreeRefs pkgs) $ \(buildTreeRef, pkg) -> - inDir (Just buildTreeRef) $ do - let targetDir = snapshotDir (display . packageId $ pkg) - targetTmpDir = targetDir ++ "-tmp" - dirExists <- doesDirectoryExist targetTmpDir - when dirExists $ - removeDirectoryRecursive targetDir - createDirectory targetTmpDir - prepareTree verbosity pkg targetTmpDir knownSuffixHandlers - return (targetTmpDir, targetDir) - - -- Now rename the "snapshots/$PKGNAME-$VERSION-tmp" dirs to - -- "snapshots/$PKGNAME-$VERSION". - snapshots <- forM tmpDirs $ \(targetTmpDir, targetDir) -> do - dirExists <- doesDirectoryExist targetDir - when dirExists $ - removeDirectoryRecursive targetDir - renameDirectory targetTmpDir targetDir - return targetDir - - -- Once the packages are copied, just 'add-source' them as usual. - doAddSource verbosity snapshots sandboxDir pkgEnv SnapshotRef - --- | Entry point for the 'cabal sandbox delete-source' command. -sandboxDeleteSource :: Verbosity -> [FilePath] -> SandboxFlags -> GlobalFlags - -> IO () -sandboxDeleteSource verbosity buildTreeRefs _sandboxFlags globalFlags = do - (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - indexFile <- tryGetIndexFilePath verbosity (pkgEnvSavedConfig pkgEnv) - - (results, convDict) <- - Index.removeBuildTreeRefs verbosity indexFile buildTreeRefs - - let (failedPaths, removedPaths) = partitionEithers results - removedRefs = fmap convDict removedPaths - - unless (null removedPaths) $ do - removeTimestamps verbosity sandboxDir removedPaths - - notice verbosity $ "Success deleting sources: " ++ - showL removedRefs ++ "\n\n" - - unless (null failedPaths) $ do - let groupedFailures = groupBy errorType failedPaths - mapM_ handleErrors groupedFailures - die' verbosity $ "The sources with the above errors were skipped. (" ++ - showL (fmap getPath failedPaths) ++ ")" - - notice verbosity $ "Note: 'sandbox delete-source' only unregisters the " ++ - "source dependency, but does not remove the package " ++ - "from the sandbox package DB.\n\n" ++ - "Use 'sandbox hc-pkg -- unregister' to do that." - where - getPath (Index.ErrNonregisteredSource p) = p - getPath (Index.ErrNonexistentSource p) = p - - showPaths f = concat . intersperse " " . fmap (show . f) - - showL = showPaths id - - showE [] = return ' ' - showE errs = showPaths getPath errs - - errorType Index.ErrNonregisteredSource{} Index.ErrNonregisteredSource{} = - True - errorType Index.ErrNonexistentSource{} Index.ErrNonexistentSource{} = True - errorType _ _ = False - - handleErrors [] = return () - handleErrors errs@(Index.ErrNonregisteredSource{}:_) = - warn verbosity ("Sources not registered: " ++ showE errs ++ "\n\n") - handleErrors errs@(Index.ErrNonexistentSource{}:_) = - warn verbosity - ("Source directory not found for paths: " ++ showE errs ++ "\n" - ++ "If you are trying to delete a reference to a removed directory, " - ++ "please provide the full absolute path " - ++ "(as given by `sandbox list-sources`).\n\n") - --- | Entry point for the 'cabal sandbox list-sources' command. -sandboxListSources :: Verbosity -> SandboxFlags -> GlobalFlags - -> IO () -sandboxListSources verbosity _sandboxFlags globalFlags = do - (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - indexFile <- tryGetIndexFilePath verbosity (pkgEnvSavedConfig pkgEnv) - - refs <- Index.listBuildTreeRefs verbosity - Index.ListIgnored Index.LinksAndSnapshots indexFile - when (null refs) $ - notice verbosity $ "Index file '" ++ indexFile - ++ "' has no references to local build trees." - when (not . null $ refs) $ do - notice verbosity $ "Source dependencies registered " - ++ "in the current sandbox ('" ++ sandboxDir ++ "'):\n\n" - mapM_ putStrLn refs - notice verbosity $ "\nTo unregister source dependencies, " - ++ "use the 'sandbox delete-source' command." - --- | Entry point for the 'cabal sandbox hc-pkg' command. Invokes the @hc-pkg@ --- tool with provided arguments, restricted to the sandbox. -sandboxHcPkg :: Verbosity -> SandboxFlags -> GlobalFlags -> [String] -> IO () -sandboxHcPkg verbosity _sandboxFlags globalFlags extraArgs = do - (sandboxDir, pkgEnv) <- tryLoadSandboxConfig verbosity globalFlags - let configFlags = savedConfigureFlags . pkgEnvSavedConfig $ pkgEnv - -- Invoke hc-pkg for the most recently configured compiler (if any), - -- using the right package-db for the compiler (see #1935). - (comp, platform, progdb) <- getPersistOrConfigCompiler configFlags - let dir = sandboxPackageDBPath sandboxDir comp platform - dbStack = [GlobalPackageDB, SpecificPackageDB dir] - Register.invokeHcPkg verbosity comp progdb dbStack extraArgs - -updateInstallDirs :: Flag Bool - -> (UseSandbox, SavedConfig) -> (UseSandbox, SavedConfig) -updateInstallDirs userInstallFlag (useSandbox, savedConfig) = - case useSandbox of - NoSandbox -> - let savedConfig' = savedConfig { - savedConfigureFlags = configureFlags { - configInstallDirs = installDirs - } - } - in (useSandbox, savedConfig') - _ -> (useSandbox, savedConfig) +updateInstallDirs :: Flag Bool -> SavedConfig -> SavedConfig +updateInstallDirs userInstallFlag savedConfig = savedConfig + { savedConfigureFlags = configureFlags + { configInstallDirs = installDirs + } + } where configureFlags = savedConfigureFlags savedConfig userInstallDirs = savedUserInstallDirs savedConfig @@ -582,30 +71,19 @@ updateInstallDirs userInstallFlag (useSandbox, savedConfig) = loadConfigOrSandboxConfig :: Verbosity -> GlobalFlags -- ^ For @--config-file@ and -- @--sandbox-config-file@. - -> IO (UseSandbox, SavedConfig) + -> IO 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') + return config' -- Neither @cabal.sandbox.config@ nor @cabal.config@ are present. AmbientPackageEnvironment -> do @@ -615,30 +93,7 @@ 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 config' -- | Return the saved \"dist/\" prefix, or the default prefix. findSavedDistPref :: SavedConfig -> Flag FilePath -> IO FilePath @@ -648,208 +103,6 @@ findSavedDistPref config flagDistPref = do `mappend` flagDistPref findDistPref defDistPref flagDistPref' --- | If we're in a sandbox, call @withSandboxBinDirOnSearchPath@, otherwise do --- nothing. -maybeWithSandboxDirOnSearchPath :: UseSandbox -> IO a -> IO a -maybeWithSandboxDirOnSearchPath NoSandbox act = act -maybeWithSandboxDirOnSearchPath (UseSandbox sandboxDir) act = - withSandboxBinDirOnSearchPath sandboxDir $ act - --- | Had reinstallAddSourceDeps actually reinstalled any dependencies? -data WereDepsReinstalled = ReinstalledSomeDeps | NoDepsReinstalled - --- | Reinstall those add-source dependencies that have been modified since --- we've last installed them. Assumes that we're working inside a sandbox. -reinstallAddSourceDeps :: Verbosity - -> ConfigFlags -> ConfigExFlags - -> InstallFlags -> GlobalFlags - -> FilePath - -> IO WereDepsReinstalled -reinstallAddSourceDeps verbosity configFlags' configExFlags - installFlags globalFlags sandboxDir = topHandler' $ do - let sandboxDistPref = sandboxBuildDir sandboxDir - configFlags = configFlags' - { configDistPref = Flag sandboxDistPref } - haddockFlags = mempty - { haddockDistPref = Flag sandboxDistPref } - (comp, platform, progdb) <- configCompilerAux' configFlags - retVal <- newIORef NoDepsReinstalled - - withSandboxPackageInfo verbosity configFlags globalFlags - comp platform progdb sandboxDir $ \sandboxPkgInfo -> - unless (null $ modifiedAddSourceDependencies sandboxPkgInfo) $ do - - withRepoContext verbosity globalFlags $ \repoContext -> do - let args :: InstallArgs - args = ((configPackageDB' configFlags) - ,repoContext - ,comp, platform, progdb - ,UseSandbox sandboxDir, Just sandboxPkgInfo - ,globalFlags, configFlags, configExFlags, installFlags - ,haddockFlags, emptyTestFlags, emptyBenchmarkFlags) - - -- This can actually be replaced by a call to 'install', but we use a - -- lower-level API because of layer separation reasons. Additionally, we - -- might want to use some lower-level features this in the future. - withSandboxBinDirOnSearchPath sandboxDir $ do - installContext <- makeInstallContext verbosity args Nothing - installPlan <- foldProgress logMsg die'' return =<< - makeInstallPlan verbosity args installContext - - processInstallPlan verbosity args installContext installPlan - writeIORef retVal ReinstalledSomeDeps - - readIORef retVal - - where - die'' message = die' verbosity (message ++ installFailedInSandbox) - -- TODO: use a better error message, remove duplication. - installFailedInSandbox = - "Note: when using a sandbox, all packages are required to have " - ++ "consistent dependencies. Try reinstalling/unregistering the " - ++ "offending packages or recreating the sandbox." - logMsg message rest = debugNoWrap verbosity message >> rest - - topHandler' = topHandlerWith $ \_ -> do - warn verbosity "Couldn't reinstall some add-source dependencies." - -- Here we can't know whether any deps have been reinstalled, so we have - -- to be conservative. - return ReinstalledSomeDeps - --- | Produce a 'SandboxPackageInfo' and feed it to the given action. Note that --- we don't update the timestamp file here - this is done in --- 'postInstallActions'. -withSandboxPackageInfo :: Verbosity -> ConfigFlags -> GlobalFlags - -> Compiler -> Platform -> ProgramDb - -> FilePath - -> (SandboxPackageInfo -> IO ()) - -> IO () -withSandboxPackageInfo verbosity configFlags globalFlags - comp platform progdb sandboxDir cont = do - -- List all add-source deps. - indexFile <- tryGetIndexFilePath' verbosity globalFlags - buildTreeRefs <- Index.listBuildTreeRefs verbosity - Index.DontListIgnored Index.OnlyLinks indexFile - let allAddSourceDepsSet = S.fromList buildTreeRefs - - -- List all packages installed in the sandbox. - installedPkgIndex <- getInstalledPackagesInSandbox verbosity - configFlags comp progdb - let err = "Error reading sandbox package information." - -- Get the package descriptions for all add-source deps. - depsCabalFiles <- mapM (flip (tryFindAddSourcePackageDesc verbosity) err) buildTreeRefs - depsPkgDescs <- mapM (readGenericPackageDescription verbosity) depsCabalFiles - let depsMap = M.fromList (zip buildTreeRefs depsPkgDescs) - isInstalled pkgid = not . null - . InstalledPackageIndex.lookupSourcePackageId installedPkgIndex $ pkgid - installedDepsMap = M.filter (isInstalled . packageId) depsMap - - -- Get the package ids of modified (and installed) add-source deps. - modifiedAddSourceDeps <- listModifiedDeps verbosity sandboxDir - (compilerId comp) platform installedDepsMap - -- 'fromJust' here is safe because 'modifiedAddSourceDeps' are guaranteed to - -- be a subset of the keys of 'depsMap'. - let modifiedDeps = [ (modDepPath, fromJust $ M.lookup modDepPath depsMap) - | modDepPath <- modifiedAddSourceDeps ] - modifiedDepsMap = M.fromList modifiedDeps - - assert (all (`S.member` allAddSourceDepsSet) modifiedAddSourceDeps) (return ()) - if (null modifiedDeps) - then info verbosity $ "Found no modified add-source deps." - else notice verbosity $ "Some add-source dependencies have been modified. " - ++ "They will be reinstalled..." - - -- Get the package ids of the remaining add-source deps (some are possibly not - -- installed). - let otherDeps = M.assocs (depsMap `M.difference` modifiedDepsMap) - - -- Finally, assemble a 'SandboxPackageInfo'. - cont $ SandboxPackageInfo (map toSourcePackage modifiedDeps) - (map toSourcePackage otherDeps) installedPkgIndex allAddSourceDepsSet - - where - toSourcePackage (path, pkgDesc) = SourcePackage - (packageId pkgDesc) pkgDesc (LocalUnpackedPackage path) Nothing - --- | Same as 'withSandboxPackageInfo' if we're inside a sandbox and the --- identity otherwise. -maybeWithSandboxPackageInfo :: Verbosity -> ConfigFlags -> GlobalFlags - -> Compiler -> Platform -> ProgramDb - -> UseSandbox - -> (Maybe SandboxPackageInfo -> IO ()) - -> IO () -maybeWithSandboxPackageInfo verbosity configFlags globalFlags - comp platform progdb useSandbox cont = - case useSandbox of - NoSandbox -> cont Nothing - UseSandbox sandboxDir -> withSandboxPackageInfo verbosity - configFlags globalFlags - comp platform progdb sandboxDir - (\spi -> cont (Just spi)) - --- | Check if a sandbox is present and call @reinstallAddSourceDeps@ in that --- case. -maybeReinstallAddSourceDeps :: Verbosity - -> Flag (Maybe Int) -- ^ The '-j' flag - -> ConfigFlags -- ^ Saved configure flags - -- (from dist/setup-config) - -> GlobalFlags - -> (UseSandbox, SavedConfig) - -> IO WereDepsReinstalled -maybeReinstallAddSourceDeps verbosity numJobsFlag configFlags' - globalFlags' (useSandbox, config) = do - case useSandbox of - NoSandbox -> return NoDepsReinstalled - UseSandbox sandboxDir -> do - -- Reinstall the modified add-source deps. - let configFlags = savedConfigureFlags config - `mappendSomeSavedFlags` - configFlags' - configExFlags = defaultConfigExFlags - `mappend` savedConfigureExFlags config - installFlags' = defaultInstallFlags - `mappend` savedInstallFlags config - installFlags = installFlags' { - installNumJobs = installNumJobs installFlags' - `mappend` numJobsFlag - } - globalFlags = savedGlobalFlags config - -- This makes it possible to override things like 'remote-repo-cache' - -- from the command line. These options are hidden, and are only - -- useful for debugging, so this should be fine. - `mappend` globalFlags' - reinstallAddSourceDeps - verbosity configFlags configExFlags - installFlags globalFlags sandboxDir - - where - - -- NOTE: we can't simply do @sandboxConfigFlags `mappend` savedFlags@ - -- because we don't want to auto-enable things like 'library-profiling' for - -- all add-source dependencies even if the user has passed - -- '--enable-library-profiling' to 'cabal configure'. These options are - -- supposed to be set in 'cabal.config'. - mappendSomeSavedFlags :: ConfigFlags -> ConfigFlags -> ConfigFlags - mappendSomeSavedFlags sandboxConfigFlags savedFlags = - sandboxConfigFlags { - configHcFlavor = configHcFlavor sandboxConfigFlags - `mappend` configHcFlavor savedFlags, - configHcPath = configHcPath sandboxConfigFlags - `mappend` configHcPath savedFlags, - configHcPkg = configHcPkg sandboxConfigFlags - `mappend` configHcPkg savedFlags, - configProgramPaths = configProgramPaths sandboxConfigFlags - `mappend` configProgramPaths savedFlags, - configProgramArgs = configProgramArgs sandboxConfigFlags - `mappend` configProgramArgs savedFlags, - -- NOTE: Unconditionally choosing the value from - -- 'dist/setup-config'. Sandbox package DB location may have been - -- changed by 'configure -w'. - configPackageDBs = configPackageDBs savedFlags - -- FIXME: Is this compatible with the 'inherit' feature? - } - --- -- Utils (transitionary) -- diff --git a/cabal-install/Distribution/Client/Sandbox/Index.hs b/cabal-install/Distribution/Client/Sandbox/Index.hs deleted file mode 100644 index 2e264206917..00000000000 --- a/cabal-install/Distribution/Client/Sandbox/Index.hs +++ /dev/null @@ -1,285 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Client.Sandbox.Index --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- Querying and modifying local build tree references in the package index. ------------------------------------------------------------------------------ - -module Distribution.Client.Sandbox.Index ( - createEmpty, - addBuildTreeRefs, - removeBuildTreeRefs, - ListIgnoredBuildTreeRefs(..), RefTypesToList(..), - DeleteSourceError(..), - listBuildTreeRefs, - validateIndexPath, - - defaultIndexFileName - ) where - -import qualified Codec.Archive.Tar as Tar -import qualified Codec.Archive.Tar.Entry as Tar -import qualified Codec.Archive.Tar.Index as Tar -import qualified Distribution.Client.Tar as Tar -import Distribution.Client.IndexUtils ( BuildTreeRefType(..) - , refTypeFromTypeCode - , typeCodeFromRefType - , updatePackageIndexCacheFile - , readCacheStrict - , Index(..) ) -import qualified Distribution.Client.IndexUtils as IndexUtils -import Distribution.Client.Utils ( byteStringToFilePath, filePathToByteString - , makeAbsoluteToCwd, tryCanonicalizePath - , tryFindAddSourcePackageDesc ) - -import Distribution.Simple.Utils ( die', debug ) -import Distribution.Compat.Exception ( tryIO ) -import Distribution.Verbosity ( Verbosity ) - -import qualified Data.ByteString.Lazy as BS -import Control.DeepSeq ( NFData(rnf) ) -import Control.Exception ( evaluate, throw, Exception ) -import Control.Monad ( liftM, unless ) -import Control.Monad.Writer.Lazy (WriterT(..), runWriterT, tell) -import Data.List ( (\\), intersect, nub, find ) -import Data.Maybe ( catMaybes ) -import Data.Either (partitionEithers) -import System.Directory ( createDirectoryIfMissing, - doesDirectoryExist, doesFileExist, - renameFile, canonicalizePath) -import System.FilePath ( (), (<.>), takeDirectory, takeExtension ) -import System.IO ( IOMode(..), withBinaryFile ) - --- | A reference to a local build tree. -data BuildTreeRef = BuildTreeRef { - buildTreeRefType :: !BuildTreeRefType, - buildTreePath :: !FilePath - } - -instance NFData BuildTreeRef where - rnf (BuildTreeRef _ fp) = rnf fp - -defaultIndexFileName :: FilePath -defaultIndexFileName = "00-index.tar" - --- | Given a path, ensure that it refers to a local build tree. -buildTreeRefFromPath :: Verbosity -> BuildTreeRefType -> FilePath -> IO (Maybe BuildTreeRef) -buildTreeRefFromPath verbosity refType dir = do - dirExists <- doesDirectoryExist dir - unless dirExists $ - die' verbosity $ "directory '" ++ dir ++ "' does not exist" - _ <- tryFindAddSourcePackageDesc verbosity dir "Error adding source reference." - return . Just $ BuildTreeRef refType dir - --- | Given a tar archive entry, try to parse it as a local build tree reference. -readBuildTreeRef :: Tar.Entry -> Maybe BuildTreeRef -readBuildTreeRef entry = case Tar.entryContent entry of - (Tar.OtherEntryType typeCode bs size) - | (Tar.isBuildTreeRefTypeCode typeCode) - && (size == BS.length bs) -> Just $! BuildTreeRef - (refTypeFromTypeCode typeCode) - (byteStringToFilePath bs) - | otherwise -> Nothing - _ -> Nothing - --- | Given a sequence of tar archive entries, extract all references to local --- build trees. -readBuildTreeRefs :: Exception e => Tar.Entries e -> [BuildTreeRef] -readBuildTreeRefs = - catMaybes - . Tar.foldEntries (\e r -> readBuildTreeRef e : r) - [] throw - --- | Given a path to a tar archive, extract all references to local build trees. -readBuildTreeRefsFromFile :: FilePath -> IO [BuildTreeRef] -readBuildTreeRefsFromFile = liftM (readBuildTreeRefs . Tar.read) . BS.readFile - --- | Read build tree references from an index cache -readBuildTreeRefsFromCache :: Verbosity -> FilePath -> IO [BuildTreeRef] -readBuildTreeRefsFromCache verbosity indexPath = do - (mRefs, _prefs) <- readCacheStrict verbosity (SandboxIndex indexPath) buildTreeRef - return (catMaybes mRefs) - where - buildTreeRef pkgEntry = - case pkgEntry of - IndexUtils.NormalPackage _ _ _ _ -> Nothing - IndexUtils.BuildTreeRef typ _ _ path _ -> Just $ BuildTreeRef typ path - --- | Given a local build tree ref, serialise it to a tar archive entry. -writeBuildTreeRef :: BuildTreeRef -> Tar.Entry -writeBuildTreeRef (BuildTreeRef refType path) = Tar.simpleEntry tarPath content - where - bs = filePathToByteString path - -- Provide a filename for tools that treat custom entries as ordinary files. - tarPath' = "local-build-tree-reference" - -- fromRight can't fail because the path is shorter than 255 characters. - tarPath = fromRight $ Tar.toTarPath True tarPath' - content = Tar.OtherEntryType (typeCodeFromRefType refType) bs (BS.length bs) - - -- TODO: Move this to D.C.Utils? - fromRight (Left err) = error err - fromRight (Right a) = a - --- | Check that the provided path is either an existing directory, or a tar --- archive in an existing directory. -validateIndexPath :: Verbosity -> FilePath -> IO FilePath -validateIndexPath verbosity path' = do - path <- makeAbsoluteToCwd path' - if (== ".tar") . takeExtension $ path - then return path - else do dirExists <- doesDirectoryExist path - unless dirExists $ - die' verbosity $ "directory does not exist: '" ++ path ++ "'" - return $ path defaultIndexFileName - --- | Create an empty index file. -createEmpty :: Verbosity -> FilePath -> IO () -createEmpty verbosity path = do - indexExists <- doesFileExist path - if indexExists - then debug verbosity $ "Package index already exists: " ++ path - else do - debug verbosity $ "Creating the index file '" ++ path ++ "'" - createDirectoryIfMissing True (takeDirectory path) - -- Equivalent to 'tar cvf empty.tar --files-from /dev/null'. - let zeros = BS.replicate (512*20) 0 - BS.writeFile path zeros - --- | Add given local build tree references to the index. -addBuildTreeRefs :: Verbosity -> FilePath -> [FilePath] -> BuildTreeRefType - -> IO () -addBuildTreeRefs _ _ [] _ = - error "Distribution.Client.Sandbox.Index.addBuildTreeRefs: unexpected" -addBuildTreeRefs verbosity path l' refType = do - checkIndexExists verbosity path - l <- liftM nub . mapM tryCanonicalizePath $ l' - treesInIndex <- fmap (map buildTreePath) (readBuildTreeRefsFromFile path) - -- Add only those paths that aren't already in the index. - treesToAdd <- mapM (buildTreeRefFromPath verbosity refType) (l \\ treesInIndex) - let entries = map writeBuildTreeRef (catMaybes treesToAdd) - unless (null entries) $ do - withBinaryFile path ReadWriteMode $ \h -> do - block <- Tar.hSeekEndEntryOffset h Nothing - debug verbosity $ "Writing at tar block: " ++ show block - BS.hPut h (Tar.write entries) - debug verbosity $ "Successfully appended to '" ++ path ++ "'" - updatePackageIndexCacheFile verbosity $ SandboxIndex path - -data DeleteSourceError = ErrNonregisteredSource { nrPath :: FilePath } - | ErrNonexistentSource { nePath :: FilePath } deriving Show - --- | Remove given local build tree references from the index. --- --- Returns a tuple with either removed build tree refs or errors and a function --- that converts from a provided build tree ref to corresponding full directory path. -removeBuildTreeRefs :: Verbosity -> FilePath -> [FilePath] - -> IO ([Either DeleteSourceError FilePath], - (FilePath -> FilePath)) -removeBuildTreeRefs _ _ [] = - error "Distribution.Client.Sandbox.Index.removeBuildTreeRefs: unexpected" -removeBuildTreeRefs verbosity indexPath l = do - checkIndexExists verbosity indexPath - let tmpFile = indexPath <.> "tmp" - - canonRes <- mapM (\btr -> do res <- tryIO $ canonicalizePath btr - return $ case res of - Right pth -> Right (btr, pth) - Left _ -> Left $ ErrNonexistentSource btr) l - let (failures, convDict) = partitionEithers canonRes - allRefs = fmap snd convDict - - -- Performance note: on my system, it takes 'index --remove-source' - -- approx. 3,5s to filter a 65M file. Real-life indices are expected to be - -- much smaller. - removedRefs <- doRemove convDict tmpFile - - renameFile tmpFile indexPath - debug verbosity $ "Successfully renamed '" ++ tmpFile - ++ "' to '" ++ indexPath ++ "'" - - unless (null removedRefs) $ - updatePackageIndexCacheFile verbosity $ SandboxIndex indexPath - - let results = fmap Right removedRefs - ++ fmap Left failures - ++ fmap (Left . ErrNonregisteredSource) - (fmap (convertWith convDict) (allRefs \\ removedRefs)) - - return (results, convertWith convDict) - - where - doRemove :: [(FilePath, FilePath)] -> FilePath -> IO [FilePath] - doRemove srcRefs tmpFile = do - (newIdx, changedPaths) <- - Tar.read `fmap` BS.readFile indexPath - >>= runWriterT . Tar.filterEntriesM (p $ fmap snd srcRefs) - BS.writeFile tmpFile . Tar.write . Tar.entriesToList $ newIdx - return changedPaths - - p :: [FilePath] -> Tar.Entry -> WriterT [FilePath] IO Bool - p refs entry = case readBuildTreeRef entry of - Nothing -> return True - -- FIXME: removing snapshot deps is done with `delete-source - -- .cabal-sandbox/snapshots/$SNAPSHOT_NAME`. Perhaps we also want to - -- support removing snapshots by providing the original path. - (Just (BuildTreeRef _ pth)) -> if pth `elem` refs - then tell [pth] >> return False - else return True - - convertWith dict pth = maybe pth fst $ find ((==pth) . snd) dict - --- | A build tree ref can become ignored if the user later adds a build tree ref --- with the same package ID. We display ignored build tree refs when the user --- runs 'cabal sandbox list-sources', but do not look at their timestamps in --- 'reinstallAddSourceDeps'. -data ListIgnoredBuildTreeRefs = ListIgnored | DontListIgnored - --- | Which types of build tree refs should be listed? -data RefTypesToList = OnlySnapshots | OnlyLinks | LinksAndSnapshots - --- | List the local build trees that are referred to from the index. -listBuildTreeRefs :: Verbosity -> ListIgnoredBuildTreeRefs -> RefTypesToList - -> FilePath - -> IO [FilePath] -listBuildTreeRefs verbosity listIgnored refTypesToList path = do - checkIndexExists verbosity path - buildTreeRefs <- - case listIgnored of - DontListIgnored -> do - paths <- listWithoutIgnored - case refTypesToList of - LinksAndSnapshots -> return paths - _ -> do - allPathsFiltered <- fmap (map buildTreePath . filter predicate) - listWithIgnored - _ <- evaluate (length allPathsFiltered) - return (paths `intersect` allPathsFiltered) - - ListIgnored -> fmap (map buildTreePath . filter predicate) listWithIgnored - - _ <- evaluate (length buildTreeRefs) - return buildTreeRefs - - where - predicate :: BuildTreeRef -> Bool - predicate = case refTypesToList of - OnlySnapshots -> (==) SnapshotRef . buildTreeRefType - OnlyLinks -> (==) LinkRef . buildTreeRefType - LinksAndSnapshots -> const True - - listWithIgnored :: IO [BuildTreeRef] - listWithIgnored = readBuildTreeRefsFromFile path - - listWithoutIgnored :: IO [FilePath] - listWithoutIgnored = fmap (map buildTreePath) - $ readBuildTreeRefsFromCache verbosity path - - --- | Check that the package index file exists and exit with error if it does not. -checkIndexExists :: Verbosity -> FilePath -> IO () -checkIndexExists verbosity path = do - indexExists <- doesFileExist path - unless indexExists $ - die' verbosity $ "index does not exist: '" ++ path ++ "'" diff --git a/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs b/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs index 78d8f6ef15d..f8dd6b204b0 100644 --- a/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs +++ b/cabal-install/Distribution/Client/Sandbox/PackageEnvironment.hs @@ -14,66 +14,48 @@ module Distribution.Client.Sandbox.PackageEnvironment ( PackageEnvironment(..) , PackageEnvironmentType(..) , classifyPackageEnvironment - , createPackageEnvironmentFile - , tryLoadSandboxPackageEnvironmentFile , readPackageEnvironmentFile , showPackageEnvironment , showPackageEnvironmentWithComments - , setPackageDB - , sandboxPackageDBPath , loadUserConfig - , basePackageEnvironment - , initialPackageEnvironment - , commentPackageEnvironment - , sandboxPackageEnvironmentFile , userPackageEnvironmentFile ) where -import Distribution.Client.Config ( SavedConfig(..), commentSavedConfig - , loadConfig, configFieldDescriptions +import Distribution.Client.Config ( SavedConfig(..) + , configFieldDescriptions , haddockFlagsFields , installDirsFields, withProgramsFields , withProgramOptionsFields - , defaultCompiler ) + ) import Distribution.Client.ParseUtils ( parseFields, ppFields, ppSection ) -import Distribution.Client.Setup ( GlobalFlags(..), ConfigExFlags(..) - , InstallFlags(..) - , defaultSandboxLocation ) +import Distribution.Client.Setup ( ConfigExFlags(..) + ) import Distribution.Client.Targets ( userConstraintPackageName ) -import Distribution.Utils.NubList ( toNubList ) -import Distribution.Simple.Compiler ( Compiler, PackageDB(..) - , compilerFlavor, showCompilerIdWithAbi ) -import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate - , defaultInstallDirs, combineInstallDirs - , fromPathTemplate, toPathTemplate ) +import Distribution.Simple.InstallDirs ( InstallDirs(..), PathTemplate ) import Distribution.Simple.Setup ( Flag(..) , ConfigFlags(..), HaddockFlags(..) - , fromFlagOrDefault, toFlag, flagToMaybe ) -import Distribution.Simple.Utils ( die', info, notice, warn, debug ) + ) +import Distribution.Simple.Utils ( 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 Distribution.Verbosity ( Verbosity ) +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 -import System.Directory ( doesDirectoryExist, doesFileExist - , renameFile ) -import System.FilePath ( (<.>), (), takeDirectory ) +import System.Directory ( doesFileExist ) +import System.FilePath ( () ) 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 +68,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,181 +78,28 @@ 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 - --- | Defaults common to 'initialPackageEnvironment' and --- 'commentPackageEnvironment'. -commonPackageEnvironmentConfig :: FilePath -> SavedConfig -commonPackageEnvironmentConfig sandboxDir = - mempty { - savedConfigureFlags = mempty { - -- TODO: Currently, we follow cabal-dev and set 'user-install: False' in - -- the config file. In the future we may want to distinguish between - -- global, sandbox and user install types. - configUserInstall = toFlag False, - configInstallDirs = installDirs - }, - savedUserInstallDirs = installDirs, - savedGlobalInstallDirs = installDirs, - savedGlobalFlags = mempty { - globalLogsDir = toFlag $ sandboxDir "logs", - -- Is this right? cabal-dev uses the global world file. - globalWorldFile = toFlag $ sandboxDir "world" - } - } - where - installDirs = sandboxInstallDirs sandboxDir - --- | 'commonPackageEnvironmentConfig' wrapped inside a 'PackageEnvironment'. -commonPackageEnvironment :: FilePath -> PackageEnvironment -commonPackageEnvironment sandboxDir = mempty { - pkgEnvSavedConfig = commonPackageEnvironmentConfig sandboxDir - } - --- | Given a path to a sandbox, return the corresponding InstallDirs record. -sandboxInstallDirs :: FilePath -> InstallDirs (Flag PathTemplate) -sandboxInstallDirs sandboxDir = mempty { - prefix = toFlag (toPathTemplate sandboxDir) - } - --- | These are the absolute basic defaults, the fields that must be --- initialised. When we load the package environment from the file we layer the --- loaded values over these ones. -basePackageEnvironment :: PackageEnvironment -basePackageEnvironment = - mempty { - pkgEnvSavedConfig = mempty { - savedConfigureFlags = mempty { - configHcFlavor = toFlag defaultCompiler, - configVerbosity = toFlag normal - } - } - } - --- | Initial configuration that we write out to the package environment file if --- it does not exist. When the package environment gets loaded this --- configuration gets layered on top of 'basePackageEnvironment'. -initialPackageEnvironment :: FilePath -> Compiler -> Platform - -> IO PackageEnvironment -initialPackageEnvironment sandboxDir compiler platform = do - defInstallDirs <- defaultInstallDirs (compilerFlavor compiler) - {- userInstall= -} False {- _hasLibs= -} False - let initialConfig = commonPackageEnvironmentConfig sandboxDir - installDirs = combineInstallDirs (\d f -> Flag $ fromFlagOrDefault d f) - defInstallDirs (savedUserInstallDirs initialConfig) - return $ mempty { - pkgEnvSavedConfig = initialConfig { - savedUserInstallDirs = installDirs, - savedGlobalInstallDirs = installDirs, - savedGlobalFlags = (savedGlobalFlags initialConfig) { - globalLocalRepos = toNubList [sandboxDir "packages"] - }, - savedConfigureFlags = setPackageDB sandboxDir compiler platform - (savedConfigureFlags initialConfig), - savedInstallFlags = (savedInstallFlags initialConfig) { - installSummaryFile = toNubList [toPathTemplate (sandboxDir - "logs" "build.log")] - } - } - } - --- | Return the path to the sandbox package database. -sandboxPackageDBPath :: FilePath -> Compiler -> Platform -> String -sandboxPackageDBPath sandboxDir compiler platform = - sandboxDir - (Text.display platform ++ "-" - ++ showCompilerIdWithAbi compiler - ++ "-packages.conf.d") --- The path in sandboxPackageDBPath should be kept in sync with the --- path in the bootstrap.sh which is used to bootstrap cabal-install --- into a sandbox. - --- | Use the package DB location specific for this compiler. -setPackageDB :: FilePath -> Compiler -> Platform -> ConfigFlags -> ConfigFlags -setPackageDB sandboxDir compiler platform configFlags = - configFlags { - configPackageDBs = [Just (SpecificPackageDB $ sandboxPackageDBPath - sandboxDir - compiler - platform)] - } --- | Almost the same as 'savedConf `mappend` pkgEnv', but some settings are --- overridden instead of mappend'ed. -overrideSandboxSettings :: PackageEnvironment -> PackageEnvironment -> - PackageEnvironment -overrideSandboxSettings pkgEnv0 pkgEnv = - pkgEnv { - pkgEnvSavedConfig = mappendedConf { - savedConfigureFlags = (savedConfigureFlags mappendedConf) { - configPackageDBs = configPackageDBs pkgEnvConfigureFlags - } - , savedInstallFlags = (savedInstallFlags mappendedConf) { - installSummaryFile = installSummaryFile pkgEnvInstallFlags - } - }, - pkgEnvInherit = pkgEnvInherit pkgEnv0 - } - where - pkgEnvConf = pkgEnvSavedConfig pkgEnv - mappendedConf = (pkgEnvSavedConfig pkgEnv0) `mappend` pkgEnvConf - pkgEnvConfigureFlags = savedConfigureFlags pkgEnvConf - pkgEnvInstallFlags = savedInstallFlags pkgEnvConf - --- | Default values that get used if no value is given. Used here to include in --- comments when we write out the initial package environment. -commentPackageEnvironment :: FilePath -> IO PackageEnvironment -commentPackageEnvironment sandboxDir = do - commentConf <- commentSavedConfig - let baseConf = commonPackageEnvironmentConfig sandboxDir - return $ mempty { - pkgEnvSavedConfig = commentConf `mappend` baseConf - } + classify :: Bool -> PackageEnvironmentType + classify True = UserPackageEnvironment + classify False = AmbientPackageEnvironment --- | 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. @@ -312,105 +138,12 @@ loadUserConfig verbosity pkgEnvDir globalConfigLocation = fmap pkgEnvSavedConfig $ userPackageEnvironment verbosity pkgEnvDir globalConfigLocation --- | Common error handling code used by 'tryLoadSandboxPackageEnvironment' and --- 'updatePackageEnvironment'. -handleParseResult :: Verbosity -> FilePath - -> Maybe (ParseResult PackageEnvironment) - -> IO PackageEnvironment -handleParseResult verbosity path minp = - case minp of - Nothing -> die' verbosity $ - "The package environment file '" ++ path ++ "' doesn't exist" - Just (ParseOk warns parseResult) -> do - unless (null warns) $ warn verbosity $ - unlines (map (showPWarning path) warns) - return parseResult - Just (ParseFailed err) -> do - let (line, msg) = locatedErrorMsg err - die' verbosity $ "Error parsing package environment file " ++ path - ++ maybe "" (\n -> ":" ++ show n) line ++ ":\n" ++ msg --- | Try to load the given package environment file, exiting with error if it --- doesn't exist. Also returns the path to the sandbox directory. The path --- parameter should refer to an existing file. -tryLoadSandboxPackageEnvironmentFile :: Verbosity -> FilePath -> (Flag FilePath) - -> IO (FilePath, PackageEnvironment) -tryLoadSandboxPackageEnvironmentFile verbosity pkgEnvFile configFileFlag = do - let pkgEnvDir = takeDirectory pkgEnvFile - minp <- readPackageEnvironmentFile - (ConstraintSourceSandboxConfig pkgEnvFile) mempty pkgEnvFile - pkgEnv <- handleParseResult verbosity pkgEnvFile minp - - -- Get the saved sandbox directory. - -- TODO: Use substPathTemplate with - -- compilerTemplateEnv ++ platformTemplateEnv ++ abiTemplateEnv. - let sandboxDir = fromFlagOrDefault defaultSandboxLocation - . fmap fromPathTemplate . prefix . savedUserInstallDirs - . pkgEnvSavedConfig $ pkgEnv - - -- Do some sanity checks - dirExists <- doesDirectoryExist sandboxDir - -- TODO: Also check for an initialised package DB? - unless dirExists $ - die' verbosity ("No sandbox exists at " ++ sandboxDir) - info verbosity $ "Using a sandbox located at " ++ sandboxDir - - 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) - `overrideSandboxSettings` pkgEnv) - where - toPkgEnv config = mempty { pkgEnvSavedConfig = config } - - updateInstallDirs pkgEnv = - let config = pkgEnvSavedConfig pkgEnv - configureFlags = savedConfigureFlags config - installDirs = savedUserInstallDirs config - in pkgEnv { - pkgEnvSavedConfig = config { - savedConfigureFlags = configureFlags { - configInstallDirs = installDirs - } - } - } - - -- We don't want to inherit the value of 'symlink-bindir' from - -- '~/.cabal/config'. See #1514. - unsetSymlinkBinDir config = - let installFlags = savedInstallFlags config - in config { - savedInstallFlags = installFlags { - installSymlinkBinDir = NoFlag - } - } - --- | Create a new package environment file, replacing the existing one if it --- exists. Note that the path parameters should point to existing directories. -createPackageEnvironmentFile :: Verbosity -> FilePath -> FilePath - -> Compiler - -> Platform - -> IO () -createPackageEnvironmentFile verbosity sandboxDir pkgEnvFile compiler platform = do - notice verbosity $ "Writing a default package environment file to " ++ pkgEnvFile - initialPkgEnv <- initialPackageEnvironment sandboxDir compiler platform - writePackageEnvironmentFile pkgEnvFile initialPkgEnv -- | 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 +158,6 @@ pkgEnvFieldDescrs src = [ ] ++ map toPkgEnv configFieldDescriptions' where - optional = Parse.option mempty . fmap toFlag - configFieldDescriptions' :: [FieldDescr SavedConfig] configFieldDescriptions' = filter (\(FieldDescr name _ _) -> name /= "preference" && name /= "constraint") @@ -538,21 +269,7 @@ parsePackageEnvironment src initial str = do type SectionsAccum = (HaddockFlags, InstallDirs (Flag PathTemplate) , [(String, FilePath)], [(String, [String])]) --- | Write out the package environment file. -writePackageEnvironmentFile :: FilePath -> PackageEnvironment -> IO () -writePackageEnvironmentFile path pkgEnv = do - let tmpPath = (path <.> "tmp") - writeFile tmpPath $ explanation ++ pkgEnvStr ++ "\n" - renameFile tmpPath path - where - pkgEnvStr = showPackageEnvironment pkgEnv - explanation = unlines - ["-- This is a Cabal package environment file." - ,"-- THIS FILE IS AUTO-GENERATED. DO NOT EDIT DIRECTLY." - ,"-- Please create a 'cabal.config' file in the same directory" - ,"-- if you want to change the default settings for this sandbox." - ,"","" - ] + -- | Pretty-print the package environment. showPackageEnvironment :: PackageEnvironment -> String diff --git a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/Distribution/Client/Sandbox/Timestamp.hs deleted file mode 100644 index 48e4ca01b39..00000000000 --- a/cabal-install/Distribution/Client/Sandbox/Timestamp.hs +++ /dev/null @@ -1,272 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Client.Sandbox.Timestamp --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- Timestamp file handling (for add-source dependencies). ------------------------------------------------------------------------------ - -module Distribution.Client.Sandbox.Timestamp ( - AddSourceTimestamp, - withAddTimestamps, - withUpdateTimestamps, - maybeAddCompilerTimestampRecord, - listModifiedDeps, - removeTimestamps, - - -- * For testing - TimestampFileRecord, - readTimestampFile, - writeTimestampFile - ) where - -import Control.Monad (filterM, forM, when) -import Data.Char (isSpace) -import Data.List (partition) -import System.Directory (renameFile) -import System.FilePath ((<.>), ()) -import qualified Data.Map as M - -import Distribution.Compiler (CompilerId) -import Distribution.Simple.Utils (debug, die', warn) -import Distribution.System (Platform) -import Distribution.Deprecated.Text (display) -import Distribution.Verbosity (Verbosity) - -import Distribution.Client.SrcDist (allPackageSourceFiles) -import Distribution.Client.Sandbox.Index - (ListIgnoredBuildTreeRefs (ListIgnored), RefTypesToList(OnlyLinks) - ,listBuildTreeRefs) - -import Distribution.Compat.Exception (catchIO) -import Distribution.Compat.Time (ModTime, getCurTime, - getModTime, - posixSecondsToModTime) - - --- | Timestamp of an add-source dependency. -type AddSourceTimestamp = (FilePath, ModTime) --- | Timestamp file record - a string identifying the compiler & platform plus a --- list of add-source timestamps. -type TimestampFileRecord = (String, [AddSourceTimestamp]) - -timestampRecordKey :: CompilerId -> Platform -> String -timestampRecordKey compId platform = display platform ++ "-" ++ display compId - --- | The 'add-source-timestamps' file keeps the timestamps of all add-source --- dependencies. It is initially populated by 'sandbox add-source' and kept --- current by 'reinstallAddSourceDeps' and 'configure -w'. The user can install --- add-source deps manually with 'cabal install' after having edited them, so we --- can err on the side of caution sometimes. --- FIXME: We should keep this info in the index file, together with build tree --- refs. -timestampFileName :: FilePath -timestampFileName = "add-source-timestamps" - --- | Read the timestamp file. Exits with error if the timestamp file is --- corrupted. Returns an empty list if the file doesn't exist. -readTimestampFile :: Verbosity -> FilePath -> IO [TimestampFileRecord] -readTimestampFile verbosity timestampFile = do - timestampString <- readFile timestampFile `catchIO` \_ -> return "[]" - case reads timestampString of - [(version, s)] - | version == (2::Int) -> - case reads s of - [(timestamps, s')] | all isSpace s' -> return timestamps - _ -> dieCorrupted - | otherwise -> dieWrongFormat - - -- Old format (timestamps are POSIX seconds). Convert to new format. - [] -> - case reads timestampString of - [(timestamps, s)] | all isSpace s -> do - let timestamps' = map (\(i, ts) -> - (i, map (\(p, t) -> - (p, posixSecondsToModTime t)) ts)) - timestamps - writeTimestampFile timestampFile timestamps' - return timestamps' - _ -> dieCorrupted - _ -> dieCorrupted - where - dieWrongFormat = die' verbosity $ wrongFormat ++ deleteAndRecreate - dieCorrupted = die' verbosity $ corrupted ++ deleteAndRecreate - wrongFormat = "The timestamps file is in the wrong format." - corrupted = "The timestamps file is corrupted." - deleteAndRecreate = " Please delete and recreate the sandbox." - --- | Write the timestamp file, atomically. -writeTimestampFile :: FilePath -> [TimestampFileRecord] -> IO () -writeTimestampFile timestampFile timestamps = do - writeFile timestampTmpFile "2\n" -- version - appendFile timestampTmpFile (show timestamps ++ "\n") - renameFile timestampTmpFile timestampFile - where - timestampTmpFile = timestampFile <.> "tmp" - --- | Read, process and write the timestamp file in one go. -withTimestampFile :: Verbosity -> FilePath - -> ([TimestampFileRecord] -> IO [TimestampFileRecord]) - -> IO () -withTimestampFile verbosity sandboxDir process = do - let timestampFile = sandboxDir timestampFileName - timestampRecords <- readTimestampFile verbosity timestampFile >>= process - writeTimestampFile timestampFile timestampRecords - --- | Given a list of 'AddSourceTimestamp's, a list of paths to add-source deps --- we've added and an initial timestamp, add an 'AddSourceTimestamp' to the list --- for each path. If a timestamp for a given path already exists in the list, --- update it. -addTimestamps :: ModTime -> [AddSourceTimestamp] -> [FilePath] - -> [AddSourceTimestamp] -addTimestamps initial timestamps newPaths = - [ (p, initial) | p <- newPaths ] ++ oldTimestamps - where - (oldTimestamps, _toBeUpdated) = - partition (\(path, _) -> path `notElem` newPaths) timestamps - --- | Given a list of 'AddSourceTimestamp's, a list of paths to add-source deps --- we've reinstalled and a new timestamp value, update the timestamp value for --- the deps in the list. If there are new paths in the list, ignore them. -updateTimestamps :: [AddSourceTimestamp] -> [FilePath] -> ModTime - -> [AddSourceTimestamp] -updateTimestamps timestamps pathsToUpdate newTimestamp = - foldr updateTimestamp [] timestamps - where - updateTimestamp t@(path, _oldTimestamp) rest - | path `elem` pathsToUpdate = (path, newTimestamp) : rest - | otherwise = t : rest - --- | Given a list of 'TimestampFileRecord's and a list of paths to add-source --- deps we've removed, remove those deps from the list. -removeTimestamps' :: [AddSourceTimestamp] -> [FilePath] -> [AddSourceTimestamp] -removeTimestamps' l pathsToRemove = foldr removeTimestamp [] l - where - removeTimestamp t@(path, _oldTimestamp) rest = - if path `elem` pathsToRemove - then rest - else t : rest - --- | If a timestamp record for this compiler doesn't exist, add a new one. -maybeAddCompilerTimestampRecord :: Verbosity -> FilePath -> FilePath - -> CompilerId -> Platform - -> IO () -maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile - compId platform = do - let key = timestampRecordKey compId platform - withTimestampFile verbosity sandboxDir $ \timestampRecords -> do - case lookup key timestampRecords of - Just _ -> return timestampRecords - Nothing -> do - buildTreeRefs <- listBuildTreeRefs verbosity ListIgnored OnlyLinks - indexFile - now <- getCurTime - let timestamps = map (\p -> (p, now)) buildTreeRefs - return $ (key, timestamps):timestampRecords - --- | Given an IO action that returns a list of build tree refs, add those --- build tree refs to the timestamps file (for all compilers). -withAddTimestamps :: Verbosity -> FilePath -> IO [FilePath] -> IO () -withAddTimestamps verbosity sandboxDir act = do - let initialTimestamp = minBound - withActionOnAllTimestamps (addTimestamps initialTimestamp) verbosity sandboxDir act - --- | Given a list of build tree refs, remove those --- build tree refs from the timestamps file (for all compilers). -removeTimestamps :: Verbosity -> FilePath -> [FilePath] -> IO () -removeTimestamps verbosity idxFile = - withActionOnAllTimestamps removeTimestamps' verbosity idxFile . return - --- | Given an IO action that returns a list of build tree refs, update the --- timestamps of the returned build tree refs to the current time (only for the --- given compiler & platform). -withUpdateTimestamps :: Verbosity -> FilePath -> CompilerId -> Platform - ->([AddSourceTimestamp] -> IO [FilePath]) - -> IO () -withUpdateTimestamps = - withActionOnCompilerTimestamps updateTimestamps - --- | Helper for implementing 'withAddTimestamps' and --- 'withRemoveTimestamps'. Runs a given action on the list of --- 'AddSourceTimestamp's for all compilers, applies 'f' to the result and then --- updates the timestamp file. The IO action is run only once. -withActionOnAllTimestamps :: ([AddSourceTimestamp] -> [FilePath] - -> [AddSourceTimestamp]) - -> Verbosity - -> FilePath - -> IO [FilePath] - -> IO () -withActionOnAllTimestamps f verbosity sandboxDir act = - withTimestampFile verbosity sandboxDir $ \timestampRecords -> do - paths <- act - return [(key, f timestamps paths) | (key, timestamps) <- timestampRecords] - --- | Helper for implementing 'withUpdateTimestamps'. Runs a given action on the --- list of 'AddSourceTimestamp's for this compiler, applies 'f' to the result --- and then updates the timestamp file record. The IO action is run only once. -withActionOnCompilerTimestamps :: ([AddSourceTimestamp] - -> [FilePath] -> ModTime - -> [AddSourceTimestamp]) - -> Verbosity - -> FilePath - -> CompilerId - -> Platform - -> ([AddSourceTimestamp] -> IO [FilePath]) - -> IO () -withActionOnCompilerTimestamps f verbosity sandboxDir compId platform act = do - let needle = timestampRecordKey compId platform - withTimestampFile verbosity sandboxDir $ \timestampRecords -> do - timestampRecords' <- forM timestampRecords $ \r@(key, timestamps) -> - if key == needle - then do paths <- act timestamps - now <- getCurTime - return (key, f timestamps paths now) - else return r - return timestampRecords' - --- | Has this dependency been modified since we have last looked at it? -isDepModified :: Verbosity -> ModTime -> AddSourceTimestamp -> IO Bool -isDepModified verbosity now (packageDir, timestamp) = do - debug verbosity ("Checking whether the dependency is modified: " ++ packageDir) - -- TODO: we should properly plumb the correct options through - -- instead of using defaultSetupScriptOptions - depSources <- allPackageSourceFiles verbosity packageDir - go depSources - - where - go [] = return False - go (dep0:rest) = do - -- FIXME: What if the clock jumps backwards at any point? For now we only - -- print a warning. - let dep = packageDir dep0 - modTime <- getModTime dep - when (modTime > now) $ - warn verbosity $ "File '" ++ dep - ++ "' has a modification time that is in the future." - if modTime >= timestamp - then do - debug verbosity ("Dependency has a modified source file: " ++ dep) - return True - else go rest - --- | List all modified dependencies. -listModifiedDeps :: Verbosity -> FilePath -> CompilerId -> Platform - -> M.Map FilePath a - -- ^ The set of all installed add-source deps. - -> IO [FilePath] -listModifiedDeps verbosity sandboxDir compId platform installedDepsMap = do - timestampRecords <- readTimestampFile verbosity (sandboxDir timestampFileName) - let needle = timestampRecordKey compId platform - timestamps <- maybe noTimestampRecord return - (lookup needle timestampRecords) - now <- getCurTime - fmap (map fst) . filterM (isDepModified verbosity now) - . filter (\ts -> fst ts `M.member` installedDepsMap) - $ timestamps - - where - noTimestampRecord = die' verbosity $ "Сouldn't find a timestamp record for the given " - ++ "compiler/platform pair. " - ++ "Please report this on the Cabal bug tracker: " - ++ "https://github.com/haskell/cabal/issues/new ." diff --git a/cabal-install/Distribution/Client/Sandbox/Types.hs b/cabal-install/Distribution/Client/Sandbox/Types.hs deleted file mode 100644 index 65871a6e94a..00000000000 --- a/cabal-install/Distribution/Client/Sandbox/Types.hs +++ /dev/null @@ -1,65 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Distribution.Client.Sandbox.Types --- Maintainer : cabal-devel@haskell.org --- Portability : portable --- --- Helpers for writing code that works both inside and outside a sandbox. ------------------------------------------------------------------------------ - -module Distribution.Client.Sandbox.Types ( - UseSandbox(..), isUseSandbox, whenUsingSandbox, - SandboxPackageInfo(..) - ) where - -import Prelude () -import Distribution.Client.Compat.Prelude - -import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex -import Distribution.Client.Types (UnresolvedSourcePackage) - -import qualified Data.Set as S - --- | Are we using a sandbox? -data UseSandbox = UseSandbox FilePath | NoSandbox - -instance Monoid UseSandbox where - mempty = NoSandbox - mappend = (<>) - -instance Semigroup UseSandbox where - NoSandbox <> s = s - u0@(UseSandbox _) <> NoSandbox = u0 - (UseSandbox _) <> u1@(UseSandbox _) = u1 - --- | Convert a @UseSandbox@ value to a boolean. Useful in conjunction with --- @when@. -isUseSandbox :: UseSandbox -> Bool -isUseSandbox (UseSandbox _) = True -isUseSandbox NoSandbox = False - --- | Execute an action only if we're in a sandbox, feeding to it the path to the --- sandbox directory. -whenUsingSandbox :: UseSandbox -> (FilePath -> IO ()) -> IO () -whenUsingSandbox NoSandbox _ = return () -whenUsingSandbox (UseSandbox sandboxDir) act = act sandboxDir - --- | Data about the packages installed in the sandbox that is passed from --- 'reinstallAddSourceDeps' to the solver. -data SandboxPackageInfo = SandboxPackageInfo { - modifiedAddSourceDependencies :: ![UnresolvedSourcePackage], - -- ^ Modified add-source deps that we want to reinstall. These are guaranteed - -- to be already installed in the sandbox. - - otherAddSourceDependencies :: ![UnresolvedSourcePackage], - -- ^ Remaining add-source deps. Some of these may be not installed in the - -- sandbox. - - otherInstalledSandboxPackages :: !InstalledPackageIndex.InstalledPackageIndex, - -- ^ All packages installed in the sandbox. Intersection with - -- 'modifiedAddSourceDependencies' and/or 'otherAddSourceDependencies' can be - -- non-empty. - - allAddSourceDependencies :: !(S.Set FilePath) - -- ^ A set of paths to all add-source dependencies, for convenience. - } diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index 69cdd703f93..46129a42a9d 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -21,7 +21,7 @@ module Distribution.Client.Setup , configureCommand, ConfigFlags(..), configureOptions, filterConfigureFlags , configPackageDB', configCompilerAux' , configureExCommand, ConfigExFlags(..), defaultConfigExFlags - , buildCommand, BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) + , buildCommand, BuildFlags(..) , filterTestFlags , replCommand, testCommand, benchmarkCommand, testOptions, benchmarkOptions , configureExOptions, reconfigureCommand @@ -42,9 +42,7 @@ module Distribution.Client.Setup , reportCommand, ReportFlags(..) , runCommand , initCommand, initOptions, IT.InitFlags(..) - , sdistCommand, SDistFlags(..) , actAsSetupCommand, ActAsSetupFlags(..) - , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) , execCommand, ExecFlags(..), defaultExecFlags , userConfigCommand, UserConfigFlags(..) , manpageCommand @@ -97,7 +95,7 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.Simple.Setup ( ConfigFlags(..), BuildFlags(..), ReplFlags , TestFlags, BenchmarkFlags - , SDistFlags(..), HaddockFlags(..) + , HaddockFlags(..) , CleanFlags(..), DoctestFlags(..) , CopyFlags(..), RegisterFlags(..) , readPackageDbList, showPackageDbList @@ -133,7 +131,7 @@ import Distribution.Deprecated.ParseUtils import Distribution.Verbosity ( Verbosity, lessVerbose, normal, verboseNoFlags, verboseNoTimestamp ) import Distribution.Simple.Utils - ( wrapText, wrapLine ) + ( wrapText ) import Distribution.Client.GlobalFlags ( GlobalFlags(..), defaultGlobalFlags , RepoContext(..), withRepoContext @@ -224,7 +222,6 @@ globalCommand commands = CommandUI { , "v1-copy" , "v1-register" , "v1-reconfigure" - , "v1-sandbox" -- v2 commands, nix-style , "v2-build" , "v2-configure" @@ -333,7 +330,6 @@ globalCommand commands = CommandUI { , addCmd "v1-copy" , addCmd "v1-register" , addCmd "v1-reconfigure" - , addCmd "v1-sandbox" ] ++ if null otherCmds then [] else par :startGroup "other" :[addCmd n | n <- otherCmds]) @@ -374,26 +370,11 @@ globalCommand commands = CommandUI { globalConfigFile (\v flags -> flags { globalConfigFile = v }) (reqArgFlag "FILE") - ,option [] ["sandbox-config-file"] - "Set an alternate location for the sandbox config file (default: './cabal.sandbox.config')" - globalSandboxConfigFile (\v flags -> flags { globalSandboxConfigFile = v }) - (reqArgFlag "FILE") - ,option [] ["default-user-config"] "Set a location for a cabal.config file for projects without their own cabal.config freeze file." globalConstraintsFile (\v flags -> flags {globalConstraintsFile = v}) (reqArgFlag "FILE") - ,option [] ["require-sandbox"] - "requiring the presence of a sandbox for sandbox-aware commands" - 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 [] ["ignore-expiry"] "Ignore expiry dates on signed metadata (use only in exceptional circumstances)" globalIgnoreExpiry (\v flags -> flags { globalIgnoreExpiry = v }) @@ -777,39 +758,18 @@ reconfigureCommand -- * Build flags -- ------------------------------------------------------------ -data SkipAddSourceDepsCheck = - SkipAddSourceDepsCheck | DontSkipAddSourceDepsCheck - deriving Eq - -data BuildExFlags = BuildExFlags { - buildOnly :: Flag SkipAddSourceDepsCheck -} deriving Generic - -buildExOptions :: ShowOrParseArgs -> [OptionField BuildExFlags] -buildExOptions _showOrParseArgs = - option [] ["only"] - "Don't reinstall add-source dependencies (sandbox-only)" - buildOnly (\v flags -> flags { buildOnly = v }) - (noArg (Flag SkipAddSourceDepsCheck)) - - : [] - -buildCommand :: CommandUI (BuildFlags, BuildExFlags) +buildCommand :: CommandUI BuildFlags buildCommand = parent { commandName = "build", commandDescription = Just $ \_ -> wrapText $ "Components encompass executables, tests, and benchmarks.\n" ++ "\n" ++ "Affected by configuration options, see `v1-configure`.\n", - commandDefaultFlags = (commandDefaultFlags parent, mempty), + commandDefaultFlags = commandDefaultFlags parent, commandUsage = usageAlternatives "v1-build" $ [ "[FLAGS]", "COMPONENTS [FLAGS]" ], - commandOptions = - \showOrParseArgs -> liftOptions fst setFst - (commandOptions parent showOrParseArgs) - ++ - liftOptions snd setSnd (buildExOptions showOrParseArgs) - , commandNotes = Just $ \pname -> + commandOptions = commandOptions parent + , commandNotes = Just $ \pname -> "Examples:\n" ++ " " ++ pname ++ " v1-build " ++ " All the components in the package\n" @@ -818,18 +778,8 @@ buildCommand = parent { ++ Cabal.programFlagsDescription defaultProgramDb } where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - parent = Cabal.buildCommand defaultProgramDb -instance Monoid BuildExFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup BuildExFlags where - (<>) = gmappend - -- ------------------------------------------------------------ -- * Test flags -- ------------------------------------------------------------ @@ -865,13 +815,12 @@ filterTestFlags flags cabalLibVersion -- * Repl command -- ------------------------------------------------------------ -replCommand :: CommandUI (ReplFlags, BuildExFlags) +replCommand :: CommandUI ReplFlags replCommand = parent { commandName = "repl", commandDescription = Just $ \pname -> wrapText $ "If the current directory contains no package, ignores COMPONENT " - ++ "parameters and opens an interactive interpreter session; if a " - ++ "sandbox is present, its package database will be used.\n" + ++ "parameters and opens an interactive interpreter session;\n" ++ "\n" ++ "Otherwise, (re)configures with the given or default flags, and " ++ "loads the interpreter with the relevant modules. For executables, " @@ -887,12 +836,8 @@ replCommand = parent { ++ "not (re)configure and you will have to specify the location of " ++ "other modules, if required.\n", commandUsage = \pname -> "Usage: " ++ pname ++ " v1-repl [COMPONENT] [FLAGS]\n", - commandDefaultFlags = (commandDefaultFlags parent, mempty), - commandOptions = - \showOrParseArgs -> liftOptions fst setFst - (commandOptions parent showOrParseArgs) - ++ - liftOptions snd setSnd (buildExOptions showOrParseArgs), + commandDefaultFlags = commandDefaultFlags parent, + commandOptions = commandOptions parent, commandNotes = Just $ \pname -> "Examples:\n" ++ " " ++ pname ++ " v1-repl " @@ -903,16 +848,13 @@ replCommand = parent { ++ " Specifying flags for interpreter\n" } where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - parent = Cabal.replCommand defaultProgramDb -- ------------------------------------------------------------ -- * Test command -- ------------------------------------------------------------ -testCommand :: CommandUI (TestFlags, BuildFlags, BuildExFlags) +testCommand :: CommandUI (BuildFlags, TestFlags) testCommand = parent { commandName = "test", commandDescription = Just $ \pname -> wrapText $ @@ -927,21 +869,17 @@ testCommand = parent { ++ " define actions to be executed before and after running tests.\n", commandUsage = usageAlternatives "v1-test" [ "[FLAGS]", "TESTCOMPONENTS [FLAGS]" ], - commandDefaultFlags = (commandDefaultFlags parent, - Cabal.defaultBuildFlags, mempty), + commandDefaultFlags = (Cabal.defaultBuildFlags, commandDefaultFlags parent), commandOptions = \showOrParseArgs -> liftOptions get1 set1 - (commandOptions parent showOrParseArgs) - ++ - liftOptions get2 set2 (Cabal.buildOptions progDb showOrParseArgs) ++ - liftOptions get3 set3 (buildExOptions showOrParseArgs) + liftOptions get2 set2 + (commandOptions parent showOrParseArgs) } where - get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c) - get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c) - get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c) + get1 (a,_) = a; set1 a (_,b) = (a,b) + get2 (_,b) = b; set2 b (a,_) = (a,b) parent = Cabal.testCommand progDb = defaultProgramDb @@ -950,7 +888,7 @@ testCommand = parent { -- * Bench command -- ------------------------------------------------------------ -benchmarkCommand :: CommandUI (BenchmarkFlags, BuildFlags, BuildExFlags) +benchmarkCommand :: CommandUI (BuildFlags, BenchmarkFlags) benchmarkCommand = parent { commandName = "bench", commandUsage = usageAlternatives "v1-bench" @@ -966,21 +904,17 @@ benchmarkCommand = parent { ++ "By defining UserHooks in a custom Setup.hs, the package can" ++ " define actions to be executed before and after running" ++ " benchmarks.\n", - commandDefaultFlags = (commandDefaultFlags parent, - Cabal.defaultBuildFlags, mempty), + commandDefaultFlags = (Cabal.defaultBuildFlags, commandDefaultFlags parent), commandOptions = \showOrParseArgs -> liftOptions get1 set1 - (commandOptions parent showOrParseArgs) - ++ - liftOptions get2 set2 (Cabal.buildOptions progDb showOrParseArgs) ++ - liftOptions get3 set3 (buildExOptions showOrParseArgs) + liftOptions get2 set2 + (commandOptions parent showOrParseArgs) } where - get1 (a,_,_) = a; set1 a (_,b,c) = (a,b,c) - get2 (_,b,_) = b; set2 b (a,_,c) = (a,b,c) - get3 (_,_,c) = c; set3 c (a,b,_) = (a,b,c) + get1 (a,_) = a; set1 a (_,b) = (a,b) + get2 (_,b) = b; set2 b (a,_) = (a,b) parent = Cabal.benchmarkCommand progDb = defaultProgramDb @@ -1418,7 +1352,7 @@ manpageCommand = CommandUI { commandOptions = manpageOptions } -runCommand :: CommandUI (BuildFlags, BuildExFlags) +runCommand :: CommandUI BuildFlags runCommand = CommandUI { commandName = "run", commandSynopsis = "Builds and runs an executable.", @@ -1438,17 +1372,9 @@ runCommand = CommandUI { commandUsage = usageAlternatives "v1-run" ["[FLAGS] [EXECUTABLE] [-- EXECUTABLE_FLAGS]"], commandDefaultFlags = mempty, - commandOptions = - \showOrParseArgs -> liftOptions fst setFst - (commandOptions parent showOrParseArgs) - ++ - liftOptions snd setSnd - (buildExOptions showOrParseArgs) + commandOptions = commandOptions parent } where - setFst a (_,b) = (a,b) - setSnd b (a,_) = (a,b) - parent = Cabal.buildCommand defaultProgramDb -- ------------------------------------------------------------ @@ -1620,9 +1546,7 @@ listCommand = CommandUI { "List all packages, or all packages matching one of the search" ++ " strings.\n" ++ "\n" - ++ "If there is a sandbox in the current directory and " - ++ "config:ignore-sandbox is False, use the sandbox package database. " - ++ "Otherwise, use the package database specified with --package-db. " + ++ "Use the package database specified with --package-db. " ++ "If not specified, use the user package database.\n", commandNotes = Just $ \pname -> "Examples:\n" @@ -1652,7 +1576,7 @@ listCommand = CommandUI { ( "Append the given package database to the list of package" ++ " databases used (to satisfy dependencies and register into)." ++ " May be a specific file, 'global' or 'user'. The initial list" - ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," + ++ " is ['global'], ['global', 'user']," ++ " depending on context. Use 'clear' to reset the list to empty." ++ " See the user guide for details.") listPackageDBs (\v flags -> flags { listPackageDBs = v }) @@ -1688,9 +1612,7 @@ infoCommand = CommandUI { commandName = "info", commandSynopsis = "Display detailed information about a particular package.", commandDescription = Just $ \_ -> wrapText $ - "If there is a sandbox in the current directory and " - ++ "config:ignore-sandbox is False, use the sandbox package database. " - ++ "Otherwise, use the package database specified with --package-db. " + "Use the package database specified with --package-db. " ++ "If not specified, use the user package database.\n", commandNotes = Nothing, commandUsage = usageAlternatives "info" ["[FLAGS] PACKAGES"], @@ -1702,7 +1624,7 @@ infoCommand = CommandUI { ( "Append the given package database to the list of package" ++ " databases used (to satisfy dependencies and register into)." ++ " May be a specific file, 'global' or 'user'. The initial list" - ++ " is ['global'], ['global', 'user'], or ['global', $sandbox]," + ++ " is ['global'], ['global', 'user']," ++ " depending on context. Use 'clear' to reset the list to empty." ++ " See the user guide for details.") infoPackageDBs (\v flags -> flags { infoPackageDBs = v }) @@ -1834,31 +1756,22 @@ installCommand = CommandUI { ], commandDescription = Just $ \_ -> wrapText $ "Installs one or more packages. By default, the installed package" - ++ " will be registered in the user's package database or, if a sandbox" - ++ " is present in the current directory, inside the sandbox.\n" + ++ " will be registered in the user's package database." ++ "\n" ++ "If PACKAGES are specified, downloads and installs those packages." ++ " Otherwise, install the package in the current directory (and/or its" ++ " dependencies) (there must be exactly one .cabal file in the current" ++ " directory).\n" ++ "\n" - ++ "When using a sandbox, the flags for `v1-install` only affect the" - ++ " current command and have no effect on future commands. (To achieve" - ++ " that, `v1-configure` must be used.)\n" - ++ " In contrast, without a sandbox, the flags to `v1-install` are saved and" + ++ "The flags to `v1-install` are saved and" ++ " affect future commands such as `v1-build` and `v1-repl`. See the help for" ++ " `v1-configure` for a list of commands being affected.\n" ++ "\n" - ++ "Installed executables will by default (and without a sandbox)" + ++ "Installed executables will by default" ++ " be put into `~/.cabal/bin/`." ++ " If you want installed executable to be available globally, make" ++ " sure that the PATH environment variable contains that directory.\n" - ++ "When using a sandbox, executables will be put into" - ++ " `$SANDBOX/bin/` (by default: `./.cabal-sandbox/bin/`).\n" - ++ "\n" - ++ "When specifying --bindir, consider also specifying --datadir;" - ++ " this way the sandbox can be deleted and the executable should" - ++ " continue working as long as bindir and datadir are left untouched.", + ++ "\n", commandNotes = Just $ \pname -> ( case commandNotes $ Cabal.configureCommand defaultProgramDb @@ -2450,18 +2363,6 @@ initOptions _ = -- * SDist flags -- ------------------------------------------------------------ --- | Extra flags to @sdist@ beyond runghc Setup sdist --- -sdistCommand :: CommandUI SDistFlags -sdistCommand = Cabal.sdistCommand { - commandUsage = \pname -> - "Usage: " ++ pname ++ " v1-sdist [FLAGS]\n", - commandDefaultFlags = (commandDefaultFlags Cabal.sdistCommand) - } - - --- - doctestCommand :: CommandUI DoctestFlags doctestCommand = Cabal.doctestCommand { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-doctest [FLAGS]\n" } @@ -2523,128 +2424,6 @@ instance Monoid ActAsSetupFlags where instance Semigroup ActAsSetupFlags where (<>) = gmappend --- ------------------------------------------------------------ --- * Sandbox-related flags --- ------------------------------------------------------------ - -data SandboxFlags = SandboxFlags { - sandboxVerbosity :: Flag Verbosity, - sandboxSnapshot :: Flag Bool, -- FIXME: this should be an 'add-source'-only - -- flag. - sandboxLocation :: Flag FilePath -} deriving Generic - -defaultSandboxLocation :: FilePath -defaultSandboxLocation = ".cabal-sandbox" - -defaultSandboxFlags :: SandboxFlags -defaultSandboxFlags = SandboxFlags { - sandboxVerbosity = toFlag normal, - sandboxSnapshot = toFlag False, - sandboxLocation = toFlag defaultSandboxLocation - } - -sandboxCommand :: CommandUI SandboxFlags -sandboxCommand = CommandUI { - commandName = "sandbox", - commandSynopsis = "Create/modify/delete a sandbox.", - commandDescription = Just $ \pname -> concat - [ paragraph $ "Sandboxes are isolated package databases that can be used" - ++ " to prevent dependency conflicts that arise when many different" - ++ " packages are installed in the same database (i.e. the user's" - ++ " database in the home directory)." - , paragraph $ "A sandbox in the current directory (created by" - ++ " `v1-sandbox init`) will be used instead of the user's database for" - ++ " commands such as `v1-install` and `v1-build`. Note that (a directly" - ++ " invoked) GHC will not automatically be aware of sandboxes;" - ++ " only if called via appropriate " ++ pname - ++ " commands, e.g. `v1-repl`, `v1-build`, `v1-exec`." - , paragraph $ "Currently, " ++ pname ++ " will not search for a sandbox" - ++ " in folders above the current one, so cabal will not see the sandbox" - ++ " if you are in a subfolder of a sandbox." - , paragraph "Subcommands:" - , headLine "init:" - , indentParagraph $ "Initialize a sandbox in the current directory." - ++ " An existing package database will not be modified, but settings" - ++ " (such as the location of the database) can be modified this way." - , headLine "delete:" - , indentParagraph $ "Remove the sandbox; deleting all the packages" - ++ " installed inside." - , headLine "add-source:" - , indentParagraph $ "Make one or more local packages available in the" - ++ " sandbox. PATHS may be relative or absolute." - ++ " Typical usecase is when you need" - ++ " to make a (temporary) modification to a dependency: You download" - ++ " the package into a different directory, make the modification," - ++ " and add that directory to the sandbox with `add-source`." - , indentParagraph $ "Unless given `--snapshot`, any add-source'd" - ++ " dependency that was modified since the last build will be" - ++ " re-installed automatically." - , headLine "delete-source:" - , indentParagraph $ "Remove an add-source dependency; however, this will" - ++ " not delete the package(s) that have been installed in the sandbox" - ++ " from this dependency. You can either unregister the package(s) via" - ++ " `" ++ pname ++ " v1-sandbox hc-pkg unregister` or re-create the" - ++ " sandbox (`v1-sandbox delete; v1-sandbox init`)." - , headLine "list-sources:" - , indentParagraph $ "List the directories of local packages made" - ++ " available via `" ++ pname ++ " v1-sandbox add-source`." - , headLine "hc-pkg:" - , indentParagraph $ "Similar to `ghc-pkg`, but for the sandbox package" - ++ " database. Can be used to list specific/all packages that are" - ++ " installed in the sandbox. For subcommands, see the help for" - ++ " ghc-pkg. Affected by the compiler version specified by `v1-configure`." - ], - commandNotes = Just $ \pname -> - relevantConfigValuesText ["require-sandbox" - ,"ignore-sandbox"] - ++ "\n" - ++ "Examples:\n" - ++ " Set up a sandbox with one local dependency, located at ../foo:\n" - ++ " " ++ pname ++ " v1-sandbox init\n" - ++ " " ++ pname ++ " v1-sandbox add-source ../foo\n" - ++ " " ++ pname ++ " v1-install --only-dependencies\n" - ++ " Reset the sandbox:\n" - ++ " " ++ pname ++ " v1-sandbox delete\n" - ++ " " ++ pname ++ " v1-sandbox init\n" - ++ " " ++ pname ++ " v1-install --only-dependencies\n" - ++ " List the packages in the sandbox:\n" - ++ " " ++ pname ++ " v1-sandbox hc-pkg list\n" - ++ " Unregister the `broken` package from the sandbox:\n" - ++ " " ++ pname ++ " v1-sandbox hc-pkg -- --force unregister broken\n", - commandUsage = usageAlternatives "v1-sandbox" - [ "init [FLAGS]" - , "delete [FLAGS]" - , "add-source [FLAGS] PATHS" - , "delete-source [FLAGS] PATHS" - , "list-sources [FLAGS]" - , "hc-pkg [FLAGS] [--] COMMAND [--] [ARGS]" - ], - - commandDefaultFlags = defaultSandboxFlags, - commandOptions = \_ -> - [ optionVerbosity sandboxVerbosity - (\v flags -> flags { sandboxVerbosity = v }) - - , option [] ["snapshot"] - "Take a snapshot instead of creating a link (only applies to 'add-source')" - sandboxSnapshot (\v flags -> flags { sandboxSnapshot = v }) - trueArg - - , option [] ["sandbox"] - "Sandbox location (default: './.cabal-sandbox')." - sandboxLocation (\v flags -> flags { sandboxLocation = v }) - (reqArgFlag "DIR") - ] - } - -instance Monoid SandboxFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup SandboxFlags where - (<>) = gmappend - -- ------------------------------------------------------------ -- * Exec Flags -- ------------------------------------------------------------ @@ -2919,26 +2698,6 @@ readLocalRepo = simpleParsec -- * Helpers for Documentation -- ------------------------------------------------------------ -headLine :: String -> String -headLine = unlines - . map unwords - . wrapLine 79 - . words - -paragraph :: String -> String -paragraph = (++"\n") - . unlines - . map unwords - . wrapLine 79 - . words - -indentParagraph :: String -> String -indentParagraph = unlines - . (flip (++)) [""] - . map ((" "++).unwords) - . wrapLine 77 - . words - relevantConfigValuesText :: [String] -> String relevantConfigValuesText vs = "Relevant global configuration keys:\n" diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index ccf415a81a2..06cb96f3922 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -239,10 +239,7 @@ executable cabal Distribution.Client.Reconfigure Distribution.Client.Run Distribution.Client.Sandbox - Distribution.Client.Sandbox.Index Distribution.Client.Sandbox.PackageEnvironment - Distribution.Client.Sandbox.Timestamp - Distribution.Client.Sandbox.Types Distribution.Client.SavedFlags Distribution.Client.Security.DNS Distribution.Client.Security.HTTP diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp index 8996c5c3f5a..191428e9ee1 100644 --- a/cabal-install/cabal-install.cabal.pp +++ b/cabal-install/cabal-install.cabal.pp @@ -178,10 +178,7 @@ Distribution.Client.Reconfigure Distribution.Client.Run Distribution.Client.Sandbox - Distribution.Client.Sandbox.Index Distribution.Client.Sandbox.PackageEnvironment - Distribution.Client.Sandbox.Timestamp - Distribution.Client.Sandbox.Types Distribution.Client.SavedFlags Distribution.Client.Security.DNS Distribution.Client.Security.HTTP @@ -478,8 +475,6 @@ UnitTests.Distribution.Client.Glob UnitTests.Distribution.Client.GZipUtils UnitTests.Distribution.Client.Init.FileCreators - UnitTests.Distribution.Client.Sandbox - UnitTests.Distribution.Client.Sandbox.Timestamp UnitTests.Distribution.Client.Store UnitTests.Distribution.Client.Tar UnitTests.Distribution.Client.TreeDiffInstances diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 1d1cffbd8fe..36cf9ebd378 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -21,7 +21,7 @@ import Distribution.Client.Setup , ConfigExFlags(..), defaultConfigExFlags, configureExCommand , reconfigureCommand , configCompilerAux', configPackageDB' - , BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) + , BuildFlags(..) , buildCommand, replCommand, testCommand, benchmarkCommand , InstallFlags(..), defaultInstallFlags , installCommand @@ -40,7 +40,6 @@ import Distribution.Client.Setup , runCommand , InitFlags(initVerbosity, initHcPath), initCommand , ActAsSetupFlags(..), actAsSetupCommand - , SandboxFlags(..), sandboxCommand , ExecFlags(..), execCommand , UserConfigFlags(..), userConfigCommand , reportCommand @@ -109,29 +108,11 @@ import Distribution.Client.Get (get) import Distribution.Client.Reconfigure (Check(..), reconfigure) import Distribution.Client.Nix (nixInstantiate ,nixShell - ,nixShellIfSandboxed) -import Distribution.Client.Sandbox (sandboxInit - ,sandboxAddSource - ,sandboxDelete - ,sandboxDeleteSource - ,sandboxListSources - ,sandboxHcPkg - ,dumpPackageEnvironment - - ,loadConfigOrSandboxConfig + ) +import Distribution.Client.Sandbox (loadConfigOrSandboxConfig ,findSavedDistPref - ,initPackageDBIfNeeded - ,maybeWithSandboxDirOnSearchPath - ,maybeWithSandboxPackageInfo - ,tryGetIndexFilePath - ,sandboxBuildDir - ,updateSandboxConfigFileFlag ,updateInstallDirs - ,getPersistOrConfigCompiler) -import Distribution.Client.Sandbox.PackageEnvironment (setPackageDB) -import Distribution.Client.Sandbox.Timestamp (maybeAddCompilerTimestampRecord) -import Distribution.Client.Sandbox.Types (UseSandbox(..), whenUsingSandbox) import Distribution.Client.Tar (createTarGzFile) import Distribution.Client.Types.Credentials (Password (..)) import Distribution.Client.Init (initCabal) @@ -157,7 +138,7 @@ import Distribution.Simple.Command ( CommandParse(..), CommandUI(..), Command, CommandSpec(..) , CommandType(..), commandsRun, commandAddAction, hiddenCommand , commandFromSpec, commandShowOptions ) -import Distribution.Simple.Compiler (Compiler(..), PackageDBStack) +import Distribution.Simple.Compiler (PackageDBStack) import Distribution.Simple.Configure ( configCompilerAuxEx, ConfigStateFileError(..) , getPersistBuildConfig, interpretPackageDbFlags @@ -229,9 +210,7 @@ mainWorker args = do CommandList opts -> printOptionsList opts CommandErrors errs -> maybe (printErrors errs) go maybeScriptAndArgs where go (script:|scriptArgs) = CmdRun.handleShebang script scriptArgs - CommandReadyToGo action -> do - globalFlags' <- updateSandboxConfigFileFlag globalFlags - action globalFlags' + CommandReadyToGo action -> action globalFlags where printCommandHelp help = do @@ -306,7 +285,6 @@ mainWorker args = do , legacyWrapperCmd copyCommand copyVerbosity copyDistPref , legacyWrapperCmd registerCommand regVerbosity regDistPref , legacyCmd reconfigureCommand reconfigureAction - , legacyCmd sandboxCommand sandboxAction ] type Action = GlobalFlags -> IO () @@ -339,7 +317,7 @@ wrapperAction command verbosityFlag distPrefFlag = { commandDefaultFlags = mempty } $ \flags extraArgs globalFlags -> do let verbosity = 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 } setupWrapper verbosity setupScriptOptions Nothing @@ -349,7 +327,7 @@ configureAction :: (ConfigFlags, ConfigExFlags) -> [String] -> Action configureAction (configFlags, configExFlags) extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - (useSandbox, config) <- updateInstallDirs (configUserInstall configFlags) + config <- updateInstallDirs (configUserInstall configFlags) <$> loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (configDistPref configFlags) nixInstantiate verbosity distPref True globalFlags config @@ -359,43 +337,24 @@ configureAction (configFlags, configExFlags) extraArgs globalFlags = do globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAuxEx configFlags' - -- If we're working inside a sandbox and the user has set the -w option, we - -- may need to create a sandbox-local package DB for this compiler and add a - -- timestamp record for this compiler to the timestamp file. - let configFlags'' = case useSandbox of - NoSandbox -> configFlags' - (UseSandbox sandboxDir) -> setPackageDB sandboxDir - comp platform configFlags' - - writeConfigFlags verbosity distPref (configFlags'', configExFlags') + writeConfigFlags verbosity distPref (configFlags', configExFlags') -- What package database(s) to use let packageDBs :: PackageDBStack packageDBs = interpretPackageDbFlags - (fromFlag (configUserInstall configFlags'')) - (configPackageDBs configFlags'') + (fromFlag (configUserInstall configFlags')) + (configPackageDBs configFlags') - whenUsingSandbox useSandbox $ \sandboxDir -> do - initPackageDBIfNeeded verbosity configFlags'' comp progdb - -- NOTE: We do not write the new sandbox package DB location to - -- 'cabal.sandbox.config' here because 'configure -w' must not affect - -- subsequent 'install' (for UI compatibility with non-sandboxed mode). - - indexFile <- tryGetIndexFilePath verbosity config - maybeAddCompilerTimestampRecord verbosity sandboxDir indexFile - (compilerId comp) platform - - maybeWithSandboxDirOnSearchPath useSandbox $ - withRepoContext verbosity globalFlags' $ \repoContext -> + withRepoContext verbosity globalFlags' $ \repoContext -> configure verbosity packageDBs repoContext - comp platform progdb configFlags'' configExFlags' extraArgs + comp platform progdb configFlags' configExFlags' extraArgs reconfigureAction :: (ConfigFlags, ConfigExFlags) -> [String] -> Action reconfigureAction flags@(configFlags, _) _ globalFlags = do let verbosity = fromFlagOrDefault normal (configVerbosity configFlags) - (useSandbox, config) <- updateInstallDirs (configUserInstall configFlags) + config <- updateInstallDirs (configUserInstall configFlags) <$> loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (configDistPref configFlags) let checkFlags = Check $ \_ saved -> do @@ -412,26 +371,23 @@ reconfigureAction flags@(configFlags, _) _ globalFlags = do nixInstantiate verbosity distPref True globalFlags config _ <- reconfigure configureAction - verbosity distPref useSandbox DontSkipAddSourceDepsCheck NoFlag + verbosity distPref NoFlag checkFlags [] globalFlags config pure () -buildAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -buildAction (buildFlags, buildExFlags) extraArgs globalFlags = do +buildAction :: BuildFlags -> [String] -> Action +buildAction buildFlags extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) - noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (buildDistPref buildFlags) -- Calls 'configureAction' to do the real work, so nothing special has to be -- done to support sandboxes. config' <- reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags) + verbosity distPref (buildNumJobs buildFlags) mempty [] globalFlags config nixShell verbosity distPref globalFlags config $ do - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config' distPref buildFlags extraArgs + build verbosity config' distPref buildFlags extraArgs -- | Actually do the work of building the package. This is separate from @@ -471,10 +427,10 @@ filterBuildFlags version config buildFlags numJobsCmdLineFlag = buildNumJobs buildFlags -replAction :: (ReplFlags, BuildExFlags) -> [String] -> Action -replAction (replFlags, buildExFlags) extraArgs globalFlags = do +replAction :: ReplFlags -> [String] -> Action +replAction replFlags extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal (replVerbosity replFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (replDistPref replFlags) cwd <- getCurrentDirectory pkgDesc <- findPackageDesc cwd @@ -482,16 +438,11 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do -- There is a .cabal file in the current directory: start a REPL and load -- the project's modules. onPkgDesc = do - let noAddSource = case replReload replFlags of - Flag True -> SkipAddSourceDepsCheck - _ -> fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - -- Calls 'configureAction' to do the real work, so nothing special has to -- be done to support sandboxes. _ <- reconfigure configureAction - verbosity distPref useSandbox noAddSource NoFlag + verbosity distPref NoFlag mempty [] globalFlags config let progDb = defaultProgramDb setupOptions = defaultSetupScriptOptions @@ -503,10 +454,8 @@ replAction (replFlags, buildExFlags) extraArgs globalFlags = do , replDistPref = toFlag distPref } - nixShell verbosity distPref globalFlags config $ do - maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing - (Cabal.replCommand progDb) (const replFlags') (const extraArgs) + nixShell verbosity distPref globalFlags config $ + setupWrapper verbosity setupOptions Nothing (Cabal.replCommand progDb) (const replFlags') (const extraArgs) -- No .cabal file in the current directory: just start the REPL (possibly -- using the sandbox package DB). @@ -529,11 +478,10 @@ installAction :: ( ConfigFlags, ConfigExFlags, InstallFlags installAction (configFlags, _, installFlags, _, _, _) _ globalFlags | fromFlagOrDefault False (installOnly installFlags) = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verb globalFlags + config <- loadConfigOrSandboxConfig verb globalFlags dist <- findSavedDistPref config (configDistPref configFlags) let setupOpts = defaultSetupScriptOptions { useDistPref = dist } - nixShellIfSandboxed verb dist globalFlags config useSandbox $ - setupWrapper + setupWrapper verb setupOpts Nothing installCommand (const (mempty, mempty, mempty, mempty, mempty, mempty)) (const []) @@ -543,29 +491,14 @@ installAction , haddockFlags, testFlags, benchmarkFlags ) extraArgs globalFlags = do let verb = fromFlagOrDefault normal (configVerbosity configFlags) - (useSandbox, config) <- updateInstallDirs (configUserInstall configFlags) + config <- updateInstallDirs (configUserInstall configFlags) <$> loadConfigOrSandboxConfig verb globalFlags - let sandboxDist = - case useSandbox of - NoSandbox -> NoFlag - UseSandbox sandboxDir -> Flag $ sandboxBuildDir sandboxDir - dist <- findSavedDistPref config - (configDistPref configFlags `mappend` sandboxDist) + dist <- findSavedDistPref config (configDistPref configFlags) - nixShellIfSandboxed verb dist globalFlags config useSandbox $ do + do targets <- readUserTargets verb extraArgs - -- TODO: It'd be nice if 'cabal install' picked up the '-w' flag passed to - -- 'configure' when run inside a sandbox. Right now, running - -- - -- \$ cabal sandbox init && cabal configure -w /path/to/ghc - -- && cabal build && cabal install - -- - -- performs the compilation twice unless you also pass -w to 'install'. - -- However, this is the same behaviour that 'cabal install' has in the normal - -- mode of operation, so we stick to it for consistency. - let configFlags' = maybeForceTests installFlags' $ savedConfigureFlags config `mappend` configFlags { configDistPref = toFlag dist } @@ -584,39 +517,18 @@ installAction benchmarkFlags { benchmarkDistPref = toFlag dist } globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAux' configFlags' + -- TODO: Redesign ProgramDB API to prevent such problems as #2241 in the -- future. progdb' <- configureAllKnownPrograms verb progdb - -- If we're working inside a sandbox and the user has set the -w option, we - -- may need to create a sandbox-local package DB for this compiler and add a - -- timestamp record for this compiler to the timestamp file. - configFlags'' <- case useSandbox of - NoSandbox -> configAbsolutePaths $ configFlags' - (UseSandbox sandboxDir) -> return $ setPackageDB sandboxDir comp platform - configFlags' - - whenUsingSandbox useSandbox $ \sandboxDir -> do - initPackageDBIfNeeded verb configFlags'' comp progdb' - - indexFile <- tryGetIndexFilePath verb config - maybeAddCompilerTimestampRecord verb sandboxDir indexFile - (compilerId comp) platform - - -- TODO: Passing 'SandboxPackageInfo' to install unconditionally here means - -- that 'cabal install some-package' inside a sandbox will sometimes reinstall - -- modified add-source deps, even if they are not among the dependencies of - -- 'some-package'. This can also prevent packages that depend on older - -- versions of add-source'd packages from building (see #1362). - maybeWithSandboxPackageInfo verb configFlags'' globalFlags' - comp platform progdb useSandbox $ \mSandboxPkgInfo -> - maybeWithSandboxDirOnSearchPath useSandbox $ - withRepoContext verb globalFlags' $ \repoContext -> + configFlags'' <- configAbsolutePaths configFlags' + + withRepoContext verb globalFlags' $ \repoContext -> install verb (configPackageDB' configFlags'') repoContext comp platform progdb' - useSandbox mSandboxPkgInfo globalFlags' configFlags'' configExFlags' installFlags' haddockFlags' testFlags' benchmarkFlags' targets @@ -628,15 +540,13 @@ installAction then configFlags' { configTests = toFlag True } else configFlags' -testAction :: (TestFlags, BuildFlags, BuildExFlags) -> [String] -> GlobalFlags +testAction :: (BuildFlags, TestFlags) -> [String] -> GlobalFlags -> IO () -testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do - let verbosity = fromFlagOrDefault normal (testVerbosity testFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags +testAction (buildFlags, testFlags) extraArgs globalFlags = do + let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (testDistPref testFlags) - let noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - buildFlags' = buildFlags + let buildFlags' = buildFlags { buildVerbosity = testVerbosity testFlags } checkFlags = Check $ \_ flags@(configFlags, configExFlags) -> if fromFlagOrDefault False (configTests configFlags) @@ -648,11 +558,9 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do ) pure (Any True, flags') - -- reconfigure also checks if we're in a sandbox and reinstalls add-source - -- deps if needed. _ <- reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags') + verbosity distPref (buildNumJobs buildFlags') checkFlags [] globalFlags config nixShell verbosity distPref globalFlags config $ do let setupOptions = defaultSetupScriptOptions { useDistPref = distPref } @@ -668,12 +576,8 @@ testAction (testFlags, buildFlags, buildExFlags) extraArgs globalFlags = do | LBI.CTestName name <- names' ] | otherwise = extraArgs - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config distPref buildFlags' extraArgs' - - maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing - Cabal.testCommand (const testFlags') (const extraArgs') + build verbosity config distPref buildFlags' extraArgs' + setupWrapper verbosity setupOptions Nothing Cabal.testCommand (const testFlags') (const extraArgs') data ComponentNames = ComponentNamesUnknown | ComponentNames [LBI.ComponentName] @@ -704,21 +608,19 @@ componentNamesFromLBI verbosity distPref targetsDescr compPred = do else return $! (ComponentNames names) -benchmarkAction :: (BenchmarkFlags, BuildFlags, BuildExFlags) +benchmarkAction :: (BuildFlags, BenchmarkFlags) -> [String] -> GlobalFlags -> IO () benchmarkAction - (benchmarkFlags, buildFlags, buildExFlags) + (buildFlags, benchmarkFlags) extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal - (benchmarkVerbosity benchmarkFlags) + (buildVerbosity buildFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (benchmarkDistPref benchmarkFlags) let buildFlags' = buildFlags { buildVerbosity = benchmarkVerbosity benchmarkFlags } - noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) let checkFlags = Check $ \_ flags@(configFlags, configExFlags) -> if fromFlagOrDefault False (configBenchmarks configFlags) @@ -730,12 +632,9 @@ benchmarkAction ) pure (Any True, flags') - - -- reconfigure also checks if we're in a sandbox and reinstalls add-source - -- deps if needed. config' <- reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags') + verbosity distPref (buildNumJobs buildFlags') checkFlags [] globalFlags config nixShell verbosity distPref globalFlags config $ do let setupOptions = defaultSetupScriptOptions { useDistPref = distPref } @@ -751,21 +650,17 @@ benchmarkAction | LBI.CBenchName name <- names'] | otherwise = extraArgs - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config' distPref buildFlags' extraArgs' - - maybeWithSandboxDirOnSearchPath useSandbox $ - setupWrapper verbosity setupOptions Nothing - Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs') + build verbosity config' distPref buildFlags' extraArgs' + setupWrapper verbosity setupOptions Nothing Cabal.benchmarkCommand (const benchmarkFlags') (const extraArgs') haddockAction :: HaddockFlags -> [String] -> Action haddockAction haddockFlags extraArgs globalFlags = do let verbosity = fromFlag (haddockVerbosity haddockFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (haddockDistPref haddockFlags) config' <- reconfigure configureAction - verbosity distPref useSandbox DontSkipAddSourceDepsCheck NoFlag + verbosity distPref NoFlag mempty [] globalFlags config nixShell verbosity distPref globalFlags config $ do let haddockFlags' = defaultHaddockFlags `mappend` @@ -793,7 +688,7 @@ doctestAction doctestFlags extraArgs _globalFlags = do cleanAction :: CleanFlags -> [String] -> Action cleanAction cleanFlags extraArgs globalFlags = do load <- try (loadConfigOrSandboxConfig verbosity globalFlags) - let config = either (\(SomeException _) -> mempty) snd load + let config = either (\(SomeException _) -> mempty) id load distPref <- findSavedDistPref config (cleanDistPref cleanFlags) let setupScriptOptions = defaultSetupScriptOptions { useDistPref = distPref @@ -808,8 +703,7 @@ cleanAction cleanFlags extraArgs globalFlags = do listAction :: ListFlags -> [String] -> Action listAction listFlags extraArgs globalFlags = do let verbosity = fromFlag (listVerbosity listFlags) - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity - (globalFlags { globalRequireSandbox = Flag False }) + config <- loadConfigOrSandboxConfig verbosity globalFlags let configFlags' = savedConfigureFlags config configFlags = configFlags' { configPackageDBs = configPackageDBs configFlags' @@ -830,8 +724,7 @@ infoAction :: InfoFlags -> [String] -> Action infoAction infoFlags extraArgs globalFlags = do let verbosity = fromFlag (infoVerbosity infoFlags) targets <- readUserTargets verbosity extraArgs - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity - (globalFlags { globalRequireSandbox = Flag False }) + config <- loadConfigOrSandboxConfig verbosity globalFlags let configFlags' = savedConfigureFlags config configFlags = configFlags' { configPackageDBs = configPackageDBs configFlags' @@ -854,8 +747,7 @@ updateAction updateFlags extraArgs globalFlags = do let verbosity = fromFlag (updateVerbosity updateFlags) unless (null extraArgs) $ die' verbosity $ "'update' doesn't take any extra arguments: " ++ unwords extraArgs - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity - (globalFlags { globalRequireSandbox = Flag False }) + config <- loadConfigOrSandboxConfig verbosity globalFlags let globalFlags' = savedGlobalFlags config `mappend` globalFlags withRepoContext verbosity globalFlags' $ \repoContext -> update verbosity updateFlags repoContext @@ -878,51 +770,41 @@ fetchAction fetchFlags extraArgs globalFlags = do freezeAction :: FreezeFlags -> [String] -> Action freezeAction freezeFlags _extraArgs globalFlags = do let verbosity = fromFlag (freezeVerbosity freezeFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config NoFlag nixShell verbosity distPref globalFlags config $ do let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAux' configFlags - maybeWithSandboxPackageInfo - verbosity configFlags globalFlags' - comp platform progdb useSandbox $ \mSandboxPkgInfo -> - maybeWithSandboxDirOnSearchPath useSandbox $ - withRepoContext verbosity globalFlags' $ \repoContext -> - freeze verbosity + withRepoContext verbosity globalFlags' $ \repoContext -> + freeze verbosity (configPackageDB' configFlags) repoContext comp platform progdb - mSandboxPkgInfo globalFlags' freezeFlags genBoundsAction :: FreezeFlags -> [String] -> GlobalFlags -> IO () genBoundsAction freezeFlags _extraArgs globalFlags = do let verbosity = fromFlag (freezeVerbosity freezeFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config NoFlag nixShell verbosity distPref globalFlags config $ do let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, progdb) <- configCompilerAux' configFlags - maybeWithSandboxPackageInfo - verbosity configFlags globalFlags' - comp platform progdb useSandbox $ \mSandboxPkgInfo -> - maybeWithSandboxDirOnSearchPath useSandbox $ - withRepoContext verbosity globalFlags' $ \repoContext -> - genBounds verbosity + withRepoContext verbosity globalFlags' $ \repoContext -> + genBounds verbosity (configPackageDB' configFlags) repoContext comp platform progdb - mSandboxPkgInfo globalFlags' freezeFlags outdatedAction :: OutdatedFlags -> [String] -> GlobalFlags -> IO () outdatedAction outdatedFlags _extraArgs globalFlags = do let verbosity = fromFlag (outdatedVerbosity outdatedFlags) - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags let configFlags = savedConfigureFlags config globalFlags' = savedGlobalFlags config `mappend` globalFlags (comp, platform, _progdb) <- configCompilerAux' configFlags @@ -1026,35 +908,27 @@ reportAction reportFlags extraArgs globalFlags = do (flagToMaybe $ reportUsername reportFlags') (flagToMaybe $ reportPassword reportFlags') -runAction :: (BuildFlags, BuildExFlags) -> [String] -> Action -runAction (buildFlags, buildExFlags) extraArgs globalFlags = do +runAction :: BuildFlags -> [String] -> Action +runAction buildFlags extraArgs globalFlags = do let verbosity = fromFlagOrDefault normal (buildVerbosity buildFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (buildDistPref buildFlags) - let noAddSource = fromFlagOrDefault DontSkipAddSourceDepsCheck - (buildOnly buildExFlags) - -- reconfigure also checks if we're in a sandbox and reinstalls add-source - -- deps if needed. config' <- reconfigure configureAction - verbosity distPref useSandbox noAddSource (buildNumJobs buildFlags) + verbosity distPref (buildNumJobs buildFlags) mempty [] globalFlags config nixShell verbosity distPref globalFlags config $ do lbi <- getPersistBuildConfig distPref (exe, exeArgs) <- splitRunArgs verbosity lbi extraArgs - maybeWithSandboxDirOnSearchPath useSandbox $ - build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)] - - maybeWithSandboxDirOnSearchPath useSandbox $ - run verbosity lbi exe exeArgs + build verbosity config' distPref buildFlags ["exe:" ++ display (exeName exe)] + run verbosity lbi exe exeArgs getAction :: GetFlags -> [String] -> Action getAction getFlags extraArgs globalFlags = do let verbosity = fromFlag (getVerbosity getFlags) targets <- readUserTargets verbosity extraArgs - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity - (globalFlags { globalRequireSandbox = Flag False }) + config <- loadConfigOrSandboxConfig verbosity globalFlags let globalFlags' = savedGlobalFlags config `mappend` globalFlags withRepoContext verbosity (savedGlobalFlags config) $ \repoContext -> get verbosity @@ -1072,8 +946,7 @@ initAction initFlags extraArgs globalFlags = do let verbosity = fromFlag (initVerbosity initFlags) when (extraArgs /= []) $ die' verbosity $ "'init' doesn't take any extra arguments: " ++ unwords extraArgs - (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity - (globalFlags { globalRequireSandbox = Flag False }) + config <- loadConfigOrSandboxConfig verbosity globalFlags let configFlags = savedConfigureFlags config `mappend` -- override with `--with-compiler` from CLI if available mempty { configHcPath = initHcPath initFlags } @@ -1088,50 +961,15 @@ initAction initFlags extraArgs globalFlags = do progdb initFlags' -sandboxAction :: SandboxFlags -> [String] -> Action -sandboxAction sandboxFlags extraArgs globalFlags = do - let verbosity = fromFlag (sandboxVerbosity sandboxFlags) - case extraArgs of - -- Basic sandbox commands. - ["init"] -> sandboxInit verbosity sandboxFlags globalFlags - ["delete"] -> sandboxDelete verbosity sandboxFlags globalFlags - ("add-source":extra) -> do - when (noExtraArgs extra) $ - die' verbosity "The 'sandbox add-source' command expects at least one argument" - sandboxAddSource verbosity extra sandboxFlags globalFlags - ("delete-source":extra) -> do - when (noExtraArgs extra) $ - die' verbosity ("The 'sandbox delete-source' command expects " ++ - "at least one argument") - sandboxDeleteSource verbosity extra sandboxFlags globalFlags - ["list-sources"] -> sandboxListSources verbosity sandboxFlags globalFlags - - -- More advanced commands. - ("hc-pkg":extra) -> do - when (noExtraArgs extra) $ - die' verbosity $ "The 'sandbox hc-pkg' command expects at least one argument" - sandboxHcPkg verbosity sandboxFlags globalFlags extra - ["buildopts"] -> die' verbosity "Not implemented!" - - -- Hidden commands. - ["dump-pkgenv"] -> dumpPackageEnvironment verbosity sandboxFlags globalFlags - - -- Error handling. - [] -> die' verbosity $ "Please specify a subcommand (see 'help sandbox')" - _ -> die' verbosity $ "Unknown 'sandbox' subcommand: " ++ unwords extraArgs - - where - noExtraArgs = (<1) . length - execAction :: ExecFlags -> [String] -> Action execAction execFlags extraArgs globalFlags = do let verbosity = fromFlag (execVerbosity execFlags) - (useSandbox, config) <- loadConfigOrSandboxConfig verbosity globalFlags + config <- loadConfigOrSandboxConfig verbosity globalFlags distPref <- findSavedDistPref config (execDistPref execFlags) let configFlags = savedConfigureFlags config configFlags' = configFlags { configDistPref = Flag distPref } (comp, platform, progdb) <- getPersistOrConfigCompiler configFlags' - exec verbosity useSandbox comp platform progdb extraArgs + exec verbosity comp platform progdb extraArgs userConfigAction :: UserConfigFlags -> [String] -> Action userConfigAction ucflags extraArgs globalFlags = do diff --git a/cabal-install/tests/UnitTests.hs b/cabal-install/tests/UnitTests.hs index 24dd4e56d51..9cb39727626 100644 --- a/cabal-install/tests/UnitTests.hs +++ b/cabal-install/tests/UnitTests.hs @@ -18,8 +18,6 @@ import qualified UnitTests.Distribution.Client.FileMonitor import qualified UnitTests.Distribution.Client.Glob import qualified UnitTests.Distribution.Client.GZipUtils import qualified UnitTests.Distribution.Client.Init.FileCreators -import qualified UnitTests.Distribution.Client.Sandbox -import qualified UnitTests.Distribution.Client.Sandbox.Timestamp import qualified UnitTests.Distribution.Client.Store import qualified UnitTests.Distribution.Client.Tar import qualified UnitTests.Distribution.Client.Targets @@ -58,10 +56,6 @@ tests mtimeChangeCalibrated = UnitTests.Distribution.Client.GZipUtils.tests , testGroup "Distribution.Client.Init.FileCreators" UnitTests.Distribution.Client.Init.FileCreators.tests - , testGroup "Distribution.Client.Sandbox" - UnitTests.Distribution.Client.Sandbox.tests - , testGroup "Distribution.Client.Sandbox.Timestamp" - UnitTests.Distribution.Client.Sandbox.Timestamp.tests , testGroup "Distribution.Client.Store" UnitTests.Distribution.Client.Store.tests , testGroup "Distribution.Client.Tar" diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs deleted file mode 100644 index 3bf2d28e114..00000000000 --- a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox.hs +++ /dev/null @@ -1,28 +0,0 @@ -module UnitTests.Distribution.Client.Sandbox ( - tests - ) where - -import Distribution.Client.Sandbox (withSandboxBinDirOnSearchPath) - -import Test.Tasty -import Test.Tasty.HUnit - -import System.FilePath (getSearchPath, ()) - -tests :: [TestTree] -tests = [ testCase "sandboxBinDirOnSearchPath" sandboxBinDirOnSearchPathTest - , testCase "oldSearchPathRestored" oldSearchPathRestoreTest - ] - -sandboxBinDirOnSearchPathTest :: Assertion -sandboxBinDirOnSearchPathTest = - withSandboxBinDirOnSearchPath "foo" $ do - r <- getSearchPath - assertBool "'foo/bin' not on search path" $ ("foo" "bin") `elem` r - -oldSearchPathRestoreTest :: Assertion -oldSearchPathRestoreTest = do - r <- getSearchPath - withSandboxBinDirOnSearchPath "foo" $ return () - r' <- getSearchPath - assertEqual "Old search path wasn't restored" r r' diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs b/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs deleted file mode 100644 index 68d7284c477..00000000000 --- a/cabal-install/tests/UnitTests/Distribution/Client/Sandbox/Timestamp.hs +++ /dev/null @@ -1,63 +0,0 @@ -module UnitTests.Distribution.Client.Sandbox.Timestamp (tests) where - -import System.FilePath - -import Distribution.Simple.Utils (withTempDirectory) -import Distribution.Verbosity - -import Distribution.Compat.Time -import Distribution.Client.Sandbox.Timestamp - -import Test.Tasty -import Test.Tasty.HUnit - -tests :: [TestTree] -tests = - [ testCase "timestamp record version 1 can be read" timestampReadTest_v1 - , testCase "timestamp record version 2 can be read" timestampReadTest_v2 - , testCase "written timestamp record can be read" timestampReadWriteTest ] - -timestampRecord_v1 :: String -timestampRecord_v1 = - "[(\"i386-linux-ghc-8.0.0.20160204\",[(\"/foo/bar/Baz\",1455350946)])" ++ - ",(\"i386-linux-ghc-7.10.3\",[(\"/foo/bar/Baz\",1455484719)])]\n" - -timestampRecord_v2 :: String -timestampRecord_v2 = - "2\n" ++ - "[(\"i386-linux-ghc-8.0.0.20160204\",[(\"/foo/bar/Baz\",1455350946)])" ++ - ",(\"i386-linux-ghc-7.10.3\",[(\"/foo/bar/Baz\",1455484719)])]" - -timestampReadTest_v1 :: Assertion -timestampReadTest_v1 = - timestampReadTest timestampRecord_v1 $ - map (\(i, ts) -> - (i, map (\(p, ModTime t) -> - (p, posixSecondsToModTime . fromIntegral $ t)) ts)) - timestampRecord - -timestampReadTest_v2 :: Assertion -timestampReadTest_v2 = timestampReadTest timestampRecord_v2 timestampRecord - -timestampReadTest :: FilePath -> [TimestampFileRecord] -> Assertion -timestampReadTest fileContent expected = - withTempDirectory silent "." "cabal-timestamp-" $ \dir -> do - let fileName = dir "timestamp-record" - writeFile fileName fileContent - tRec <- readTimestampFile normal fileName - assertEqual "expected timestamp records to be equal" - expected tRec - -timestampRecord :: [TimestampFileRecord] -timestampRecord = - [("i386-linux-ghc-8.0.0.20160204",[("/foo/bar/Baz",ModTime 1455350946)]) - ,("i386-linux-ghc-7.10.3",[("/foo/bar/Baz",ModTime 1455484719)])] - -timestampReadWriteTest :: Assertion -timestampReadWriteTest = - withTempDirectory silent "." "cabal-timestamp-" $ \dir -> do - let fileName = dir "timestamp-record" - writeTimestampFile fileName timestampRecord - tRec <- readTimestampFile normal fileName - assertEqual "expected timestamp records to be equal" - timestampRecord tRec diff --git a/cabal-testsuite/PackageTests/CustomDep/sandbox.out b/cabal-testsuite/PackageTests/CustomDep/sandbox.out deleted file mode 100644 index 0eae1931245..00000000000 --- a/cabal-testsuite/PackageTests/CustomDep/sandbox.out +++ /dev/null @@ -1,5 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-sandbox add-source diff --git a/cabal-testsuite/PackageTests/CustomDep/sandbox.test.hs b/cabal-testsuite/PackageTests/CustomDep/sandbox.test.hs deleted file mode 100644 index d56655095c7..00000000000 --- a/cabal-testsuite/PackageTests/CustomDep/sandbox.test.hs +++ /dev/null @@ -1,22 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - osx <- isOSX - win <- isWindows - -- On Travis OSX, Cabal shipped with GHC 7.8 does not work - -- with error "setup: /usr/bin/ar: permission denied"; see - -- also https://github.com/haskell/cabal/issues/3938 - -- This is a hack to make the test not run in this case. - when osx $ skipUnless =<< ghcVersionIs (>= mkVersion [7,10]) - -- On Appveyor, for some reason this test fails sometimes - -- due to missing symbols in Cabal 1.24. The solution is to - -- use a newer version of GHC that bundles a newer version - -- of Cabal, but for now, we skip. - when win $ skipUnless =<< ghcVersionIs (>= mkVersion [8,2]) - withSandbox $ do - cabal_sandbox "add-source" ["custom"] - cabal_sandbox "add-source" ["client"] - -- NB: This test relies critically on the Setup script being - -- built against GHC's bundled Cabal. This means that the - -- output we see may vary between tests, so we don't record this. - recordMode DoNotRecord $ - cabal "v1-install" ["client"] diff --git a/cabal-testsuite/PackageTests/Exec/T4049/UseLib.c b/cabal-testsuite/PackageTests/Exec/T4049/UseLib.c deleted file mode 100644 index 65770da6380..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/UseLib.c +++ /dev/null @@ -1,9 +0,0 @@ -#include - -int main() -{ - myForeignLibInit(); - sayHi(); - myForeignLibExit(); - return 0; -} diff --git a/cabal-testsuite/PackageTests/Exec/T4049/csrc/MyForeignLibWrapper.c b/cabal-testsuite/PackageTests/Exec/T4049/csrc/MyForeignLibWrapper.c deleted file mode 100644 index 2660c6a335e..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/csrc/MyForeignLibWrapper.c +++ /dev/null @@ -1,23 +0,0 @@ -#include -#include "HsFFI.h" - -HsBool myForeignLibInit(void){ - int argc = 2; - char *argv[] = { "+RTS", "-A32m", NULL }; - char **pargv = argv; - - // Initialize Haskell runtime - hs_init(&argc, &pargv); - - // do any other initialization here and - // return false if there was a problem - return HS_BOOL_TRUE; -} - -void myForeignLibExit(void){ - hs_exit(); -} - -int cFoo2() { - return 1234; -} diff --git a/cabal-testsuite/PackageTests/Exec/T4049/my-foreign-lib.cabal b/cabal-testsuite/PackageTests/Exec/T4049/my-foreign-lib.cabal deleted file mode 100644 index 05ab5eef604..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/my-foreign-lib.cabal +++ /dev/null @@ -1,19 +0,0 @@ -name: my-foreign-lib -version: 0.1.0.0 -author: Edsko de Vries -maintainer: edsko@well-typed.com -build-type: Simple -cabal-version: >=1.10 - -foreign-library myforeignlib - type: native-shared - - if os(windows) - options: standalone - - other-modules: MyForeignLib.Hello - MyForeignLib.SomeBindings - build-depends: base - hs-source-dirs: src - c-sources: csrc/MyForeignLibWrapper.c - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Exec/T4049/sandbox.out b/cabal-testsuite/PackageTests/Exec/T4049/sandbox.out deleted file mode 100644 index 211fa0469b3..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/sandbox.out +++ /dev/null @@ -1,12 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-install -Resolving dependencies... -Configuring my-foreign-lib-0.1.0.0... -Preprocessing foreign library 'myforeignlib' for my-foreign-lib-0.1.0.0.. -Building foreign library 'myforeignlib' for my-foreign-lib-0.1.0.0.. -Installing foreign library myforeignlib in -Completed my-foreign-lib-0.1.0.0 -# cabal v1-exec -Hi from a foreign library! Foo has value 5678 diff --git a/cabal-testsuite/PackageTests/Exec/T4049/sandbox.test.hs b/cabal-testsuite/PackageTests/Exec/T4049/sandbox.test.hs deleted file mode 100644 index bad008e7086..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/sandbox.test.hs +++ /dev/null @@ -1,20 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - skipUnless =<< ghcVersionIs (>= mkVersion [7,8]) - withSandbox $ do - cabal "v1-install" ["--enable-shared"] - env <- getTestEnv - is_windows <- isWindows - let sandbox_dir = testSandboxDir env - work_dir = testWorkDir env - lib_dir = - -- This is dumb but it's been this way for a long time. - if is_windows - then sandbox_dir - else sandbox_dir "lib" - gcc [ "UseLib.c" - , "-o", work_dir "UseLib" - , "-l" ++ "myforeignlib" - , "-L" ++ lib_dir ] - recordMode RecordAll $ - cabal "v1-exec" ["-v0", work_dir "UseLib"] diff --git a/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/Hello.hs b/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/Hello.hs deleted file mode 100644 index cc6b20ecb0c..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/Hello.hs +++ /dev/null @@ -1,10 +0,0 @@ --- | Module with single foreign export -module MyForeignLib.Hello (sayHi) where - -import MyForeignLib.SomeBindings - -foreign export ccall sayHi :: IO () - --- | Say hi! -sayHi :: IO () -sayHi = putStrLn $ "Hi from a foreign library! Foo has value " ++ show valueOfFoo diff --git a/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/SomeBindings.hsc b/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/SomeBindings.hsc deleted file mode 100644 index beea7f8c49c..00000000000 --- a/cabal-testsuite/PackageTests/Exec/T4049/src/MyForeignLib/SomeBindings.hsc +++ /dev/null @@ -1,10 +0,0 @@ --- | Module that needs the hsc2hs preprocessor -module MyForeignLib.SomeBindings where - -#define FOO 1 - -#ifdef FOO --- | Value guarded by a CPP flag -valueOfFoo :: Int -valueOfFoo = 5678 -#endif diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.out b/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.out deleted file mode 100644 index 3a800edf8b9..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.out +++ /dev/null @@ -1,16 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox-ghc-pkg.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox-ghc-pkg.dist/sandbox -# cabal v1-exec -cabal: The program 'my-executable' is required but it could not be found. -# cabal v1-install -Resolving dependencies... -Configuring my-0.1... -Preprocessing executable 'my-executable' for my-0.1.. -Building executable 'my-executable' for my-0.1.. -Preprocessing library for my-0.1.. -Building library for my-0.1.. -Installing executable my-executable in -Installing library in -Completed my-0.1 -# cabal v1-exec diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.test.hs b/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.test.hs deleted file mode 100644 index 5e0b2baf94f..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-ghc-pkg.test.hs +++ /dev/null @@ -1,12 +0,0 @@ -import Test.Cabal.Prelude -import Data.Maybe -main = cabalTest $ do - withPackageDb $ do - withSandbox $ do - fails $ cabal "v1-exec" ["my-executable"] - cabal "v1-install" [] - -- The library should not be available outside the sandbox - ghcPkg' "list" [] >>= assertOutputDoesNotContain "my-0.1" - -- Execute ghc-pkg inside the sandbox; it should find my-0.1 - cabal' "v1-exec" ["ghc-pkg", "list"] - >>= assertOutputContains "my-0.1" diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.out b/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.out deleted file mode 100644 index 05bc439dd32..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.out +++ /dev/null @@ -1,16 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox-hc-pkg.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox-hc-pkg.dist/sandbox -# cabal v1-exec -cabal: The program 'my-executable' is required but it could not be found. -# cabal v1-install -Resolving dependencies... -Configuring my-0.1... -Preprocessing executable 'my-executable' for my-0.1.. -Building executable 'my-executable' for my-0.1.. -Preprocessing library for my-0.1.. -Building library for my-0.1.. -Installing executable my-executable in -Installing library in -Completed my-0.1 -# cabal v1-exec diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs b/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs deleted file mode 100644 index 57cdb6a365c..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-hc-pkg.test.hs +++ /dev/null @@ -1,26 +0,0 @@ -import Test.Cabal.Prelude -import Data.Maybe -import Distribution.Compat.Directory -import Control.Monad.IO.Class - -main = cabalTest $ do - withPackageDb $ do - withSandbox $ do - fails $ cabal "v1-exec" ["my-executable"] - cabal "v1-install" [] - -- The library should not be available outside the sandbox - ghcPkg' "list" [] >>= assertOutputDoesNotContain "my-0.1" - -- When run inside 'cabal-exec' the 'sandbox hc-pkg list' sub-command - -- should find the library. - env <- getTestEnv - -- NB: cabal_path might be relative, so we have to - -- turn it absolute - rel_cabal_path <- programPathM cabalProgram - cabal_path <- liftIO $ makeAbsolute rel_cabal_path - cabal' "v1-exec" ["sh", "--", "-c" - , "cd subdir && " ++ show cabal_path ++ - -- TODO: Ugh. Test abstractions leaking - -- through - " --sandbox-config-file " ++ show (testSandboxConfigFile env) ++ - " v1-sandbox hc-pkg list"] - >>= assertOutputContains "my-0.1" diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-path.out b/cabal-testsuite/PackageTests/Exec/sandbox-path.out deleted file mode 100644 index 47868be1d19..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-path.out +++ /dev/null @@ -1,16 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox-path.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox-path.dist/sandbox -# cabal v1-exec -cabal: The program 'my-executable' is required but it could not be found. -# cabal v1-install -Resolving dependencies... -Configuring my-0.1... -Preprocessing executable 'my-executable' for my-0.1.. -Building executable 'my-executable' for my-0.1.. -Preprocessing library for my-0.1.. -Building library for my-0.1.. -Installing executable my-executable in -Installing library in -Completed my-0.1 -# cabal v1-exec diff --git a/cabal-testsuite/PackageTests/Exec/sandbox-path.test.hs b/cabal-testsuite/PackageTests/Exec/sandbox-path.test.hs deleted file mode 100644 index 2a13450b9a9..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox-path.test.hs +++ /dev/null @@ -1,8 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - fails $ cabal "v1-exec" ["my-executable"] - cabal "v1-install" [] - -- Execute indirectly via bash to ensure that we go through $PATH - cabal' "v1-exec" ["sh", "--", "-c", "my-executable"] - >>= assertOutputContains "This is my-executable" diff --git a/cabal-testsuite/PackageTests/Exec/sandbox.out b/cabal-testsuite/PackageTests/Exec/sandbox.out deleted file mode 100644 index 589bca8e246..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox.out +++ /dev/null @@ -1,16 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-exec -cabal: The program 'my-executable' is required but it could not be found. -# cabal v1-install -Resolving dependencies... -Configuring my-0.1... -Preprocessing executable 'my-executable' for my-0.1.. -Building executable 'my-executable' for my-0.1.. -Preprocessing library for my-0.1.. -Building library for my-0.1.. -Installing executable my-executable in -Installing library in -Completed my-0.1 -# cabal v1-exec diff --git a/cabal-testsuite/PackageTests/Exec/sandbox.test.hs b/cabal-testsuite/PackageTests/Exec/sandbox.test.hs deleted file mode 100644 index c36c53d4c6d..00000000000 --- a/cabal-testsuite/PackageTests/Exec/sandbox.test.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - fails $ cabal "v1-exec" ["my-executable"] - cabal "v1-install" [] - cabal' "v1-exec" ["my-executable"] - >>= assertOutputContains "This is my-executable" diff --git a/cabal-testsuite/PackageTests/Freeze/freeze.test.hs b/cabal-testsuite/PackageTests/Freeze/freeze.test.hs index 65550b5774d..2961a0e0055 100644 --- a/cabal-testsuite/PackageTests/Freeze/freeze.test.hs +++ b/cabal-testsuite/PackageTests/Freeze/freeze.test.hs @@ -1,8 +1,6 @@ import Test.Cabal.Prelude main = cabalTest $ do withRepo "repo" . withSourceCopy $ do - -- TODO: test this with a sandbox-installed package - -- that is not depended upon cabal "v1-freeze" [] cwd <- fmap testCurrentDir getTestEnv assertFileDoesNotContain (cwd "cabal.config") "exceptions" diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out b/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out deleted file mode 100644 index 744c5827d79..00000000000 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out +++ /dev/null @@ -1,18 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox-shadow.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox-shadow.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -Configuring p-0.1.0.0... -Preprocessing library 'q' for p-0.1.0.0.. -Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. -Preprocessing library for p-0.1.0.0.. -Building library for p-0.1.0.0.. -Installing internal library q in -Installing executable foo in -Installing library in -Completed p-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.test.hs b/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.test.hs deleted file mode 100644 index bc9c97cf810..00000000000 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.test.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - cabal_sandbox "add-source" ["p"] - cabal_sandbox "add-source" ["q"] - cabal "v1-install" ["p"] diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out b/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out deleted file mode 100644 index 39712f79e68..00000000000 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out +++ /dev/null @@ -1,17 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -Configuring p-0.1.0.0... -Preprocessing library 'q' for p-0.1.0.0.. -Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. -Preprocessing library for p-0.1.0.0.. -Building library for p-0.1.0.0.. -Installing internal library q in -Installing executable foo in -Installing library in -Completed p-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.test.hs b/cabal-testsuite/PackageTests/InternalLibraries/sandbox.test.hs deleted file mode 100644 index 6d2eda9bf15..00000000000 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.test.hs +++ /dev/null @@ -1,5 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - cabal_sandbox "add-source" ["p"] - cabal "v1-install" ["p"] diff --git a/cabal-testsuite/PackageTests/Regression/T3199/Cabal/Cabal.cabal b/cabal-testsuite/PackageTests/Regression/T3199/Cabal/Cabal.cabal deleted file mode 100644 index b7d750f4eb2..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/Cabal/Cabal.cabal +++ /dev/null @@ -1,8 +0,0 @@ -name: Cabal -version: 2.0.0.0 -build-type: Simple -cabal-version: >= 1.10 - -library - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Regression/T3199/Main.hs b/cabal-testsuite/PackageTests/Regression/T3199/Main.hs deleted file mode 100644 index 65ae4a05d5d..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/Main.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Main where - -main :: IO () -main = putStrLn "Hello, Haskell!" diff --git a/cabal-testsuite/PackageTests/Regression/T3199/Setup.hs b/cabal-testsuite/PackageTests/Regression/T3199/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/Regression/T3199/sandbox.out b/cabal-testsuite/PackageTests/Regression/T3199/sandbox.out deleted file mode 100644 index ff147725e73..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/sandbox.out +++ /dev/null @@ -1,8 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -In order, the following would be installed: -Cabal-2.0.0.0 (new version) diff --git a/cabal-testsuite/PackageTests/Regression/T3199/sandbox.test.hs b/cabal-testsuite/PackageTests/Regression/T3199/sandbox.test.hs deleted file mode 100644 index 56ae58ea5eb..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/sandbox.test.hs +++ /dev/null @@ -1,11 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - -- 8.0 and up come with sufficiently recent versions of - -- Cabal which don't have this bug. - skipUnless =<< ghcVersionIs (< mkVersion [8,0]) - withSandbox $ do - cabal_sandbox "add-source" ["Cabal"] - cabal "v1-install" - -- Ignore the Cabal library that is under test - ["--package-db=clear", "--package-db=global" - ,"--only-dep", "--dry-run"] diff --git a/cabal-testsuite/PackageTests/Regression/T3199/test-3199.cabal b/cabal-testsuite/PackageTests/Regression/T3199/test-3199.cabal deleted file mode 100644 index 93e94c20bbb..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3199/test-3199.cabal +++ /dev/null @@ -1,27 +0,0 @@ -name: test-t3199 -version: 0.1.0.0 -license: BSD3 -author: Mikhail Glushenkov -maintainer: mikhail.glushenkov@gmail.com -category: Test -build-type: Custom -cabal-version: >=1.10 - -flag exe_2 - description: Build second exe - default: False - -executable test-3199-1 - main-is: Main.hs - build-depends: base - default-language: Haskell2010 - -executable test-3199-2 - main-is: Main.hs - build-depends: base, ansi-terminal - default-language: Haskell2010 - - if flag(exe_2) - buildable: True - else - buildable: False diff --git a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/Cabal.cabal b/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/Cabal.cabal deleted file mode 100644 index 76395b26b8e..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/Cabal.cabal +++ /dev/null @@ -1,8 +0,0 @@ -name: Cabal -version: 1.2 -build-type: Simple -cabal-version: >= 1.2 - -library - build-depends: base - exposed-modules: CabalMessage diff --git a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/CabalMessage.hs b/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/CabalMessage.hs deleted file mode 100644 index 6e1a6484def..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-1.2/CabalMessage.hs +++ /dev/null @@ -1,3 +0,0 @@ -module CabalMessage where - -message = "This is Cabal-1.2" diff --git a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/Cabal.cabal b/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/Cabal.cabal deleted file mode 100644 index 88209657a23..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/Cabal.cabal +++ /dev/null @@ -1,8 +0,0 @@ -name: Cabal -version: 2.0 -build-type: Simple -cabal-version: >= 1.2 - -library - build-depends: base - exposed-modules: CabalMessage diff --git a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/CabalMessage.hs b/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/CabalMessage.hs deleted file mode 100644 index 282d834c9e1..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/Cabal-2.0/CabalMessage.hs +++ /dev/null @@ -1,3 +0,0 @@ -module CabalMessage where - -message = "This is Cabal-2.0" diff --git a/cabal-testsuite/PackageTests/Regression/T3436/cabal.out b/cabal-testsuite/PackageTests/Regression/T3436/cabal.out deleted file mode 100644 index 39f0f8aedff..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/cabal.out +++ /dev/null @@ -1,9 +0,0 @@ -# cabal v2-build -Resolving dependencies... -Build profile: -w ghc- -O1 -In order, the following will be built: - - Cabal-2.0 (lib:Cabal) (first run) - - custom-setup-1.0 (lib:custom-setup) (first run) -Configuring Cabal-2.0... -Preprocessing library for Cabal-2.0.. -Building library for Cabal-2.0.. diff --git a/cabal-testsuite/PackageTests/Regression/T3436/cabal.project b/cabal-testsuite/PackageTests/Regression/T3436/cabal.project deleted file mode 100644 index 0701ffdaa1c..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/cabal.project +++ /dev/null @@ -1 +0,0 @@ -packages: custom-setup Cabal-2.0 diff --git a/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/Setup.hs b/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/Setup.hs deleted file mode 100644 index 86cab0c3e25..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/Setup.hs +++ /dev/null @@ -1,5 +0,0 @@ -import CabalMessage (message) -import System.Exit -import System.IO - -main = hPutStrLn stderr message >> exitFailure diff --git a/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/custom-setup.cabal b/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/custom-setup.cabal deleted file mode 100644 index 62a6149c1d2..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/custom-setup/custom-setup.cabal +++ /dev/null @@ -1,10 +0,0 @@ -cabal-version: 2.0 -name: custom-setup -version: 1.0 -build-type: Custom - -custom-setup - setup-depends: base, Cabal >= 2.0 - -library - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Regression/T3436/sandbox.out b/cabal-testsuite/PackageTests/Regression/T3436/sandbox.out deleted file mode 100644 index 0827756048a..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/sandbox.out +++ /dev/null @@ -1,22 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-install -Resolving dependencies... -Configuring Cabal-1.2... -Preprocessing library for Cabal-1.2.. -Building library for Cabal-1.2.. -Installing library in -Completed Cabal-1.2 -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -Configuring Cabal-2.0... -Preprocessing library for Cabal-2.0.. -Building library for Cabal-2.0.. -Installing library in -Completed Cabal-2.0 -Failed to install custom-setup-1.0 -cabal: Error: some packages failed to install: -custom-setup-1.0-KL06TzJxSBkDtcPp9Xd2v1 failed during the configure step. The exception was: - ExitFailure 1 diff --git a/cabal-testsuite/PackageTests/Regression/T3436/sandbox.test.hs b/cabal-testsuite/PackageTests/Regression/T3436/sandbox.test.hs deleted file mode 100644 index f0124693d73..00000000000 --- a/cabal-testsuite/PackageTests/Regression/T3436/sandbox.test.hs +++ /dev/null @@ -1,21 +0,0 @@ -import Test.Cabal.Prelude - --- Regression test for issue #3436 --- --- #3436 occurred when a package with a custom setup specified a 'cabal-version' --- that was newer than the version of the installed Cabal library, even though --- the solver didn't choose the installed Cabal for the package's setup script. --- --- This test installs a fake Cabal-1.2 and then tries to build the package --- custom-setup, which depends on a fake Cabal-2.0 (through cabal-version and --- setup-depends). -main = cabalTest $ do - withSandbox $ do - cabal "v1-install" ["./Cabal-1.2"] - cabal_sandbox "add-source" ["Cabal-2.0"] - - -- cabal should build custom-setup's setup script with Cabal-2.0, but - -- then configure should fail because Setup just prints an error message - -- imported from Cabal and exits. - r <- fails $ cabal' "v1-install" ["custom-setup/"] - assertOutputContains "This is Cabal-2.0" r diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.out b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.out deleted file mode 100644 index 8c70749b813..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.out +++ /dev/null @@ -1,12 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /cabal.dist/cabal.sandbox.config -Creating a new sandbox at /cabal.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -Configuring q-0.1.0.0... -Preprocessing library for q-0.1.0.0.. -Building library for q-0.1.0.0.. -Installing library in -Completed q-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.test.hs b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.test.hs deleted file mode 100644 index 7ab798e542d..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/cabal.test.hs +++ /dev/null @@ -1,6 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - cabal_sandbox "add-source" ["p"] - cabal_sandbox "add-source" ["q"] - cabal "v1-install" ["q"] diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/LICENSE b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/LICENSE deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/Setup.hs b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/p.cabal b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/p.cabal deleted file mode 100644 index 8fe1d6c6dde..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/p/p.cabal +++ /dev/null @@ -1,11 +0,0 @@ -name: p -version: 0.1.0.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.10 - -library - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/LICENSE b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/LICENSE deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/Setup.hs b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/q.cabal b/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/q.cabal deleted file mode 100644 index 9fb08608ab0..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/MultipleSources/q/q.cabal +++ /dev/null @@ -1,11 +0,0 @@ -name: q -version: 0.1.0.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.10 - -library - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/Main.hs b/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/Main.hs deleted file mode 100644 index 81ff7550980..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/Main.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Q (message) - -main :: IO () -main = do - putStrLn "-----BEGIN CABAL OUTPUT-----" - putStrLn message - putStrLn "-----END CABAL OUTPUT-----" diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/p.cabal b/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/p.cabal deleted file mode 100644 index 66336366775..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/p/p.cabal +++ /dev/null @@ -1,8 +0,0 @@ -name: p -version: 1.0 -build-type: Simple -cabal-version: >= 1.2 - -executable p - main-is: Main.hs - build-depends: q, base diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs b/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs deleted file mode 100644 index f046ba5e428..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs +++ /dev/null @@ -1,4 +0,0 @@ -module Q where - -message :: String -message = "message" diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs.in2 b/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs.in2 deleted file mode 100644 index 930d6400353..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/Q.hs.in2 +++ /dev/null @@ -1,4 +0,0 @@ -module Q where - -message :: String -message = "message updated" diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/q.cabal b/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/q.cabal deleted file mode 100644 index 79b1cf734d2..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/q/q.cabal +++ /dev/null @@ -1,8 +0,0 @@ -name: q -version: 1.0 -build-type: Simple -cabal-version: >= 1.2 - -library - build-depends: base - exposed-modules: Q diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.out b/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.out deleted file mode 100644 index 59c4220549b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.out +++ /dev/null @@ -1,15 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-install -Resolving dependencies... -Configuring q-1.0... -Preprocessing library for q-1.0.. -Building library for q-1.0.. -Installing library in -Completed q-1.0 -# cabal v1-run -message -# cabal v1-run -message updated diff --git a/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.test.hs b/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.test.hs deleted file mode 100644 index d29ed4dd66c..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Reinstall/sandbox.test.hs +++ /dev/null @@ -1,9 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSourceCopy . withDelay . withDirectory "p" . withSandbox $ do - cabal_sandbox "add-source" ["../q"] - cabal "v1-install" ["--only-dependencies"] - recordMode RecordMarked $ cabal "v1-run" ["p", "-v0"] - delay - copySourceFileTo "../q/Q.hs.in2" "../q/Q.hs" - recordMode RecordMarked $ cabal "v1-run" ["p", "-v0"] diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/p/LICENSE b/cabal-testsuite/PackageTests/Sandbox/Sources/p/LICENSE deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/p/Setup.hs b/cabal-testsuite/PackageTests/Sandbox/Sources/p/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/p/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/p/p.cabal b/cabal-testsuite/PackageTests/Sandbox/Sources/p/p.cabal deleted file mode 100644 index 8fe1d6c6dde..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/p/p.cabal +++ /dev/null @@ -1,11 +0,0 @@ -name: p -version: 0.1.0.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.10 - -library - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/q/LICENSE b/cabal-testsuite/PackageTests/Sandbox/Sources/q/LICENSE deleted file mode 100644 index e69de29bb2d..00000000000 diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/q/Setup.hs b/cabal-testsuite/PackageTests/Sandbox/Sources/q/Setup.hs deleted file mode 100644 index 9a994af677b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/q/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/q/q.cabal b/cabal-testsuite/PackageTests/Sandbox/Sources/q/q.cabal deleted file mode 100644 index 9fb08608ab0..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/q/q.cabal +++ /dev/null @@ -1,11 +0,0 @@ -name: q -version: 0.1.0.0 -license-file: LICENSE -author: Edward Z. Yang -maintainer: ezyang@cs.stanford.edu -build-type: Simple -cabal-version: >=1.10 - -library - build-depends: base - default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.out b/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.out deleted file mode 100644 index 0327f06173b..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.out +++ /dev/null @@ -1,15 +0,0 @@ -# cabal v1-sandbox init -Writing a default package environment file to /sandbox.dist/cabal.sandbox.config -Creating a new sandbox at /sandbox.dist/sandbox -# cabal v1-sandbox add-source -# cabal v1-sandbox delete-source -Warning: Sources not registered: "q" - -cabal: The sources with the above errors were skipped. ("q") -# cabal v1-sandbox add-source -# cabal v1-sandbox delete-source -Success deleting sources: "p" "q" - -Note: 'sandbox delete-source' only unregisters the source dependency, but does not remove the package from the sandbox package DB. - -Use 'sandbox hc-pkg -- unregister' to do that. diff --git a/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.test.hs b/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.test.hs deleted file mode 100644 index 693972937ec..00000000000 --- a/cabal-testsuite/PackageTests/Sandbox/Sources/sandbox.test.hs +++ /dev/null @@ -1,7 +0,0 @@ -import Test.Cabal.Prelude -main = cabalTest $ do - withSandbox $ do - cabal_sandbox "add-source" ["p"] - fails $ cabal_sandbox "delete-source" ["q"] - cabal_sandbox "add-source" ["q"] - cabal_sandbox "delete-source" ["p", "q"] diff --git a/cabal-testsuite/src/Test/Cabal/Monad.hs b/cabal-testsuite/src/Test/Cabal/Monad.hs index 839beb866e2..19695aaa37b 100644 --- a/cabal-testsuite/src/Test/Cabal/Monad.hs +++ b/cabal-testsuite/src/Test/Cabal/Monad.hs @@ -29,8 +29,6 @@ module Test.Cabal.Monad ( testPrefixDir, testDistDir, testPackageDbDir, - testSandboxDir, - testSandboxConfigFile, testRepoDir, testKeysDir, testSourceCopyDir, @@ -331,7 +329,6 @@ runTestM mode m = withSystemTempDirectory "cabal-testsuite" $ \tmp_dir -> do testShouldFail = False, testRelativeCurrentDir = ".", testHavePackageDb = False, - testHaveSandbox = False, testHaveRepo = False, testHaveSourceCopy = False, testCabalInstallAsSetup = False, @@ -508,8 +505,6 @@ data TestEnv = TestEnv , testRelativeCurrentDir :: FilePath -- | Says if we've initialized the per-test package DB , testHavePackageDb :: Bool - -- | Says if we're working in a sandbox - , testHaveSandbox :: Bool -- | Says if we've setup a repository , testHaveRepo :: Bool -- | Says if we've copied the source to a hermetic directory @@ -581,14 +576,6 @@ testPackageDbDir env = testWorkDir env "packagedb" testHomeDir :: TestEnv -> FilePath testHomeDir env = testWorkDir env "home" --- | The absolute prefix of our sandbox directory -testSandboxDir :: TestEnv -> FilePath -testSandboxDir env = testWorkDir env "sandbox" - --- | The sandbox configuration file -testSandboxConfigFile :: TestEnv -> FilePath -testSandboxConfigFile env = testWorkDir env "cabal.sandbox.config" - -- | The absolute prefix of our local secure repository, which we -- use to simulate "external" packages testRepoDir :: TestEnv -> FilePath diff --git a/cabal-testsuite/src/Test/Cabal/Prelude.hs b/cabal-testsuite/src/Test/Cabal/Prelude.hs index 2b51b203902..68340059bdc 100644 --- a/cabal-testsuite/src/Test/Cabal/Prelude.hs +++ b/cabal-testsuite/src/Test/Cabal/Prelude.hs @@ -252,8 +252,6 @@ packageDBParams dbs = "--package-db=clear" -- * Running cabal cabal :: String -> [String] -> TestM () -cabal "sandbox" _ = - error "Use cabal_sandbox instead" cabal cmd args = void (cabal' cmd args) cabal' :: String -> [String] -> TestM Result @@ -263,42 +261,33 @@ cabalG :: [String] -> String -> [String] -> TestM () cabalG global_args cmd args = void (cabalG' global_args cmd args) cabalG' :: [String] -> String -> [String] -> TestM Result -cabalG' _ "sandbox" _ = - -- NB: We don't just auto-pass this through, because it's - -- possible that the first argument isn't the sub-sub-command. - -- So make sure the user specifies it correctly. - error "Use cabal_sandbox' instead" cabalG' global_args cmd args = do env <- getTestEnv -- Freeze writes out cabal.config to source directory, this is not -- overwritable when (cmd == "v1-freeze") requireHasSourceCopy let extra_args - -- Sandboxes manage dist dir - | testHaveSandbox env - = install_args | cmd `elem` ["v1-update", "outdated", "user-config", "man", "v1-freeze", "check"] = [ ] + -- new-build commands are affected by testCabalProjectFile - | cmd == "v2-sdist" = [ "--project-file", testCabalProjectFile env ] + | cmd == "v2-sdist" + = [ "--project-file", testCabalProjectFile env ] + | "v2-" `isPrefixOf` cmd = [ "--builddir", testDistDir env , "--project-file", testCabalProjectFile env , "-j1" ] + | otherwise = [ "--builddir", testDistDir env ] ++ install_args + install_args - | cmd == "v1-install" - || cmd == "v1-build" = [ "-j1" ] - | otherwise = [] - extra_global_args - | testHaveSandbox env - = [ "--sandbox-config-file", testSandboxConfigFile env ] - | otherwise - = [] - cabal_args = extra_global_args - ++ global_args + | cmd == "v1-install" || cmd == "v1-build" = [ "-j1" ] + | otherwise = [] + + cabal_args = global_args ++ [ cmd, marked_verbose ] ++ extra_args ++ args @@ -306,30 +295,9 @@ cabalG' global_args cmd args = do recordHeader ["cabal", cmd] cabal_raw' cabal_args -cabal_sandbox :: String -> [String] -> TestM () -cabal_sandbox cmd args = void $ cabal_sandbox' cmd args - -cabal_sandbox' :: String -> [String] -> TestM Result -cabal_sandbox' cmd args = do - env <- getTestEnv - let cabal_args = [ "--sandbox-config-file", testSandboxConfigFile env - , "v1-sandbox", cmd - , marked_verbose ] - ++ args - defaultRecordMode RecordMarked $ do - recordHeader ["cabal", "v1-sandbox", cmd] - cabal_raw' cabal_args - cabal_raw' :: [String] -> TestM Result cabal_raw' cabal_args = runProgramM cabalProgram cabal_args -withSandbox :: TestM a -> TestM a -withSandbox m = do - env0 <- getTestEnv - -- void $ cabal_raw' ["sandbox", "init", "--sandbox", testSandboxDir env0] - cabal_sandbox "init" ["--sandbox", testSandboxDir env0] - withReaderT (\env -> env { testHaveSandbox = True }) m - withProjectFile :: FilePath -> TestM a -> TestM a withProjectFile fp m = withReaderT (\env -> env { testCabalProjectFile = fp }) m