Skip to content

Commit

Permalink
update --build-depends help string
Browse files Browse the repository at this point in the history
  • Loading branch information
emilypi committed Apr 11, 2020
1 parent 9894516 commit 85d9acf
Showing 1 changed file with 28 additions and 29 deletions.
57 changes: 28 additions & 29 deletions cabal-install/Distribution/Client/CmdRepl.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ import Distribution.Client.ProjectConfig
( ProjectConfig(..), withProjectOrGlobalConfigIgn
, projectConfigConfigFile )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
import Distribution.Client.ProjectPlanning
( ElaboratedSharedConfig(..), ElaboratedInstallPlan )
import Distribution.Client.ProjectPlanning.Types
( elabOrderExeDependencies )
Expand Down Expand Up @@ -109,7 +109,7 @@ import System.FilePath

type ReplFlags = [String]

data EnvFlags = EnvFlags
data EnvFlags = EnvFlags
{ envPackages :: [Dependency]
, envIncludeTransitive :: Flag Bool
, envIgnoreProject :: Flag Bool
Expand All @@ -125,9 +125,9 @@ defaultEnvFlags = EnvFlags
envOptions :: ShowOrParseArgs -> [OptionField EnvFlags]
envOptions _ =
[ option ['b'] ["build-depends"]
"Include an additional package in the environment presented to GHCi."
"Include additional packages in the environment presented to GHCi."
envPackages (\p flags -> flags { envPackages = p ++ envPackages flags })
(reqArg "DEPENDENCY" dependencyReadE (fmap prettyShow :: [Dependency] -> [String]))
(reqArg "DEPENDENCIES" dependencyReadE (fmap prettyShow :: [Dependency] -> [String]))
, option [] ["no-transitive-deps"]
"Don't automatically include transitive dependencies of requested packages."
envIncludeTransitive (\p flags -> flags { envIncludeTransitive = p })
Expand Down Expand Up @@ -234,7 +234,7 @@ replAction ( configFlags, configExFlags, installFlags
ignoreProject = fromFlagOrDefault False (envIgnoreProject envFlags)
with = withProject cliConfig verbosity targetStrings
without config = withoutProject (config <> cliConfig) verbosity targetStrings

(baseCtx, targetSelectors, finalizer, replType) <-
withProjectOrGlobalConfigIgn ignoreProject verbosity globalConfigFlag with without

Expand All @@ -252,65 +252,65 @@ replAction ( configFlags, configExFlags, installFlags
withInstallPlan (lessVerbose verbosity) baseCtx $ \elaboratedPlan _ -> do
-- targets should be non-empty map, but there's no NonEmptyMap yet.
targets <- validatedTargets elaboratedPlan targetSelectors

let
(unitId, _) = fromMaybe (error "panic: targets should be non-empty") $ safeHead $ Map.toList targets
originalDeps = installedUnitId <$> InstallPlan.directDeps elaboratedPlan unitId
oci = OriginalComponentInfo unitId originalDeps
pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId
pkgId = fromMaybe (error $ "cannot find " ++ prettyShow unitId) $ packageId <$> InstallPlan.lookup elaboratedPlan unitId
baseCtx' = addDepsToProjectTarget (envPackages envFlags) pkgId baseCtx

return (Just oci, baseCtx')
-- Now, we run the solver again with the added packages. While the graph

-- Now, we run the solver again with the added packages. While the graph
-- won't actually reflect the addition of transitive dependencies,
-- they're going to be available already and will be offered to the REPL
-- and that's good enough.
--
-- In addition, to avoid a *third* trip through the solver, we are
-- 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' $
\elaboratedPlan elaboratedShared' -> do
let ProjectBaseContext{..} = baseCtx'

-- Recalculate with updated project.
targets <- validatedTargets elaboratedPlan targetSelectors

let
let
elaboratedPlan' = pruneInstallPlanToTargets
TargetActionRepl
targets
elaboratedPlan
includeTransitive = fromFlagOrDefault True (envIncludeTransitive envFlags)

pkgsBuildStatus <- rebuildTargetsDryRun distDirLayout elaboratedShared'
elaboratedPlan'

let elaboratedPlan'' = improveInstallPlanWithUpToDatePackages
pkgsBuildStatus elaboratedPlan'
debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan'')

let
buildCtx = ProjectBuildContext
let
buildCtx = ProjectBuildContext
{ elaboratedPlanOriginal = elaboratedPlan
, elaboratedPlanToExecute = elaboratedPlan''
, elaboratedShared = elaboratedShared'
, pkgsBuildStatus
, targetsMap = targets
}

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
replFlags' = case originalComponent of
Just oci -> generateReplFlags includeTransitive elaboratedPlan' oci
Nothing -> []
replFlags'' = case replType of
GlobalRepl scriptPath
GlobalRepl scriptPath
| Just version <- compilerCompatVersion GHC compiler
, version >= minGhciScriptVersion -> ("-ghci-script" ++ scriptPath) : replFlags'
_ -> replFlags'
Expand All @@ -334,7 +334,7 @@ replAction ( configFlags, configExFlags, installFlags
mempty -- ClientInstallFlags, not needed here
haddockFlags testFlags benchmarkFlags
globalConfigFlag = projectConfigConfigFile (projectConfigShared cliConfig)

validatedTargets elaboratedPlan targetSelectors = do
-- Interpret the targets on the command line as repl targets
-- (as opposed to say build or haddock targets).
Expand Down Expand Up @@ -363,7 +363,7 @@ data OriginalComponentInfo = OriginalComponentInfo
deriving (Show)

-- | Tracks what type of GHCi instance we're creating.
data ReplType = ProjectRepl
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
Expand Down Expand Up @@ -397,7 +397,7 @@ withoutProject config verbosity extraArgs = do
, packageSource = LocalUnpackedPackage tempDir
, packageDescrOverride = Nothing
}
genericPackageDescription = emptyGenericPackageDescription
genericPackageDescription = emptyGenericPackageDescription
& L.packageDescription .~ packageDescription
& L.condLibrary .~ Just (CondNode library [baseDep] [])
packageDescription = emptyPackageDescription
Expand All @@ -414,13 +414,13 @@ withoutProject config verbosity extraArgs = do
pkgId = fakePackageId

writeGenericPackageDescription (tempDir </> "fake-package.cabal") genericPackageDescription

let ghciScriptPath = tempDir </> "setcwd.ghci"
cwd <- getCurrentDirectory
writeFile ghciScriptPath (":cd " ++ cwd)

distDirLayout <- establishDummyDistDirLayout verbosity config tempDir
baseCtx <-
baseCtx <-
establishDummyProjectBaseContext
verbosity
config
Expand All @@ -438,15 +438,15 @@ addDepsToProjectTarget :: [Dependency]
-> PackageId
-> ProjectBaseContext
-> ProjectBaseContext
addDepsToProjectTarget deps pkgId ctx =
addDepsToProjectTarget deps pkgId ctx =
(\p -> ctx { localPackages = p }) . fmap addDeps . localPackages $ ctx
where
addDeps :: PackageSpecifier UnresolvedSourcePackage
-> PackageSpecifier UnresolvedSourcePackage
addDeps (SpecificSourcePackage pkg)
| packageId pkg /= pkgId = SpecificSourcePackage pkg
| SourcePackage{..} <- pkg =
SpecificSourcePackage $ pkg { packageDescription =
SpecificSourcePackage $ pkg { packageDescription =
packageDescription & (\f -> L.allCondTrees $ traverseCondTreeC f)
%~ (deps ++)
}
Expand All @@ -456,8 +456,8 @@ generateReplFlags :: Bool -> ElaboratedInstallPlan -> OriginalComponentInfo -> R
generateReplFlags includeTransitive elaboratedPlan OriginalComponentInfo{..} = flags
where
exeDeps :: [UnitId]
exeDeps =
foldMap
exeDeps =
foldMap
(InstallPlan.foldPlanPackage (const []) elabOrderExeDependencies)
(InstallPlan.dependencyClosure elaboratedPlan [ociUnitId])

Expand Down Expand Up @@ -621,4 +621,3 @@ explanationSingleComponentLimitation =
"The reason for this limitation is that current versions of ghci do not "
++ "support loading multiple components as source. Load just one component "
++ "and when you make changes to a dependent component then quit and reload."

0 comments on commit 85d9acf

Please sign in to comment.