Commit bae4b41c authored by Alexis Williams's avatar Alexis Williams
Browse files

Allow resolveTargets to know about Hackage packages

parent 57ab56bb
......@@ -100,6 +100,7 @@ benchAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
......
......@@ -91,6 +91,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
......
......@@ -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 "
......
......@@ -94,6 +94,7 @@ haddockAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
......
......@@ -161,6 +161,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
......
......@@ -126,6 +126,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, replArgs)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
......
......@@ -130,6 +130,7 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
......
......@@ -106,6 +106,7 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let elaboratedPlan' = pruneInstallPlanToTargets
......
......@@ -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
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment