Skip to content

Commit

Permalink
Merge pull request #3495 from rjmk/revert-construct-plan-logic
Browse files Browse the repository at this point in the history
Revert "Clean up --only-dependencies logic in ConstructPlan"
  • Loading branch information
mgsloan authored Oct 17, 2017
2 parents 79341d5 + 9975dbe commit 154e547
Show file tree
Hide file tree
Showing 2 changed files with 23 additions and 18 deletions.
3 changes: 3 additions & 0 deletions ChangeLog.md
Original file line number Diff line number Diff line change
Expand Up @@ -142,6 +142,9 @@ Bug fixes:
[#3376](https://github.com/commercialhaskell/stack/issues/3376).
* `stack clean` now works with nix. See
[#3468](https://github.com/commercialhaskell/stack/issues/3376).
* `stack build --only-dependencies` no longer builds local project packages
that are depended on. See
[#3476](https://github.com/commercialhaskell/stack/issues/3476).


## 1.5.1
Expand Down
38 changes: 20 additions & 18 deletions src/Stack/Build/ConstructPlan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -332,7 +332,7 @@ mkUnregisterLocal tasks dirtyReason localDumpPkgs sourceMap initialBuildSteps =
-- step.
addFinal :: LocalPackage -> Package -> Bool -> M ()
addFinal lp package isAllInOne = do
depsRes <- addPackageDeps package
depsRes <- addPackageDeps False package
res <- case depsRes of
Left e -> return $ Left e
Right (missing, present, _minLoc) -> do
Expand Down Expand Up @@ -402,10 +402,10 @@ addDep treatAsDep' name = do
return $ Right $ ADRFound loc installed
Just (PIOnlySource ps) -> do
tellExecutables ps
installPackage name ps Nothing
installPackage treatAsDep name ps Nothing
Just (PIBoth ps installed) -> do
tellExecutables ps
installPackage name ps (Just installed)
installPackage treatAsDep name ps (Just installed)
updateLibMap name res
return res

Expand Down Expand Up @@ -450,30 +450,30 @@ tellExecutablesPackage loc p = do

-- | Given a 'PackageSource' and perhaps an 'Installed' value, adds
-- build 'Task's for the package and its dependencies.
installPackage
:: PackageName
-> PackageSource
-> Maybe Installed
-> M (Either ConstructPlanException AddDepRes)
installPackage name ps minstalled = do
installPackage :: Bool -- ^ is this being used by a dependency?
-> PackageName
-> PackageSource
-> Maybe Installed
-> M (Either ConstructPlanException AddDepRes)
installPackage treatAsDep name ps minstalled = do
ctx <- ask
case ps of
PSIndex _ flags ghcOptions pkgLoc -> do
planDebug $ "installPackage: Doing all-in-one build for upstream package " ++ show name
package <- liftIO $ loadPackage ctx (PLIndex pkgLoc) flags ghcOptions -- FIXME be more efficient! Get this from the LoadedPackageInfo!
resolveDepsAndInstall True ps package minstalled
resolveDepsAndInstall True treatAsDep ps package minstalled
PSFiles lp _ ->
case lpTestBench lp of
Nothing -> do
planDebug $ "installPackage: No test / bench component for " ++ show name ++ " so doing an all-in-one build."
resolveDepsAndInstall True ps (lpPackage lp) minstalled
resolveDepsAndInstall True treatAsDep ps (lpPackage lp) minstalled
Just tb -> do
-- Attempt to find a plan which performs an all-in-one
-- build. Ignore the writer action + reset the state if
-- it fails.
s <- get
res <- pass $ do
res <- addPackageDeps tb
res <- addPackageDeps treatAsDep tb
let writerFunc w = case res of
Left _ -> mempty
_ -> w
Expand All @@ -494,7 +494,7 @@ installPackage name ps minstalled = do
put s
-- Otherwise, fall back on building the
-- tests / benchmarks in a separate step.
res' <- resolveDepsAndInstall False ps (lpPackage lp) minstalled
res' <- resolveDepsAndInstall False treatAsDep ps (lpPackage lp) minstalled
when (isRight res') $ do
-- Insert it into the map so that it's
-- available for addFinal.
Expand All @@ -503,12 +503,13 @@ installPackage name ps minstalled = do
return res'

resolveDepsAndInstall :: Bool
-> Bool
-> PackageSource
-> Package
-> Maybe Installed
-> M (Either ConstructPlanException AddDepRes)
resolveDepsAndInstall isAllInOne ps package minstalled = do
res <- addPackageDeps package
resolveDepsAndInstall isAllInOne treatAsDep ps package minstalled = do
res <- addPackageDeps treatAsDep package
case res of
Left err -> return $ Left err
Right deps -> liftM Right $ installPackageGivenDeps isAllInOne ps package minstalled deps
Expand Down Expand Up @@ -586,12 +587,13 @@ addEllipsis t
-- then the parent package must be installed locally. Otherwise, if it
-- is 'Snap', then it can either be installed locally or in the
-- snapshot.
addPackageDeps :: Package -> M (Either ConstructPlanException (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, InstallLocation))
addPackageDeps package = do
addPackageDeps :: Bool -- ^ is this being used by a dependency?
-> Package -> M (Either ConstructPlanException (Set PackageIdentifier, Map PackageIdentifier GhcPkgId, InstallLocation))
addPackageDeps treatAsDep package = do
ctx <- ask
deps' <- packageDepsWithTools package
deps <- forM (Map.toList deps') $ \(depname, range) -> do
eres <- addDep True depname
eres <- addDep treatAsDep depname
let getLatestApplicable = do
vs <- liftIO $ getVersions ctx depname
return (latestApplicableVersion range vs)
Expand Down

0 comments on commit 154e547

Please sign in to comment.