diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index 629df6fb172..5b6d10ddf6e 100644 --- a/cabal-install/Distribution/Client/CmdBench.hs +++ b/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. diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 2fe43f596d1..76ba3bb0faa 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs index 32abb2395cb..033a8eb9588 100644 --- a/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdHaddock.hs b/cabal-install/Distribution/Client/CmdHaddock.hs index 50d8d745208..caa896aa041 100644 --- a/cabal-install/Distribution/Client/CmdHaddock.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs index 946cb145335..69ac1fc28e7 100644 --- a/cabal-install/Distribution/Client/CmdInstall.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index 71d811102b4..8953aacbcec 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/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) diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 48e895769d0..1880d143300 100644 --- a/cabal-install/Distribution/Client/CmdRun.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdSdist.hs b/cabal-install/Distribution/Client/CmdSdist.hs index ec268a55533..dd537179e71 100644 --- a/cabal-install/Distribution/Client/CmdSdist.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs b/cabal-install/Distribution/Client/CmdShowBuildInfo.hs index a10fcf5ad1f..76c83ead864 100644 --- a/cabal-install/Distribution/Client/CmdShowBuildInfo.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs index cc1f49ed398..e9f53f1e084 100644 --- a/cabal-install/Distribution/Client/CmdTest.hs +++ b/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 diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index e08cdc92347..e9cb519d7d2 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/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'