From bae4b41c02e13cd921aaa595ac7a7aeaebb79485 Mon Sep 17 00:00:00 2001
From: Alexis Williams <alexis@typedr.at>
Date: Tue, 12 Jun 2018 16:16:59 -0700
Subject: [PATCH] Allow resolveTargets to know about Hackage packages
---
cabal-install/Distribution/Client/CmdBench.hs | 1 +
cabal-install/Distribution/Client/CmdBuild.hs | 1 +
.../Distribution/Client/CmdErrorMessages.hs | 6 +++++
.../Distribution/Client/CmdHaddock.hs | 1 +
.../Distribution/Client/CmdInstall.hs | 1 +
cabal-install/Distribution/Client/CmdRepl.hs | 1 +
cabal-install/Distribution/Client/CmdRun.hs | 1 +
cabal-install/Distribution/Client/CmdTest.hs | 1 +
.../Client/ProjectOrchestration.hs | 26 ++++++++++---------
cabal-install/tests/IntegrationTests2.hs | 4 ++-
10 files changed, 30 insertions(+), 13 deletions(-)
diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs
index 1272c02371..80afb42319 100644
--- a/cabal-install/Distribution/Client/CmdBench.hs
+++ b/cabal-install/Distribution/Client/CmdBench.hs
@@ -100,6 +100,7 @@ benchAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs
index a6235499af..8186635f9a 100644
--- a/cabal-install/Distribution/Client/CmdBuild.hs
+++ b/cabal-install/Distribution/Client/CmdBuild.hs
@@ -91,6 +91,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs
index d20d84eaeb..f11057d029 100644
--- a/cabal-install/Distribution/Client/CmdErrorMessages.hs
+++ b/cabal-install/Distribution/Client/CmdErrorMessages.hs
@@ -197,6 +197,12 @@ renderTargetProblemCommon verb (TargetNotInProject pkgname) =
++ "in this project (either directly or indirectly). If you want to add it "
++ "to the project then edit the cabal.project file."
+renderTargetProblemCommon verb (TargetAvailableInIndex pkgname) =
+ "Cannot " ++ verb ++ " the package " ++ display pkgname ++ ", it is not "
+ ++ "in this project (either directly or indirectly), but it is in the current "
+ ++ "package index. If you want to add it to the project then edit the "
+ ++ "cabal.project file."
+
renderTargetProblemCommon verb (TargetComponentNotProjectLocal pkgid cname _) =
"Cannot " ++ verb ++ " the " ++ showComponentName cname ++ " because the "
++ "package " ++ display pkgid ++ " is not local to the project, and cabal "
diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs
index 74d206db9b..aa6256ec37 100644
--- a/cabal-install/Distribution/Client/CmdHaddock.hs
+++ b/cabal-install/Distribution/Client/CmdHaddock.hs
@@ -94,6 +94,7 @@ haddockAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs
index 8460a28ea3..806f00f982 100644
--- a/cabal-install/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/Distribution/Client/CmdInstall.hs
@@ -161,6 +161,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs
index 1c226399c9..26bb63ce17 100644
--- a/cabal-install/Distribution/Client/CmdRepl.hs
+++ b/cabal-install/Distribution/Client/CmdRepl.hs
@@ -126,6 +126,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, replArgs)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs
index db6ade9eb3..a40cec2f1a 100644
--- a/cabal-install/Distribution/Client/CmdRun.hs
+++ b/cabal-install/Distribution/Client/CmdRun.hs
@@ -130,6 +130,7 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs
index 9d95979619..451379aeb4 100644
--- a/cabal-install/Distribution/Client/CmdTest.hs
+++ b/cabal-install/Distribution/Client/CmdTest.hs
@@ -106,6 +106,7 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
+ Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs
index fd17a548e7..404878a2ba 100644
--- a/cabal-install/Distribution/Client/ProjectOrchestration.hs
+++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs
@@ -108,7 +108,10 @@ import Distribution.Client.ProjectPlanOutput
import Distribution.Client.Types
( GenericReadyPackage(..), UnresolvedSourcePackage
- , PackageSpecifier(..) )
+ , PackageSpecifier(..)
+ , SourcePackageDb(..) )
+import Distribution.Solver.Types.PackageIndex
+ ( lookupPackageName )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.TargetSelector
( TargetSelector(..)
@@ -148,6 +151,7 @@ import qualified Data.Monoid as Mon
import qualified Data.Set as Set
import qualified Data.Map as Map
import Data.Either
+import Data.Maybe ( isJust, fromJust )
import Control.Exception (Exception(..), throwIO, assert)
import System.Exit (ExitCode(..), exitFailure)
#ifdef MIN_VERSION_unix
@@ -440,17 +444,11 @@ resolveTargets :: forall err.
-> Either err k )
-> (TargetProblemCommon -> err)
-> ElaboratedInstallPlan
+ -> Maybe (SourcePackageDb)
-> [TargetSelector]
-> Either [err] TargetsMap
resolveTargets selectPackageTargets selectComponentTarget liftProblem
- installPlan =
- --TODO: [required eventually]
- -- we cannot resolve names of packages other than those that are
- -- directly in the current plan. We ought to keep a set of the known
- -- hackage packages so we can resolve names to those. Though we don't
- -- really need that until we can do something sensible with packages
- -- outside of the project.
-
+ installPlan mPkgDb =
fmap mkTargetsMap
. checkErrors
. map (\ts -> (,) ts <$> checkTarget ts)
@@ -530,11 +528,14 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
= fmap (componentTargets WholeComponent)
. selectPackageTargets bt
$ ats
-
+
+ | Just SourcePackageDb{ packageIndex } <- mPkgDb
+ , let pkg = lookupPackageName packageIndex pkgname
+ , not (null pkg)
+ = Left (liftProblem (TargetAvailableInIndex pkgname))
+
| otherwise
= Left (liftProblem (TargetNotInProject pkgname))
- --TODO: check if the package is in hackage and return different
- -- error cases here so the commands can handle things appropriately
componentTargets :: SubComponentTarget
-> [(b, ComponentName)]
@@ -705,6 +706,7 @@ selectComponentTargetBasic subtarget
data TargetProblemCommon
= TargetNotInProject PackageName
+ | TargetAvailableInIndex PackageName
| TargetComponentNotProjectLocal PackageId ComponentName SubComponentTarget
| TargetComponentNotBuildable PackageId ComponentName SubComponentTarget
| TargetOptionalStanzaDisabledByUser PackageId ComponentName SubComponentTarget
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
index 9ae6c57d65..52d5214212 100644
--- a/cabal-install/tests/IntegrationTests2.hs
+++ b/cabal-install/tests/IntegrationTests2.hs
@@ -1215,6 +1215,7 @@ assertProjectDistinctTargets elaboratedPlan
selectComponentTarget
liftProblem
elaboratedPlan
+ Nothing
targetSelectors
@@ -1260,7 +1261,8 @@ assertTargetProblems elaboratedPlan
where
assertTargetProblem expected targetSelector =
let res = resolveTargets selectPackageTargets selectComponentTarget
- liftProblem elaboratedPlan [targetSelector] in
+ liftProblem elaboratedPlan Nothing
+ [targetSelector] in
case res of
Left [problem] ->
problem @?= expected targetSelector
--
GitLab