Add AmbiguityResolver to decide how to resolve ambiguty

Every other command defaults to what they used to do. show-build-info
now just chooses the first choice, since it doesn't care about
ambiguity.

cabal-install/Distribution/Client/CmdBench.hs

@@ -22,7 +22,7 @@ import Distribution.Client.ProjectOrchestration
 import Distribution.Client.CmdErrorMessages
          ( renderTargetSelector, showTargetSelector, renderTargetProblem,
            renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs,
-           targetSelectorFilter )
+           targetSelectorFilter, AmbiguityResolver(..) )
 import Distribution.Client.TargetProblem
          ( TargetProblem (..) )
 import Distribution.Client.NixStyleOptions
@@ -87,7 +87,8 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
     baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
 
     targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-                   =<< readTargetSelectors (localPackages baseCtx) (Just BenchKind) targetStrings
+                   =<< readTargetSelectors (localPackages baseCtx)
+                        (AmbiguityResolverKind BenchKind) targetStrings
 
     buildCtx <-
       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
@@ -120,7 +121,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
     runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
   where
     verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
-    cliConfig = commandLineFlagsToProjectConfig globalFlags flags 
+    cliConfig = commandLineFlagsToProjectConfig globalFlags flags
                   mempty -- ClientInstallFlags, not needed here
 
 -- | This defines what a 'TargetSelector' means for the @bench@ command.

cabal-install/Distribution/Client/CmdBuild.hs

@@ -106,7 +106,8 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo
 
     targetSelectors <-
       either (reportTargetSelectorProblems verbosity) return
-      =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
+      =<< readTargetSelectors (localPackages baseCtx)
+            AmbiguityResolverNone targetStrings
 
     buildCtx <-
       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

cabal-install/Distribution/Client/CmdErrorMessages.hs

@@ -21,7 +21,7 @@ import Distribution.Client.TargetSelector
 import Distribution.Client.TargetProblem
          ( TargetProblem(..), TargetProblem' )
 import Distribution.Client.TargetSelector
-         ( ComponentKind(..), ComponentKindFilter, TargetSelector(..),
+         ( ComponentKind(..), AmbiguityResolver(..), TargetSelector(..),
            componentKind, showTargetSelector )
 
 import Distribution.Package
@@ -170,7 +170,7 @@ targetSelectorRefersToPkgs (TargetPackageNamed _ mkfilter) = isNothing mkfilter
 targetSelectorRefersToPkgs  TargetComponent{}              = False
 targetSelectorRefersToPkgs  TargetComponentUnknown{}       = False
 
-targetSelectorFilter :: TargetSelector -> Maybe ComponentKindFilter
+targetSelectorFilter :: TargetSelector -> Maybe ComponentKind
 targetSelectorFilter (TargetPackage    _ _ mkfilter) = mkfilter
 targetSelectorFilter (TargetPackageNamed _ mkfilter) = mkfilter
 targetSelectorFilter (TargetAllPackages    mkfilter) = mkfilter

cabal-install/Distribution/Client/CmdHaddock.hs

@@ -76,7 +76,8 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do
     baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand
 
     targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-                   =<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
+                   =<< readTargetSelectors (localPackages baseCtx)
+                          AmbiguityResolverNone targetStrings
 
     buildCtx <-
       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

cabal-install/Distribution/Client/CmdInstall.hs

@@ -241,7 +241,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
           targetSelectors <-
             either (reportTargetSelectorProblems verbosity) return
             =<< readTargetSelectors (localPackages localBaseCtx)
-                                    Nothing targetStrings''
+                                    AmbiguityResolverNone targetStrings''
 
           (specs, selectors) <-
             getSpecsAndTargetSelectors
@@ -430,7 +430,7 @@ getSpecsAndTargetSelectors
   -> [TargetSelector]
   -> DistDirLayout
   -> ProjectBaseContext
-  -> Maybe ComponentKindFilter
+  -> Maybe ComponentKind
   -> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
 getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors localDistDirLayout localBaseCtx targetFilter =
   withInstallPlan reducedVerbosity localBaseCtx $ \elaboratedPlan _ -> do

cabal-install/Distribution/Client/CmdRepl.hs

@@ -26,7 +26,7 @@ import qualified Distribution.Types.Lens as L
 import Distribution.Client.NixStyleOptions
          ( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
 import Distribution.Client.CmdErrorMessages
-         ( renderTargetSelector, showTargetSelector,
+         ( renderTargetSelector, showTargetSelector, AmbiguityResolver(..),
            renderTargetProblem,
            targetSelectorRefersToPkgs,
            renderComponentKind, renderListCommaAnd, renderListSemiAnd,
@@ -344,7 +344,7 @@ withProject cliConfig verbosity targetStrings = do
   baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
 
   targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-                 =<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings
+                 =<< readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind LibKind) targetStrings
 
   return (baseCtx, targetSelectors, return (), ProjectRepl)
 

cabal-install/Distribution/Client/CmdRun.hs

@@ -59,7 +59,7 @@ import Distribution.Client.ProjectPlanning
 import Distribution.Client.ProjectPlanning.Types
          ( dataDirsEnvironmentForPlan )
 import Distribution.Client.TargetSelector
-         ( TargetSelectorProblem(..), TargetString(..) )
+         ( TargetSelectorProblem(..), TargetString(..), AmbiguityResolver(..) )
 import Distribution.Client.InstallPlan
          ( toList, foldPlanPackage )
 import Distribution.Types.UnqualComponentName
@@ -182,7 +182,7 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do
           else reportTargetSelectorProblems verbosity err
 
     (baseCtx', targetSelectors) <-
-      readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings)
+      readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind ExeKind) (take 1 targetStrings)
         >>= \case
           Left err@(TargetSelectorNoTargetsInProject:_)
             | (script:_) <- targetStrings -> scriptOrError script err

cabal-install/Distribution/Client/CmdSdist.hs

@@ -18,7 +18,7 @@ import Distribution.Client.ProjectOrchestration
 import Distribution.Client.NixStyleOptions
          ( NixStyleFlags (..), defaultNixStyleFlags )
 import Distribution.Client.TargetSelector
-    ( TargetSelector(..), ComponentKind
+    ( TargetSelector(..), ComponentKind, AmbiguityResolver(..)
     , readTargetSelectors, reportTargetSelectorProblems )
 import Distribution.Client.Setup
     ( GlobalFlags(..) )
@@ -151,7 +151,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
     let localPkgs = localPackages baseCtx
 
     targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-        =<< readTargetSelectors localPkgs Nothing targetStrings
+        =<< readTargetSelectors localPkgs AmbiguityResolverNone targetStrings
 
     -- elaborate path, create target directory
     mOutputPath' <- case mOutputPath of

cabal-install/Distribution/Client/CmdShowBuildInfo.hs

@@ -114,7 +114,7 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO
         }
 
   targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-                  =<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings
+                  =<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings
 
   buildCtx <-
     runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do

cabal-install/Distribution/Client/CmdTest.hs

@@ -22,7 +22,8 @@ import Distribution.Client.ProjectOrchestration
 import Distribution.Client.CmdErrorMessages
          ( renderTargetSelector, showTargetSelector, targetSelectorFilter, plural,
            renderTargetProblem,
-           renderTargetProblemNoTargets, targetSelectorPluralPkgs )
+           renderTargetProblemNoTargets, targetSelectorPluralPkgs,
+           AmbiguityResolver(..) )
 import Distribution.Client.TargetProblem
          ( TargetProblem (..) )
 import Distribution.Client.NixStyleOptions
@@ -99,7 +100,8 @@ testAction flags@NixStyleFlags {..} targetStrings globalFlags = do
     baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
 
     targetSelectors <- either (reportTargetSelectorProblems verbosity) return
-                   =<< readTargetSelectors (localPackages baseCtx) (Just TestKind) targetStrings
+                   =<< readTargetSelectors (localPackages baseCtx)
+                        (AmbiguityResolverKind TestKind) targetStrings
 
     buildCtx <-
       runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

cabal-install/Distribution/Client/TargetSelector.hs

@@ -19,7 +19,7 @@ module Distribution.Client.TargetSelector (
     TargetSelector(..),
     TargetImplicitCwd(..),
     ComponentKind(..),
-    ComponentKindFilter,
+    AmbiguityResolver(..),
     SubComponentTarget(..),
     QualLevel(..),
     componentKind,
@@ -130,18 +130,18 @@ data TargetSelector =
      -- 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)
+     TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKind)
 
      -- | A package specified by name. This may refer to @extra-packages@ from
      -- the @cabal.project@ file, or a dependency of a known project package or
      -- could refer to a package from a hackage archive. It needs further
      -- context to resolve to a specific package.
      --
-   | TargetPackageNamed PackageName (Maybe ComponentKindFilter)
+   | TargetPackageNamed PackageName (Maybe ComponentKind)
 
      -- | All packages, or all components of a particular kind in all packages.
      --
-   | TargetAllPackages (Maybe ComponentKindFilter)
+   | TargetAllPackages (Maybe ComponentKind)
 
      -- | A specific component in a package within the project.
      --
@@ -167,7 +167,16 @@ data TargetImplicitCwd = TargetImplicitCwd | TargetExplicitNamed
 data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
   deriving (Eq, Ord, Enum, Show)
 
-type ComponentKindFilter = ComponentKind
+-- | Whenever there is an ambiguous TargetSelector from some user input, how
+-- should it be resolved?
+data AmbiguityResolver =
+                        -- | Treat ambiguity as an error
+                         AmbiguityResolverNone
+                        -- | Choose the first target
+                       | AmbiguityResolverFirst
+                        -- | Choose the target component with the specific kind
+                       | AmbiguityResolverKind ComponentKind
+  deriving (Eq, Ord, Show)
 
 -- | Either the component as a whole or detail about a file or module target
 -- within a component.
@@ -199,19 +208,25 @@ instance Structured SubComponentTarget
 -- the available packages (and their locations).
 --
 readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))]
-                    -> Maybe ComponentKindFilter
+                    -> AmbiguityResolver
                     -- ^ This parameter is used when there are ambiguous selectors.
-                    --   If it is 'Just', then we attempt to resolve ambiguitiy
-                    --   by applying it, since otherwise there is no way to allow
-                    --   contextually valid yet syntactically ambiguous selectors.
+                    --   If it is 'AmbiguityResolverKind', then we attempt to resolve
+                    --   ambiguitiy by applying it, since otherwise there is no
+                    --   way to allow contextually valid yet syntactically ambiguous
+                    --   selectors.
                     --   (#4676, #5461)
+                    --   If it is 'AmbiguityResolverFirst', then we resolve it by
+                    --   choosing just the first target. This is used by
+                    --   the show-build-info command.
+                    --   Otherwise, if it is 'AmbiguityResolverNone', we make
+                    --   ambiguity a 'TargetSelectorProblem'.
                     -> [String]
                     -> IO (Either [TargetSelectorProblem] [TargetSelector])
 readTargetSelectors = readTargetSelectorsWith defaultDirActions
 
 readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m
                         -> [PackageSpecifier (SourcePackage (PackageLocation a))]
-                        -> Maybe ComponentKindFilter
+                        -> AmbiguityResolver
                         -> [String]
                         -> m (Either [TargetSelectorProblem] [TargetSelector])
 readTargetSelectorsWith dirActions@DirActions{} pkgs mfilter targetStrs =
@@ -457,7 +472,7 @@ copyFileStatus src dst =
 --
 resolveTargetSelectors :: KnownTargets
                        -> [TargetStringFileStatus]
-                       -> Maybe ComponentKindFilter
+                       -> AmbiguityResolver
                        -> ([TargetSelectorProblem],
                            [TargetSelector])
 -- default local dir target if there's no given target:
@@ -478,7 +493,7 @@ resolveTargetSelectors knowntargets targetStrs mfilter =
   $ targetStrs
 
 resolveTargetSelector :: KnownTargets
-                      -> Maybe ComponentKindFilter
+                      -> AmbiguityResolver
                       -> TargetStringFileStatus
                       -> Either TargetSelectorProblem TargetSelector
 resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
@@ -497,14 +512,17 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
         | otherwise            -> Left (classifyMatchErrors errs)
 
       Ambiguous _          targets
-        | Just kfilter <- mfilter
+        | AmbiguityResolverKind kfilter <- mfilter
         , [target] <- applyKindFilter kfilter targets -> Right target
 
       Ambiguous exactMatch targets ->
         case disambiguateTargetSelectors
                matcher targetStrStatus exactMatch
                targets of
-          Right targets'   -> Left (TargetSelectorAmbiguous targetStr targets')
+          Right targets'   ->
+            case (targets', mfilter) of
+              ((_,t):_, AmbiguityResolverFirst) -> Right t
+              _ -> Left (TargetSelectorAmbiguous targetStr targets')
           Left ((m, ms):_) -> Left (MatchingInternalError targetStr m ms)
           Left []          -> internalError "resolveTargetSelector"
   where
@@ -559,7 +577,7 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
                      = innerErr (Just (kind,thing)) m
         innerErr c m = (c,m)
 
-    applyKindFilter :: ComponentKindFilter -> [TargetSelector] -> [TargetSelector]
+    applyKindFilter :: ComponentKind -> [TargetSelector] -> [TargetSelector]
     applyKindFilter kfilter = filter go
       where
         go (TargetPackage      _ _ (Just filter')) = kfilter == filter'