Add support for component-filters in target selectors

This means we can say things like:
cabal build tests     -- for the tests in the package in the cwd
cabal build foo:tests -- for the tests in package foo
cabal build all:benchmarks -- benchmarks in all packages in the project

cabal-install/Distribution/Client/CmdBuild.hs

@@ -133,13 +133,22 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags)
 --
 selectPackageTargets :: TargetSelector PackageId
                      -> [AvailableTarget k] -> Either BuildTargetProblem [k]
-selectPackageTargets _bt ts
+selectPackageTargets bt ts
   | (_:_)  <- enabledts = Right enabledts
   | (_:_)  <- ts        = Left TargetPackageNoEnabledTargets -- allts
   | otherwise           = Left TargetPackageNoTargets
   where
-    enabledts = [ k | TargetBuildable k TargetRequestedByDefault
-                        <- map availableTargetStatus ts ]
+    enabledts = [ k | TargetBuildable k requestedByDefault
+                        <- map availableTargetStatus ts
+                    , pruneReq bt requestedByDefault ]
+
+    -- When there's a target filter like "pkg:tests" then we do select tests,
+    -- but if it's just a target like "pkg" then we don't build tests unless
+    -- they are requested by default (i.e. by using --enable-tests)
+    pruneReq (TargetPackage   _  Nothing) TargetNotRequestedByDefault = False
+    pruneReq (TargetCwdPackage _ Nothing) TargetNotRequestedByDefault = False
+    pruneReq (TargetAllPackages  Nothing) TargetNotRequestedByDefault = False
+    pruneReq _ _ = True
 
 -- For checking an individual component target, for build there's no
 -- additional checks we need beyond the basic ones.

cabal-install/Distribution/Client/ProjectOrchestration.hs

@@ -90,8 +90,8 @@ import           Distribution.Client.Types
                    ( GenericReadyPackage(..), UnresolvedSourcePackage )
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import           Distribution.Client.TargetSelector
-                   ( TargetSelector(..), readTargetSelectors
-                   , reportTargetSelectorProblems )
+                   ( TargetSelector(..), ComponentKind(..)
+                   , readTargetSelectors, reportTargetSelectorProblems )
 import           Distribution.Client.DistDirLayout
 import           Distribution.Client.Config (defaultCabalDir)
 import           Distribution.Client.Setup hiding (packageName)
@@ -408,8 +408,9 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
                 -> Either err [(UnitId, ComponentTarget)]
 
     -- We can ask to build any whole package, project-local or a dependency
-    checkTarget bt@(TargetPackage pkgid)
-      | Just ats <- Map.lookup pkgid availableTargetsByPackage
+    checkTarget bt@(TargetPackage pkgid mkfilter)
+      | Just ats <- fmap (maybe id filterComponentKind mkfilter)
+                  $ Map.lookup pkgid availableTargetsByPackage
       = case selectPackageTargets bt ats of
           Left  e  -> Left e
           Right ts -> Right [ (unitid, ComponentTarget cname WholeComponent)
@@ -417,9 +418,21 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
 
       | otherwise = internalErrorUnknownTarget
 
-    checkTarget bt@TargetAllPackages =
-      let ats = filter availableTargetLocalToProject
-                      (concat (Map.elems availableTargetsByPackage))
+    checkTarget bt@(TargetCwdPackage [pkgid] mkfilter)
+      | Just ats <- fmap (maybe id filterComponentKind mkfilter)
+                  $ Map.lookup pkgid availableTargetsByPackage
+      = case selectPackageTargets bt ats of
+          Left  e  -> Left e
+          Right ts -> Right [ (unitid, ComponentTarget cname WholeComponent)
+                            | (unitid, cname) <- ts ]
+
+    checkTarget (TargetCwdPackage _ _)
+      = internalErrorUnknownTarget
+
+    checkTarget bt@(TargetAllPackages mkfilter) =
+      let ats = maybe id filterComponentKind mkfilter
+              $ filter availableTargetLocalToProject
+              $ concat (Map.elems availableTargetsByPackage)
        in case selectPackageTargets bt ats of
             Left  e  -> Left e
             Right ts -> Right [ (unitid, ComponentTarget cname WholeComponent)
@@ -447,6 +460,18 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
                                     availableTargetsByComponent
     availableTargetsByComponent = availableTargets installPlan
 
+    filterComponentKind :: ComponentKind
+                        -> [AvailableTarget a] -> [AvailableTarget a]
+    filterComponentKind kfilter =
+      filter ((kfilter==) . componentKind . availableTargetComponentName)
+
+    componentKind CLibName{}    = LibKind
+    componentKind CSubLibName{} = LibKind
+    componentKind CFLibName{}   = FLibKind
+    componentKind CExeName{}    = ExeKind
+    componentKind CTestName{}   = TestKind
+    componentKind CBenchName{}  = BenchKind
+
     --TODO: [research required] what if the solution has multiple versions of this package?
     --      e.g. due to setup deps or due to multiple independent sets of
     --      packages being built (e.g. ghc + ghcjs in a project)

cabal-install/Distribution/Client/TargetSelector.hs

@@ -14,6 +14,7 @@ module Distribution.Client.TargetSelector (
 
     -- * Target selectors
     TargetSelector(..),
+    ComponentKind(..),
     SubComponentTarget(..),
     QualLevel(..),
 
@@ -129,19 +130,29 @@ import Text.EditDistance
 --
 data TargetSelector pkg =
 
-     -- | A package as a whole: the default components for the package
+     -- | A package as a whole: the default components for the package or all
+     -- components of a particular kind.
      --
-     TargetPackage pkg
+     TargetPackage pkg (Maybe ComponentKindFilter)
 
-     -- | All packages: the default components for all packages.
+     -- | All packages, or all components of a particular kind in all packages.
      --
-   | TargetAllPackages
+   | TargetCwdPackage [pkg] (Maybe ComponentKindFilter)
+
+     -- | All packages, or all components of a particular kind in all packages.
+     --
+   | TargetAllPackages (Maybe ComponentKindFilter)
 
      -- | A specific component in a package.
      --
    | TargetComponent pkg ComponentName SubComponentTarget
   deriving (Eq, Ord, Functor, Show, Generic)
 
+data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
+  deriving (Eq, Ord, Show)
+
+type ComponentKindFilter = ComponentKind
+
 -- | Either the component as a whole or detail about a file or module target
 -- within a component.
 --
@@ -370,10 +381,11 @@ resolveTargetSelectors :: [PackageInfo]     -- any pkg in the cur dir
                            [TargetSelector PackageInfo])
 
 -- default local dir target if there's no given target:
-resolveTargetSelectors [ppinfo] _opinfo [] =
-    ([], [TargetPackage ppinfo])
-resolveTargetSelectors (_:_) _opinfo [] =
-    internalError "no support for multiple packages in one dir yet"
+resolveTargetSelectors [] _opinfo [] =
+    ([TargetSelectorNoTargets], [])
+
+resolveTargetSelectors ppinfo _opinfo [] =
+    ([], [TargetCwdPackage ppinfo Nothing])
     --TODO: in future allow multiple packages in the same dir
 
 resolveTargetSelectors ppinfo opinfo targetStrs =
@@ -387,6 +399,11 @@ resolveTargetSelector :: [PackageInfo] -> [PackageInfo]
                                 (TargetSelector PackageInfo)
 resolveTargetSelector ppinfo opinfo targetStrStatus =
     case findMatch (matcher targetStrStatus) of
+      Unambiguous (TargetCwdPackage _ mkfilter) ->
+        case ppinfo of
+          [] -> Left (TargetSelectorNoCurrentPackage targetStr)
+          _  -> Right (TargetCwdPackage ppinfo mkfilter)
+
       Unambiguous          target  -> Right target
       None                 errs    -> Left (classifyMatchErrors errs)
       Ambiguous exactMatch targets ->
@@ -462,6 +479,8 @@ data TargetSelectorProblem
                            [(TargetString, [TargetSelector PackageInfo])]
    | TargetSelectorUnrecognised String
      -- ^ Syntax error when trying to parse a target string.
+   | TargetSelectorNoCurrentPackage TargetString
+   | TargetSelectorNoTargets
   deriving Show
 
 data QualLevel = QL1 | QL2 | QL3 | QLFull
@@ -636,6 +655,26 @@ reportTargetSelectorProblems verbosity problems = do
                        | (ut, bt) <- amb ]
           | (target, amb) <- targets ]
 
+    case [ t | TargetSelectorNoCurrentPackage t <- problems ] of
+      []       -> return ()
+      target:_ ->
+        die' verbosity $
+            "The target '" ++ showTargetString target ++ "' refers to the "
+         ++ "components in the package in the current directory, but there "
+         ++ "is no package in the current directory (or at least not listed "
+         ++ "as part of the project)."
+        --TODO: report a different error if there is a .cabal file but it's
+        -- not a member of the project
+
+    case [ () | TargetSelectorNoTargets <- problems ] of
+      []  -> return ()
+      _:_ ->
+        die' verbosity $
+            "No targets given and there is no package in the current "
+         ++ "directory. Use the target 'all' for all packages in the "
+         ++ "project or specify packages or components by name or location. "
+         ++ "See 'cabal build --help' for more details on target options."
+
     fail "reportTargetSelectorProblems: internal error"
 
   where
@@ -646,8 +685,12 @@ reportTargetSelectorProblems verbosity problems = do
        in showTargetString (forgetFileStatus t')
 
     showTargetSelectorKind bt = case bt of
-      TargetPackage{}                    -> "package"
-      TargetAllPackages                  -> "all-packages"
+      TargetPackage _ Nothing            -> "package"
+      TargetPackage _ (Just _)           -> "package:filter"
+      TargetCwdPackage _ Nothing         -> "cwd-package"
+      TargetCwdPackage _ (Just _)        -> "cwd-package:filter"
+      TargetAllPackages Nothing          -> "all-packages"
+      TargetAllPackages (Just _)         -> "all-packages:filter"
       TargetComponent _ _ WholeComponent -> "component"
       TargetComponent _ _ ModuleTarget{} -> "module"
       TargetComponent _ _ FileTarget{}   -> "file"
@@ -730,6 +773,7 @@ syntaxForms ppinfo opinfo =
       [ shadowingAlternatives
           [ ambiguousAlternatives
               [ syntaxForm1All
+              , syntaxForm1Filter
               , shadowingAlternatives
                   [ syntaxForm1Component pcinfo
                   , syntaxForm1Package   pinfo
@@ -743,8 +787,10 @@ syntaxForms ppinfo opinfo =
         -- two-component partially qualified forms
         -- fully qualified form for 'all'
       , syntaxForm2MetaAll
+      , syntaxForm2AllFilter
       , syntaxForm2NamespacePackage pinfo
       , syntaxForm2PackageComponent pinfo
+      , syntaxForm2PackageFilter    pinfo
       , syntaxForm2KindComponent    cinfo
       , syntaxForm2PackageModule   pinfo
       , syntaxForm2ComponentModule cinfo
@@ -757,9 +803,15 @@ syntaxForms ppinfo opinfo =
       , syntaxForm3PackageComponentFile   pinfo
       , syntaxForm3KindComponentModule    cinfo
       , syntaxForm3KindComponentFile      cinfo
+      , syntaxForm3NamespacePackageFilter pinfo
 
-        -- fully-qualified form for package
+        -- fully-qualified forms for all and cwd with filter
+      , syntaxForm3MetaAllFilter
+      , syntaxForm3MetaCwdFilter
+
+        -- fully-qualified form for package and package with filter
       , syntaxForm3MetaNamespacePackage       pinfo
+      , syntaxForm4MetaNamespacePackageFilter pinfo
 
         -- fully-qualified forms for component, module and file
       , syntaxForm5MetaNamespacePackageKindComponent                pinfo
@@ -783,12 +835,26 @@ syntaxForm1All :: Syntax
 syntaxForm1All =
   syntaxForm1 render $ \str1 _fstatus1 -> do
     guardMetaAll str1
-    return TargetAllPackages
+    return (TargetAllPackages Nothing)
   where
-    render TargetAllPackages =
+    render (TargetAllPackages Nothing) =
       [TargetStringFileStatus1 "all" noFileStatus]
     render _ = []
 
+-- | Syntax: filter
+--
+-- > cabal build tests
+--
+syntaxForm1Filter :: Syntax
+syntaxForm1Filter =
+  syntaxForm1 render $ \str1 _fstatus1 -> do
+    kfilter <- matchComponentKindFilter str1
+    return (TargetCwdPackage [] (Just kfilter))
+  where
+    render (TargetCwdPackage _ (Just kfilter)) =
+      [TargetStringFileStatus1 (dispF kfilter) noFileStatus]
+    render _ = []
+
 -- | Syntax: package (name, dir or file)
 --
 -- > cabal build foo
@@ -799,9 +865,9 @@ syntaxForm1Package pinfo =
   syntaxForm1 render $ \str1 fstatus1 -> do
     guardPackage            str1 fstatus1
     p <- matchPackage pinfo str1 fstatus1
-    return (TargetPackage p)
+    return (TargetPackage p Nothing)
   where
-    render (TargetPackage p) =
+    render (TargetPackage p Nothing) =
       [TargetStringFileStatus1 (dispP p) noFileStatus]
     render _ = []
 
@@ -864,12 +930,43 @@ syntaxForm2MetaAll =
   syntaxForm2 render $ \str1 _fstatus1 str2 -> do
     guardNamespaceMeta str1
     guardMetaAll str2
-    return TargetAllPackages
+    return (TargetAllPackages Nothing)
   where
-    render TargetAllPackages =
+    render (TargetAllPackages Nothing) =
       [TargetStringFileStatus2 "" noFileStatus "all"]
     render _ = []
 
+-- | Syntax:  all : filer
+--
+-- > cabal build all:tests
+--
+syntaxForm2AllFilter :: Syntax
+syntaxForm2AllFilter =
+  syntaxForm2 render $ \str1 _fstatus1 str2 -> do
+    guardMetaAll str1
+    kfilter <- matchComponentKindFilter str2
+    return (TargetAllPackages (Just kfilter))
+  where
+    render (TargetAllPackages (Just kfilter)) =
+      [TargetStringFileStatus2 "all" noFileStatus (dispF kfilter)]
+    render _ = []
+
+-- | Syntax:  package : filer
+--
+-- > cabal build foo:tests
+--
+syntaxForm2PackageFilter :: [PackageInfo] -> Syntax
+syntaxForm2PackageFilter ps =
+  syntaxForm2 render $ \str1 fstatus1 str2 -> do
+    guardPackage         str1 fstatus1
+    p <- matchPackage ps str1 fstatus1
+    kfilter <- matchComponentKindFilter str2
+    return (TargetPackage p (Just kfilter))
+  where
+    render (TargetPackage p (Just kfilter)) =
+      [TargetStringFileStatus2 (dispP p) noFileStatus (dispF kfilter)]
+    render _ = []
+
 -- | Syntax: pkg : package name
 --
 -- > cabal build pkg:foo
@@ -880,9 +977,9 @@ syntaxForm2NamespacePackage pinfo =
     guardNamespacePackage   str1
     guardPackageName        str2
     p <- matchPackage pinfo str2 noFileStatus
-    return (TargetPackage p)
+    return (TargetPackage p Nothing)
   where
-    render (TargetPackage p) =
+    render (TargetPackage p Nothing) =
       [TargetStringFileStatus2 "pkg" noFileStatus (dispP p)]
     render _ = []
 
@@ -1004,6 +1101,34 @@ syntaxForm2ComponentFile cs =
 
 ---
 
+-- | Syntax: :all : filter
+--
+-- > cabal build :all:tests
+--
+syntaxForm3MetaAllFilter :: Syntax
+syntaxForm3MetaAllFilter =
+  syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
+    guardNamespaceMeta str1
+    guardMetaAll str2
+    kfilter <- matchComponentKindFilter str3
+    return (TargetAllPackages (Just kfilter))
+  where
+    render (TargetAllPackages (Just kfilter)) =
+      [TargetStringFileStatus3 "" noFileStatus "all" (dispF kfilter)]
+    render _ = []
+
+syntaxForm3MetaCwdFilter :: Syntax
+syntaxForm3MetaCwdFilter =
+  syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
+    guardNamespaceMeta str1
+    guardNamespaceCwd str2
+    kfilter <- matchComponentKindFilter str3
+    return (TargetCwdPackage [] (Just kfilter))
+  where
+    render (TargetCwdPackage _ (Just kfilter)) =
+      [TargetStringFileStatus3 "" noFileStatus "cwd" (dispF kfilter)]
+    render _ = []
+
 -- | Syntax: :pkg : package name
 --
 -- > cabal build :pkg:foo
@@ -1015,9 +1140,9 @@ syntaxForm3MetaNamespacePackage pinfo =
     guardNamespacePackage   str2
     guardPackageName        str3
     p <- matchPackage pinfo str3 noFileStatus
-    return (TargetPackage p)
+    return (TargetPackage p Nothing)
   where
-    render (TargetPackage p) =
+    render (TargetPackage p Nothing) =
       [TargetStringFileStatus3 "" noFileStatus "pkg" (dispP p)]
     render _ = []
 
@@ -1128,8 +1253,35 @@ syntaxForm3KindComponentFile cs =
       [TargetStringFileStatus3 (dispK c) noFileStatus (dispC p c) f]
     render _ = []
 
+syntaxForm3NamespacePackageFilter :: [PackageInfo] -> Syntax
+syntaxForm3NamespacePackageFilter ps =
+  syntaxForm3 render $ \str1 _fstatus1 str2 str3 -> do
+    guardNamespacePackage str1
+    guardPackageName      str2
+    p <- matchPackage  ps str2 noFileStatus
+    kfilter <- matchComponentKindFilter str3
+    return (TargetPackage p (Just kfilter))
+  where
+    render (TargetPackage p (Just kfilter)) =
+      [TargetStringFileStatus3 "pkg" noFileStatus (dispP p) (dispF kfilter)]
+    render _ = []
+
 --
 
+syntaxForm4MetaNamespacePackageFilter :: [PackageInfo] -> Syntax
+syntaxForm4MetaNamespacePackageFilter ps =
+  syntaxForm4 render $ \str1 str2 str3 str4 -> do
+    guardNamespaceMeta    str1
+    guardNamespacePackage str2
+    guardPackageName      str3
+    p <- matchPackage  ps str3 noFileStatus
+    kfilter <- matchComponentKindFilter str4
+    return (TargetPackage p (Just kfilter))
+  where
+    render (TargetPackage p (Just kfilter)) =
+      [TargetStringFileStatus4 "" "pkg" (dispP p) (dispF kfilter)]
+    render _ = []
+
 -- | Syntax: :pkg : package : namespace : component
 --
 -- > cabal build :pkg:foo:lib:foo
@@ -1278,6 +1430,9 @@ dispC = componentStringName
 dispK :: ComponentName -> String
 dispK = showComponentKindShort . componentKind
 
+dispF :: ComponentKind -> String
+dispF = showComponentKindFilterShort
+
 dispM :: ModuleName -> String
 dispM = display
 
@@ -1403,6 +1558,9 @@ guardMetaAll = guardToken ["all"] "meta-target 'all'"
 guardNamespacePackage :: String -> Match ()
 guardNamespacePackage = guardToken ["pkg", "package"] "'pkg' namespace"
 
+guardNamespaceCwd :: String -> Match ()
+guardNamespaceCwd = guardToken ["cwd"] "'cwd' namespace"
+
 guardNamespaceModule :: String -> Match ()
 guardNamespaceModule = guardToken ["mod", "module"] "'module' namespace"
 
@@ -1419,9 +1577,6 @@ guardToken tokens msg s
 -- Matching component kinds
 --
 
-data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
-  deriving (Eq, Ord, Show)
-
 componentKind :: ComponentName -> ComponentKind
 componentKind  CLibName      = LibKind
 componentKind (CSubLibName _) = LibKind
@@ -1449,6 +1604,22 @@ matchComponentKind s
     testlabels  = ["tst", "test", "test-suite"]
     benchlabels = ["bench", "benchmark"]
 
+matchComponentKindFilter :: String -> Match ComponentKind
+matchComponentKindFilter s
+  | s' `elem` liblabels   = increaseConfidence >> return LibKind
+  | s' `elem` fliblabels  = increaseConfidence >> return FLibKind
+  | s' `elem` exelabels   = increaseConfidence >> return ExeKind
+  | s' `elem` testlabels  = increaseConfidence >> return TestKind
+  | s' `elem` benchlabels = increaseConfidence >> return BenchKind
+  | otherwise             = matchErrorExpected "component kind filter" s
+  where
+    s'          = caseFold s
+    liblabels   = ["libs", "libraries"]
+    fliblabels  = ["flibs", "foreign-libraries"]
+    exelabels   = ["exes", "executables"]
+    testlabels  = ["tests", "test-suites"]
+    benchlabels = ["benches", "benchmarks"]
+
 showComponentKind :: ComponentKind -> String
 showComponentKind LibKind   = "library"
 showComponentKind FLibKind  = "foreign library"
@@ -1463,6 +1634,14 @@ showComponentKindShort ExeKind   = "exe"
 showComponentKindShort TestKind  = "test"
 showComponentKindShort BenchKind = "bench"
 
+showComponentKindFilterShort :: ComponentKind -> String
+showComponentKindFilterShort LibKind   = "libs"
+showComponentKindFilterShort FLibKind  = "flibs"
+showComponentKindFilterShort ExeKind   = "exes"
+showComponentKindFilterShort TestKind  = "tests"
+showComponentKindFilterShort BenchKind = "benchmarks"
+
+
 ------------------------------
 -- Matching package targets
 --