Commit 1fb24861 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

TargetPackage TargetSelector allows multiple package ids

That is, the TargetPackage instead of having a single PackageId contains
a [PackageId].

Ultimately this will allow us to support multiple .cabal files in a
single directory. But the real reason to do this generalisation now is
that it helps with the TargetImplicitCwd case. For the implicit CWD case
we need to be able to parse the target whether or not there is a package
in the CWD. So the simplest solution is to pass in all the local CWD
packages (though typically only 0 or 1) and put all of them in. Then at
the end we can check if in fact there were 0 and fail.

When we do want to support multiple .cabal files in a dir, we'll also
need to adjust the project config code, and extend the syntax slightly
so that we render as the package location for the case of multiple
packages.
parent 0cdaeaa9
......@@ -85,12 +85,14 @@ sortGroupOn key = map (\xs@(x:_) -> (key x, xs))
--
renderTargetSelector :: TargetSelector -> String
renderTargetSelector (TargetPackage _ pkgid Nothing) =
"the package " ++ display pkgid
renderTargetSelector (TargetPackage _ pkgids Nothing) =
"the " ++ plural (listPlural pkgids) "package" "packages" ++ " "
++ renderListCommaAnd (map display pkgids)
renderTargetSelector (TargetPackage _ pkgid (Just kfilter)) =
renderTargetSelector (TargetPackage _ pkgids (Just kfilter)) =
"the " ++ renderComponentKind Plural kfilter
++ " in the package " ++ display pkgid
++ " in the " ++ plural (listPlural pkgids) "package" "packages" ++ " "
++ renderListCommaAnd (map display pkgids)
renderTargetSelector (TargetAllPackages Nothing) =
"all the packages in the project"
......@@ -131,11 +133,11 @@ optionalStanza _ = Nothing
--
targetSelectorPluralPkgs :: TargetSelector -> Plural
targetSelectorPluralPkgs (TargetAllPackages _) = Plural
targetSelectorPluralPkgs (TargetPackage _ _ _) = Singular
targetSelectorPluralPkgs (TargetPackage _ pids _) = listPlural pids
targetSelectorPluralPkgs (TargetComponent _ _ _) = Singular
targetSelectorPluralPkgs (TargetPackageName _) = Singular
-- | Does the 'TargetSelector' refer to
-- | Does the 'TargetSelector' refer to packages or to components?
targetSelectorRefersToPkgs :: TargetSelector -> Bool
targetSelectorRefersToPkgs (TargetAllPackages mkfilter) = isNothing mkfilter
targetSelectorRefersToPkgs (TargetPackage _ _ mkfilter) = isNothing mkfilter
......
......@@ -465,7 +465,7 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
checkTarget :: TargetSelector -> Either err [(UnitId, ComponentTarget)]
-- We can ask to build any whole package, project-local or a dependency
checkTarget bt@(TargetPackage _ pkgid mkfilter)
checkTarget bt@(TargetPackage _ [pkgid] mkfilter)
| Just ats <- fmap (maybe id filterTargetsKind mkfilter)
$ Map.lookup pkgid availableTargetsByPackage
= case selectPackageTargets bt ats of
......@@ -476,6 +476,12 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
| otherwise
= Left (liftProblem (TargetProblemNoSuchPackage pkgid))
checkTarget (TargetPackage _ _ _)
= error "TODO: add support for multiple packages in a directory"
-- For the moment this error cannot happen here, because it gets
-- detected when the package config is being constructed. This case
-- will need handling properly when we do add support.
checkTarget bt@(TargetAllPackages mkfilter) =
let ats = maybe id filterTargetsKind mkfilter
$ filter availableTargetLocalToProject
......
......@@ -37,10 +37,8 @@ module Distribution.Client.TargetSelector (
) where
import Distribution.Package
( Package(..), PackageId, PackageIdentifier(..)
( Package(..), PackageId
, PackageName, packageName, mkPackageName )
import Distribution.Version
( mkVersion )
import Distribution.Types.UnqualComponentName ( unUnqualComponentName )
import Distribution.Client.Types
( PackageLocation(..), PackageSpecifier(..) )
......@@ -143,10 +141,13 @@ import Text.EditDistance
--
data TargetSelector =
-- | A package as a whole: the default components for the package or all
-- components of a particular kind.
-- | One (or more) packages as a whole, or all the components of a
-- particular kind within the package(s).
--
TargetPackage TargetImplicitCwd PackageId (Maybe ComponentKindFilter)
-- These are always packages that are local to the project. In the case
-- that there is more than one, they all share the same directory location.
--
TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter)
-- | All packages, or all components of a particular kind in all packages.
--
......@@ -443,9 +444,8 @@ resolveTargetSelectors (KnownTargets{knownPackagesAll = []}) [] =
resolveTargetSelectors (KnownTargets{knownPackagesPrimary = []}) [] =
([TargetSelectorNoTargetsInCwd], [])
resolveTargetSelectors (KnownTargets{knownPackagesPrimary = (pkg:_)}) [] =
([], [TargetPackage TargetImplicitCwd (packageId pkg) Nothing])
--TODO: in future allow multiple packages in the same dir
resolveTargetSelectors (KnownTargets{knownPackagesPrimary = pkgs}) [] =
([], [TargetPackage TargetImplicitCwd (map packageId pkgs) Nothing])
resolveTargetSelectors knowntargets targetStrs =
partitionEithers
......@@ -461,11 +461,8 @@ resolveTargetSelector knowntargets@KnownTargets{..} targetStrStatus =
Unambiguous _
| projectIsEmpty -> Left TargetSelectorNoTargetsInProject
Unambiguous (TargetPackage TargetImplicitCwd _ mkfilter)
| (pkg:_) <- knownPackagesPrimary
--TODO: in future allow multiple packages in the same dir
-> Right (TargetPackage TargetImplicitCwd (packageId pkg) mkfilter)
| otherwise -> Left (TargetSelectorNoCurrentPackage targetStr)
Unambiguous (TargetPackage TargetImplicitCwd [] _)
-> Left (TargetSelectorNoCurrentPackage targetStr)
Unambiguous target -> Right target
......@@ -829,6 +826,7 @@ matchTargetSelector knowntargets = \usertarget ->
syntaxForms :: KnownTargets -> Syntax
syntaxForms KnownTargets {
knownPackagesAll = pinfo,
knownPackagesPrimary = ppinfo,
knownComponentsAll = cinfo,
knownComponentsPrimary = pcinfo,
knownComponentsOther = ocinfo
......@@ -848,7 +846,7 @@ syntaxForms KnownTargets {
[ shadowingAlternatives
[ ambiguousAlternatives
[ syntaxForm1All
, syntaxForm1Filter
, syntaxForm1Filter ppinfo
, shadowingAlternatives
[ syntaxForm1Component pcinfo
, syntaxForm1Package pinfo
......@@ -890,7 +888,7 @@ syntaxForms KnownTargets {
-- fully-qualified forms for all and cwd with filter
, syntaxForm3MetaAllFilter
, syntaxForm3MetaCwdFilter
, syntaxForm3MetaCwdFilter ppinfo
-- fully-qualified form for package and package with filter
, syntaxForm3MetaNamespacePackage pinfo
......@@ -924,21 +922,17 @@ syntaxForm1All =
--
-- > cabal build tests
--
syntaxForm1Filter :: Syntax
syntaxForm1Filter =
syntaxForm1Filter :: [KnownPackage] -> Syntax
syntaxForm1Filter ps =
syntaxForm1 render $ \str1 _fstatus1 -> do
kfilter <- matchComponentKindFilter str1
return (TargetPackage TargetImplicitCwd dummyKnownPackageId (Just kfilter))
return (TargetPackage TargetImplicitCwd pids (Just kfilter))
where
pids = [ pinfoId | KnownPackage{pinfoId} <- ps ]
render (TargetPackage TargetImplicitCwd _ (Just kfilter)) =
[TargetStringFileStatus1 (dispF kfilter) noFileStatus]
render _ = []
-- Only used for TargetPackage TargetImplicitCwd
dummyKnownPackageId :: PackageId
dummyKnownPackageId = PackageIdentifier
(mkPackageName "dummyKnownPackage")
(mkVersion [])
-- | Syntax: package (name, dir or file)
--
......@@ -950,9 +944,9 @@ syntaxForm1Package pinfo =
syntaxForm1 render $ \str1 fstatus1 -> do
guardPackage str1 fstatus1
p <- matchPackage pinfo str1 fstatus1
return (TargetPackage TargetExplicitNamed (packageId p) Nothing)
return (TargetPackage TargetExplicitNamed [packageId p] Nothing)
where
render (TargetPackage TargetExplicitNamed p Nothing) =
render (TargetPackage TargetExplicitNamed [p] Nothing) =
[TargetStringFileStatus1 (dispP p) noFileStatus]
render _ = []
......@@ -1050,9 +1044,9 @@ syntaxForm2PackageFilter ps =
guardPackage str1 fstatus1
p <- matchPackage ps str1 fstatus1
kfilter <- matchComponentKindFilter str2
return (TargetPackage TargetExplicitNamed (packageId p) (Just kfilter))
return (TargetPackage TargetExplicitNamed [packageId p] (Just kfilter))
where
render (TargetPackage TargetExplicitNamed p (Just kfilter)) =
render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
[TargetStringFileStatus2 (dispP p) noFileStatus (dispF kfilter)]
render _ = []
......@@ -1066,9 +1060,9 @@ syntaxForm2NamespacePackage pinfo =
guardNamespacePackage str1
guardPackageName str2
p <- matchPackage pinfo str2 noFileStatus
return (TargetPackage TargetExplicitNamed (packageId p) Nothing)
return (TargetPackage TargetExplicitNamed [packageId p] Nothing)
where
render (TargetPackage TargetExplicitNamed p Nothing) =
render (TargetPackage TargetExplicitNamed [p] Nothing) =
[TargetStringFileStatus2 "pkg" noFileStatus (dispP p)]
render _ = []
......@@ -1206,14 +1200,15 @@ syntaxForm3MetaAllFilter =
[TargetStringFileStatus3 "" noFileStatus "all" (dispF kfilter)]
render _ = []
syntaxForm3MetaCwdFilter :: Syntax
syntaxForm3MetaCwdFilter =
syntaxForm3MetaCwdFilter :: [KnownPackage] -> Syntax
syntaxForm3MetaCwdFilter ps =
syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
guardNamespaceMeta str1
guardNamespaceCwd str2
kfilter <- matchComponentKindFilter str3
return (TargetPackage TargetImplicitCwd dummyKnownPackageId (Just kfilter))
return (TargetPackage TargetImplicitCwd pids (Just kfilter))
where
pids = [ pinfoId | KnownPackage{pinfoId} <- ps ]
render (TargetPackage TargetImplicitCwd _ (Just kfilter)) =
[TargetStringFileStatus3 "" noFileStatus "cwd" (dispF kfilter)]
render _ = []
......@@ -1229,9 +1224,9 @@ syntaxForm3MetaNamespacePackage pinfo =
guardNamespacePackage str2
guardPackageName str3
p <- matchPackage pinfo str3 noFileStatus
return (TargetPackage TargetExplicitNamed (packageId p) Nothing)
return (TargetPackage TargetExplicitNamed [packageId p] Nothing)
where
render (TargetPackage TargetExplicitNamed p Nothing) =
render (TargetPackage TargetExplicitNamed [p] Nothing) =
[TargetStringFileStatus3 "" noFileStatus "pkg" (dispP p)]
render _ = []
......@@ -1349,9 +1344,9 @@ syntaxForm3NamespacePackageFilter ps =
guardPackageName str2
p <- matchPackage ps str2 noFileStatus
kfilter <- matchComponentKindFilter str3
return (TargetPackage TargetExplicitNamed (packageId p) (Just kfilter))
return (TargetPackage TargetExplicitNamed [packageId p] (Just kfilter))
where
render (TargetPackage TargetExplicitNamed p (Just kfilter)) =
render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
[TargetStringFileStatus3 "pkg" noFileStatus (dispP p) (dispF kfilter)]
render _ = []
......@@ -1365,9 +1360,9 @@ syntaxForm4MetaNamespacePackageFilter ps =
guardPackageName str3
p <- matchPackage ps str3 noFileStatus
kfilter <- matchComponentKindFilter str4
return (TargetPackage TargetExplicitNamed (packageId p) (Just kfilter))
return (TargetPackage TargetExplicitNamed [packageId p] (Just kfilter))
where
render (TargetPackage TargetExplicitNamed p (Just kfilter)) =
render (TargetPackage TargetExplicitNamed [p] (Just kfilter)) =
[TargetStringFileStatus4 "" "pkg" (dispP p) (dispF kfilter)]
render _ = []
......
......@@ -149,7 +149,7 @@ testTargetSelectors reportSubCase = do
reportSubCase "cwd"
do Right ts <- readTargetSelectors' []
ts @?= [TargetPackage TargetImplicitCwd "p-0.1" Nothing]
ts @?= [TargetPackage TargetImplicitCwd ["p-0.1"] Nothing]
reportSubCase "all"
do Right ts <- readTargetSelectors'
......@@ -164,7 +164,7 @@ testTargetSelectors reportSubCase = do
, "tests", ":cwd:tests"
, "benchmarks", ":cwd:benchmarks"]
zipWithM_ (@?=) ts
[ TargetPackage TargetImplicitCwd "p-0.1" (Just kind)
[ TargetPackage TargetImplicitCwd ["p-0.1"] (Just kind)
| kind <- concatMap (replicate 2) [LibKind .. ]
]
......@@ -200,10 +200,10 @@ testTargetSelectors reportSubCase = do
, "q:tests", "q/:tests", ":pkg:q:tests"
, "q:benchmarks", "q/:benchmarks", ":pkg:q:benchmarks"]
zipWithM_ (@?=) ts $
[ TargetPackage TargetExplicitNamed "p-0.1" (Just kind)
[ TargetPackage TargetExplicitNamed ["p-0.1"] (Just kind)
| kind <- concatMap (replicate 3) [LibKind .. ]
] ++
[ TargetPackage TargetExplicitNamed "q-0.1" (Just kind)
[ TargetPackage TargetExplicitNamed ["q-0.1"] (Just kind)
| kind <- concatMap (replicate 3) [LibKind .. ]
]
......@@ -289,19 +289,19 @@ testTargetSelectorAmbiguous reportSubCase = do
reportSubCase "ambiguous: cwd-pkg filter vs pkg"
assertAmbiguous "libs"
[ mkTargetPackage "libs"
, TargetPackage TargetImplicitCwd "dummyKnownPackage" (Just LibKind) ]
, TargetPackage TargetImplicitCwd ["libs"] (Just LibKind) ]
[mkpkg "libs" []]
reportSubCase "ambiguous: filter vs cwd component"
assertAmbiguous "exes"
[ mkTargetComponent "other" (CExeName "exes")
, TargetPackage TargetImplicitCwd "dummyKnownPackage" (Just ExeKind) ]
, TargetPackage TargetImplicitCwd ["other"] (Just ExeKind) ]
[mkpkg "other" [mkexe "exes"]]
-- but filters are not ambiguous with non-cwd components, modules or files
reportSubCase "unambiguous: filter vs non-cwd comp, mod, file"
assertUnambiguous "Libs"
(TargetPackage TargetImplicitCwd "bar" (Just LibKind))
(TargetPackage TargetImplicitCwd ["bar"] (Just LibKind))
[ mkpkgAt "foo" [mkexe "Libs"] "foo"
, mkpkg "bar" [ mkexe "bar" `withModules` ["Libs"]
, mkexe "baz" `withCFiles` ["Libs"] ]
......@@ -441,7 +441,7 @@ testTargetSelectorAmbiguous reportSubCase = do
mkTargetPackage :: PackageId -> TargetSelector
mkTargetPackage pkgid =
TargetPackage TargetExplicitNamed pkgid Nothing
TargetPackage TargetExplicitNamed [pkgid] Nothing
mkTargetComponent :: PackageId -> ComponentName -> TargetSelector
mkTargetComponent pkgid cname =
......@@ -673,8 +673,8 @@ testTargetProblemsBuild config reportSubCase = do
CmdBuild.selectPackageTargets
CmdBuild.selectComponentTarget
CmdBuild.TargetProblemCommon
[ TargetPackage TargetExplicitNamed "p-0.1" (Just TestKind)
, TargetPackage TargetExplicitNamed "p-0.1" (Just BenchKind)
[ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
, TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
]
[ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
, ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
......@@ -726,7 +726,7 @@ testTargetProblemsRepl config reportSubCase = do
, AvailableTarget "p-0.1" (CTestName "p1")
(TargetBuildable () TargetNotRequestedByDefault) True
]
, TargetPackage TargetExplicitNamed "p-0.1" (Just TestKind) )
, TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) )
]
reportSubCase "multiple targets"
......@@ -796,7 +796,7 @@ testTargetProblemsRepl config reportSubCase = do
CmdRepl.selectPackageTargets
CmdRepl.selectComponentTarget
CmdRepl.TargetProblemCommon
[ TargetPackage TargetExplicitNamed "p-0.1" Nothing ]
[ TargetPackage TargetExplicitNamed ["p-0.1"] Nothing ]
[ ("p-0.1-inplace", CLibName) ]
-- When we select the package with an explicit filter then we get those
-- components even though we did not explicitly enable tests/benchmarks
......@@ -805,14 +805,14 @@ testTargetProblemsRepl config reportSubCase = do
CmdRepl.selectPackageTargets
CmdRepl.selectComponentTarget
CmdRepl.TargetProblemCommon
[ TargetPackage TargetExplicitNamed "p-0.1" (Just TestKind) ]
[ TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind) ]
[ ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite") ]
assertProjectDistinctTargets
elaboratedPlan
CmdRepl.selectPackageTargets
CmdRepl.selectComponentTarget
CmdRepl.TargetProblemCommon
[ TargetPackage TargetExplicitNamed "p-0.1" (Just BenchKind) ]
[ TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind) ]
[ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark") ]
......@@ -1195,10 +1195,10 @@ testTargetProblemsHaddock config reportSubCase = do
(CmdHaddock.selectPackageTargets haddockFlags)
CmdHaddock.selectComponentTarget
CmdHaddock.TargetProblemCommon
[ TargetPackage TargetExplicitNamed "p-0.1" (Just FLibKind)
, TargetPackage TargetExplicitNamed "p-0.1" (Just ExeKind)
, TargetPackage TargetExplicitNamed "p-0.1" (Just TestKind)
, TargetPackage TargetExplicitNamed "p-0.1" (Just BenchKind)
[ TargetPackage TargetExplicitNamed ["p-0.1"] (Just FLibKind)
, TargetPackage TargetExplicitNamed ["p-0.1"] (Just ExeKind)
, TargetPackage TargetExplicitNamed ["p-0.1"] (Just TestKind)
, TargetPackage TargetExplicitNamed ["p-0.1"] (Just BenchKind)
]
[ ("p-0.1-inplace-a-benchmark", CBenchName "a-benchmark")
, ("p-0.1-inplace-a-testsuite", CTestName "a-testsuite")
......
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