Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
Packages
Cabal
Commits
bae4b41c
Commit
bae4b41c
authored
Jun 12, 2018
by
Alexis Williams
Browse files
Allow resolveTargets to know about Hackage packages
parent
57ab56bb
Changes
10
Hide whitespace changes
Inline
Side-by-side
cabal-install/Distribution/Client/CmdBench.hs
View file @
bae4b41c
...
...
@@ -100,6 +100,7 @@ benchAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let
elaboratedPlan'
=
pruneInstallPlanToTargets
...
...
cabal-install/Distribution/Client/CmdBuild.hs
View file @
bae4b41c
...
...
@@ -91,6 +91,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let
elaboratedPlan'
=
pruneInstallPlanToTargets
...
...
cabal-install/Distribution/Client/CmdErrorMessages.hs
View file @
bae4b41c
...
...
@@ -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 "
...
...
cabal-install/Distribution/Client/CmdHaddock.hs
View file @
bae4b41c
...
...
@@ -94,6 +94,7 @@ haddockAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let
elaboratedPlan'
=
pruneInstallPlanToTargets
...
...
cabal-install/Distribution/Client/CmdInstall.hs
View file @
bae4b41c
...
...
@@ -161,6 +161,7 @@ installAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let
elaboratedPlan'
=
pruneInstallPlanToTargets
...
...
cabal-install/Distribution/Client/CmdRepl.hs
View file @
bae4b41c
...
...
@@ -126,6 +126,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags, replArgs)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
...
...
cabal-install/Distribution/Client/CmdRun.hs
View file @
bae4b41c
...
...
@@ -130,6 +130,7 @@ runAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
-- Reject multiple targets, or at least targets in different
...
...
cabal-install/Distribution/Client/CmdTest.hs
View file @
bae4b41c
...
...
@@ -106,6 +106,7 @@ testAction (configFlags, configExFlags, installFlags, haddockFlags)
selectComponentTarget
TargetProblemCommon
elaboratedPlan
Nothing
targetSelectors
let
elaboratedPlan'
=
pruneInstallPlanToTargets
...
...
cabal-install/Distribution/Client/ProjectOrchestration.hs
View file @
bae4b41c
...
...
@@ -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
...
...
cabal-install/tests/IntegrationTests2.hs
View file @
bae4b41c
...
...
@@ -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
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment