diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs
index d36b47381d4e2b68a0cdf3eb09dacbd1b0ddb526..fabfdffd8f4d0140ef38f9920b13bcda5f14712b 100644
--- a/cabal-install/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/Distribution/Client/CmdInstall.hs
@@ -546,6 +546,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags
config
tmpDir
(envSpecs ++ specs)
+ InstallCommand
buildCtx <-
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
@@ -828,9 +829,10 @@ establishDummyProjectBaseContext
-- ^ Where to put the dist directory
-> [PackageSpecifier UnresolvedSourcePackage]
-- ^ The packages to be included in the project
+ -> CurrentCommand
-> IO ProjectBaseContext
-establishDummyProjectBaseContext verbosity cliConfig tmpDir localPackages = do
-
+establishDummyProjectBaseContext verbosity cliConfig tmpDir
+ localPackages currentCommand = do
cabalDir <- getCabalDir
-- Create the dist directories
@@ -860,8 +862,6 @@ establishDummyProjectBaseContext verbosity cliConfig tmpDir localPackages = do
verbosity cabalDirLayout
projectConfig
- currentCommand = InstallCommand
-
return ProjectBaseContext {
distDirLayout,
cabalDirLayout,
diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs
index 8429c723af2880fb3af399ea9362606e8c5fd211..3eaaab25e34307ceadf2bece66f513f95a6a7e54 100644
--- a/cabal-install/Distribution/Client/CmdRepl.hs
+++ b/cabal-install/Distribution/Client/CmdRepl.hs
@@ -50,6 +50,10 @@ import Distribution.Simple.Setup
import Distribution.Simple.Command
( CommandUI(..), liftOption, usageAlternatives, option
, ShowOrParseArgs, OptionField, reqArg )
+import Distribution.Compiler
+ ( CompilerFlavor(GHC) )
+import Distribution.Simple.Compiler
+ ( compilerCompatVersion )
import Distribution.Package
( Package(..), packageName, UnitId, installedUnitId )
import Distribution.PackageDescription.PrettyPrint
@@ -98,7 +102,7 @@ import Data.List
import qualified Data.Map as Map
import qualified Data.Set as Set
import System.Directory
- ( getTemporaryDirectory, removeDirectoryRecursive )
+ ( getCurrentDirectory, getTemporaryDirectory, removeDirectoryRecursive )
import System.FilePath
( (</>) )
@@ -219,7 +223,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r
with = withProject cliConfig verbosity targetStrings
without config = withoutProject (config <> cliConfig) verbosity targetStrings
- (baseCtx, targetSelectors, finalizer) <- if ignoreProject
+ (baseCtx, targetSelectors, finalizer, replType) <- if ignoreProject
then do
globalConfig <- runRebuild "" $ readGlobalConfig verbosity globalConfigFlag
without globalConfig
@@ -256,7 +260,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r
-- In addition, to avoid a *third* trip through the solver, we are
-- replicating the second half of 'runProjectPreBuildPhase' by hand
-- here.
- (buildCtx, replFlags') <- withInstallPlan verbosity baseCtx' $
+ (buildCtx, replFlags'') <- withInstallPlan verbosity baseCtx' $
\elaboratedPlan elaboratedShared' -> do
let ProjectBaseContext{..} = baseCtx'
@@ -269,9 +273,6 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r
targets
elaboratedPlan
includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags)
- replFlags' = case originalComponent of
- Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci
- Nothing -> []
pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared'
elaboratedPlan'
@@ -288,11 +289,27 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags, r
, pkgsBuildStatus
, targetsMap = targets
}
- return (buildCtx, replFlags')
+
+ ElaboratedSharedConfig { pkgConfigCompiler = compiler } = elaboratedShared'
+
+ -- First version of GHC where GHCi supported the flag we need.
+ -- https://downloads.haskell.org/~ghc/7.6.1/docs/html/users_guide/release-7-6-1.html
+ minGhciScriptVersion = mkVersion [7, 6]
+
+ replFlags' = case originalComponent of
+ Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci
+ Nothing -> []
+ replFlags'' = case replType of
+ GlobalRepl scriptPath
+ | Just version <- compilerCompatVersion GHC compiler
+ , version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags'
+ _ -> replFlags'
+
+ return (buildCtx, replFlags'')
let buildCtx' = buildCtx
{ elaboratedShared = (elaboratedShared buildCtx)
- { pkgConfigReplOptions = replFlags ++ replFlags' }
+ { pkgConfigReplOptions = replFlags ++ replFlags'' }
}
printPlan verbosity baseCtx' buildCtx'
@@ -335,16 +352,26 @@ data OriginalComponentInfo = OriginalComponentInfo
}
deriving (Show)
-withProject :: ProjectConfig -> Verbosity -> [String] -> IO (ProjectBaseContext, [TargetSelector], IO ())
+-- | Tracks what type of GHCi instance we're creating.
+data ReplType = ProjectRepl
+ | GlobalRepl FilePath -- ^ The 'FilePath' argument is path to a GHCi
+ -- script responsible for changing to the
+ -- correct directory. Only works on GHC geq
+ -- 7.6, though. ðŸ™
+ deriving (Show, Eq)
+
+withProject :: ProjectConfig -> Verbosity -> [String]
+ -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType)
withProject cliConfig verbosity targetStrings = do
baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
=<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings
- return (baseCtx, targetSelectors, return ())
+ return (baseCtx, targetSelectors, return (), ProjectRepl)
-withoutProject :: ProjectConfig -> Verbosity -> [String] -> IO (ProjectBaseContext, [TargetSelector], IO ())
+withoutProject :: ProjectConfig -> Verbosity -> [String]
+ -> IO (ProjectBaseContext, [TargetSelector], IO (), ReplType)
withoutProject config verbosity extraArgs = do
unless (null extraArgs) $
die' verbosity $ "'repl' doesn't take any extra arguments when outside a project: " ++ unwords extraArgs
@@ -378,18 +405,23 @@ withoutProject config verbosity extraArgs = do
writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription
+ let ghciScriptPath = tempDir </> "setcwd.ghci"
+ cwd <- getCurrentDirectory
+ writeFile ghciScriptPath (":cd " ++ cwd)
+
baseCtx <-
establishDummyProjectBaseContext
verbosity
config
tempDir
[SpecificSourcePackage sourcePackage]
+ OtherCommand
let
targetSelectors = [TargetPackage TargetExplicitNamed [pkgId] Nothing]
finalizer = handleDoesNotExist () (removeDirectoryRecursive tempDir)
- return (baseCtx, targetSelectors, finalizer)
+ return (baseCtx, targetSelectors, finalizer, GlobalRepl ghciScriptPath)
addDepsToProjectTarget :: [Dependency]
-> PackageId
diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs
index 9e53f41a77e56a46fb0f4fbad2ee0b409d96e7d1..6cc183637c394b124411c8ef61e81f26a2f149f0 100644
--- a/cabal-install/Distribution/Client/CmdRun.hs
+++ b/cabal-install/Distribution/Client/CmdRun.hs
@@ -164,7 +164,7 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags, testFlags)
with =
establishProjectBaseContext verbosity cliConfig OtherCommand
without config =
- establishDummyProjectBaseContext verbosity (config <> cliConfig) tempDir []
+ establishDummyProjectBaseContext verbosity (config <> cliConfig) tempDir [] OtherCommand
baseCtx <- withProjectOrGlobalConfig verbosity globalConfigFlag with without
diff --git a/cabal-install/changelog b/cabal-install/changelog
index 4993ed2029e01d2f0d9d138ab6e4f90c558b264a..16f684b63909fb6cbc9a45f6d5600a58f4667cdc 100644
--- a/cabal-install/changelog
+++ b/cabal-install/changelog
@@ -1,6 +1,8 @@
-*-change-log-*-
3.0.0.0 (current development version)
+ * `v2-repl` no longer changes directory to a randomized temporary folder
+ when used outside of a project. (#5544)
* `install-method` and `overwrite-policy` in `.cabal/config` now actually work. (#5942)
* `v2-install` now reports the error when a package fails to build. (#5641)
* `v2-install` now has a default when called in a project (#5978, #6014, #6092)