~fgaz/cabal

fef6d8d40e7a5eb72f1fb19b59e88f0b22b6fcea — Alexis Williams 1 year, 1 month ago 4d2ca52
Fix `v2-repl` changing directory incorrectly. (#6115)

* Fix `v2-repl` changing directory incorrectly.

* Add changelog entry

* Add haddocks

* Add check for GHC geq 7.6 (`-ghci-script` wasn't there yet)
M cabal-install/Distribution/Client/CmdInstall.hs => cabal-install/Distribution/Client/CmdInstall.hs +4 -4
@@ 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,

M cabal-install/Distribution/Client/CmdRepl.hs => cabal-install/Distribution/Client/CmdRepl.hs +44 -12
@@ 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

M cabal-install/Distribution/Client/CmdRun.hs => cabal-install/Distribution/Client/CmdRun.hs +1 -1
@@ 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


M cabal-install/changelog => cabal-install/changelog +2 -0
@@ 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)