Skip to content

Commit 4b93757

Browse files
lukel97lukel97
committed
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.
1 parent 0587c91 commit 4b93757

11 files changed

+56
-33
lines changed

‎cabal-install/Distribution/Client/CmdBench.hs

+4-3
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ import Distribution.Client.ProjectOrchestration
2222
import Distribution.Client.CmdErrorMessages
2323
( renderTargetSelector, showTargetSelector, renderTargetProblem,
2424
renderTargetProblemNoTargets, plural, targetSelectorPluralPkgs,
25-
targetSelectorFilter )
25+
targetSelectorFilter, AmbiguityResolver(..) )
2626
import Distribution.Client.TargetProblem
2727
( TargetProblem (..) )
2828
import Distribution.Client.NixStyleOptions
@@ -87,7 +87,8 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
8787
baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
8888

8989
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
90-
=<< readTargetSelectors (localPackages baseCtx) (Just BenchKind) targetStrings
90+
=<< readTargetSelectors (localPackages baseCtx)
91+
(AmbiguityResolverKind BenchKind) targetStrings
9192

9293
buildCtx <-
9394
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do
@@ -120,7 +121,7 @@ benchAction flags@NixStyleFlags {..} targetStrings globalFlags = do
120121
runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes
121122
where
122123
verbosity = fromFlagOrDefault normal (configVerbosity configFlags)
123-
cliConfig = commandLineFlagsToProjectConfig globalFlags flags
124+
cliConfig = commandLineFlagsToProjectConfig globalFlags flags
124125
mempty -- ClientInstallFlags, not needed here
125126

126127
-- | This defines what a 'TargetSelector' means for the @bench@ command.

‎cabal-install/Distribution/Client/CmdBuild.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,8 @@ buildAction flags@NixStyleFlags { extraFlags = buildFlags, ..} targetStrings glo
106106

107107
targetSelectors <-
108108
either (reportTargetSelectorProblems verbosity) return
109-
=<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
109+
=<< readTargetSelectors (localPackages baseCtx)
110+
AmbiguityResolverNone targetStrings
110111

111112
buildCtx <-
112113
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

‎cabal-install/Distribution/Client/CmdErrorMessages.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ import Distribution.Client.TargetSelector
2121
import Distribution.Client.TargetProblem
2222
( TargetProblem(..), TargetProblem' )
2323
import Distribution.Client.TargetSelector
24-
( ComponentKind(..), ComponentKindFilter, TargetSelector(..),
24+
( ComponentKind(..), AmbiguityResolver(..), TargetSelector(..),
2525
componentKind, showTargetSelector )
2626

2727
import Distribution.Package
@@ -170,7 +170,7 @@ targetSelectorRefersToPkgs (TargetPackageNamed _ mkfilter) = isNothing mkfilter
170170
targetSelectorRefersToPkgs TargetComponent{} = False
171171
targetSelectorRefersToPkgs TargetComponentUnknown{} = False
172172

173-
targetSelectorFilter :: TargetSelector -> Maybe ComponentKindFilter
173+
targetSelectorFilter :: TargetSelector -> Maybe ComponentKind
174174
targetSelectorFilter (TargetPackage _ _ mkfilter) = mkfilter
175175
targetSelectorFilter (TargetPackageNamed _ mkfilter) = mkfilter
176176
targetSelectorFilter (TargetAllPackages mkfilter) = mkfilter

‎cabal-install/Distribution/Client/CmdHaddock.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -76,7 +76,8 @@ haddockAction flags@NixStyleFlags {..} targetStrings globalFlags = do
7676
baseCtx <- establishProjectBaseContext verbosity cliConfig HaddockCommand
7777

7878
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
79-
=<< readTargetSelectors (localPackages baseCtx) Nothing targetStrings
79+
=<< readTargetSelectors (localPackages baseCtx)
80+
AmbiguityResolverNone targetStrings
8081

8182
buildCtx <-
8283
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

‎cabal-install/Distribution/Client/CmdInstall.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -241,7 +241,7 @@ installAction flags@NixStyleFlags { extraFlags = clientInstallFlags', .. } targe
241241
targetSelectors <-
242242
either (reportTargetSelectorProblems verbosity) return
243243
=<< readTargetSelectors (localPackages localBaseCtx)
244-
Nothing targetStrings''
244+
AmbiguityResolverNone targetStrings''
245245

246246
(specs, selectors) <-
247247
getSpecsAndTargetSelectors
@@ -430,7 +430,7 @@ getSpecsAndTargetSelectors
430430
-> [TargetSelector]
431431
-> DistDirLayout
432432
-> ProjectBaseContext
433-
-> Maybe ComponentKindFilter
433+
-> Maybe ComponentKind
434434
-> IO ([PackageSpecifier UnresolvedSourcePackage], [TargetSelector])
435435
getSpecsAndTargetSelectors verbosity reducedVerbosity pkgDb targetSelectors localDistDirLayout localBaseCtx targetFilter =
436436
withInstallPlan reducedVerbosity localBaseCtx $ \elaboratedPlan _ -> do

‎cabal-install/Distribution/Client/CmdRepl.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ import qualified Distribution.Types.Lens as L
2626
import Distribution.Client.NixStyleOptions
2727
( NixStyleFlags (..), nixStyleOptions, defaultNixStyleFlags )
2828
import Distribution.Client.CmdErrorMessages
29-
( renderTargetSelector, showTargetSelector,
29+
( renderTargetSelector, showTargetSelector, AmbiguityResolver(..),
3030
renderTargetProblem,
3131
targetSelectorRefersToPkgs,
3232
renderComponentKind, renderListCommaAnd, renderListSemiAnd,
@@ -344,7 +344,7 @@ withProject cliConfig verbosity targetStrings = do
344344
baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
345345

346346
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
347-
=<< readTargetSelectors (localPackages baseCtx) (Just LibKind) targetStrings
347+
=<< readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind LibKind) targetStrings
348348

349349
return (baseCtx, targetSelectors, return (), ProjectRepl)
350350

‎cabal-install/Distribution/Client/CmdRun.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -59,7 +59,7 @@ import Distribution.Client.ProjectPlanning
5959
import Distribution.Client.ProjectPlanning.Types
6060
( dataDirsEnvironmentForPlan )
6161
import Distribution.Client.TargetSelector
62-
( TargetSelectorProblem(..), TargetString(..) )
62+
( TargetSelectorProblem(..), TargetString(..), AmbiguityResolver(..) )
6363
import Distribution.Client.InstallPlan
6464
( toList, foldPlanPackage )
6565
import Distribution.Types.UnqualComponentName
@@ -182,7 +182,7 @@ runAction flags@NixStyleFlags {..} targetStrings globalFlags = do
182182
else reportTargetSelectorProblems verbosity err
183183

184184
(baseCtx', targetSelectors) <-
185-
readTargetSelectors (localPackages baseCtx) (Just ExeKind) (take 1 targetStrings)
185+
readTargetSelectors (localPackages baseCtx) (AmbiguityResolverKind ExeKind) (take 1 targetStrings)
186186
>>= \case
187187
Left err@(TargetSelectorNoTargetsInProject:_)
188188
| (script:_) <- targetStrings -> scriptOrError script err

‎cabal-install/Distribution/Client/CmdSdist.hs

+2-2
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,7 @@ import Distribution.Client.ProjectOrchestration
1818
import Distribution.Client.NixStyleOptions
1919
( NixStyleFlags (..), defaultNixStyleFlags )
2020
import Distribution.Client.TargetSelector
21-
( TargetSelector(..), ComponentKind
21+
( TargetSelector(..), ComponentKind, AmbiguityResolver(..)
2222
, readTargetSelectors, reportTargetSelectorProblems )
2323
import Distribution.Client.Setup
2424
( GlobalFlags(..) )
@@ -151,7 +151,7 @@ sdistAction (ProjectFlags{..}, SdistFlags{..}) targetStrings globalFlags = do
151151
let localPkgs = localPackages baseCtx
152152

153153
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
154-
=<< readTargetSelectors localPkgs Nothing targetStrings
154+
=<< readTargetSelectors localPkgs AmbiguityResolverNone targetStrings
155155

156156
-- elaborate path, create target directory
157157
mOutputPath' <- case mOutputPath of

‎cabal-install/Distribution/Client/CmdShowBuildInfo.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -114,7 +114,7 @@ showBuildInfoAction flags@NixStyleFlags { extraFlags = (ShowBuildInfoFlags fileO
114114
}
115115

116116
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
117-
=<< readTargetSelectors (localPackages baseCtx') Nothing targetStrings
117+
=<< readTargetSelectors (localPackages baseCtx') AmbiguityResolverFirst targetStrings
118118

119119
buildCtx <-
120120
runProjectPreBuildPhase verbosity baseCtx' $ \elaboratedPlan -> do

‎cabal-install/Distribution/Client/CmdTest.hs

+4-2
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,8 @@ import Distribution.Client.ProjectOrchestration
2222
import Distribution.Client.CmdErrorMessages
2323
( renderTargetSelector, showTargetSelector, targetSelectorFilter, plural,
2424
renderTargetProblem,
25-
renderTargetProblemNoTargets, targetSelectorPluralPkgs )
25+
renderTargetProblemNoTargets, targetSelectorPluralPkgs,
26+
AmbiguityResolver(..) )
2627
import Distribution.Client.TargetProblem
2728
( TargetProblem (..) )
2829
import Distribution.Client.NixStyleOptions
@@ -99,7 +100,8 @@ testAction flags@NixStyleFlags {..} targetStrings globalFlags = do
99100
baseCtx <- establishProjectBaseContext verbosity cliConfig OtherCommand
100101

101102
targetSelectors <- either (reportTargetSelectorProblems verbosity) return
102-
=<< readTargetSelectors (localPackages baseCtx) (Just TestKind) targetStrings
103+
=<< readTargetSelectors (localPackages baseCtx)
104+
(AmbiguityResolverKind TestKind) targetStrings
103105

104106
buildCtx <-
105107
runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do

‎cabal-install/Distribution/Client/TargetSelector.hs

+33-15
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ module Distribution.Client.TargetSelector (
1919
TargetSelector(..),
2020
TargetImplicitCwd(..),
2121
ComponentKind(..),
22-
ComponentKindFilter,
22+
AmbiguityResolver(..),
2323
SubComponentTarget(..),
2424
QualLevel(..),
2525
componentKind,
@@ -130,18 +130,18 @@ data TargetSelector =
130130
-- These are always packages that are local to the project. In the case
131131
-- that there is more than one, they all share the same directory location.
132132
--
133-
TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKindFilter)
133+
TargetPackage TargetImplicitCwd [PackageId] (Maybe ComponentKind)
134134

135135
-- | A package specified by name. This may refer to @extra-packages@ from
136136
-- the @cabal.project@ file, or a dependency of a known project package or
137137
-- could refer to a package from a hackage archive. It needs further
138138
-- context to resolve to a specific package.
139139
--
140-
| TargetPackageNamed PackageName (Maybe ComponentKindFilter)
140+
| TargetPackageNamed PackageName (Maybe ComponentKind)
141141

142142
-- | All packages, or all components of a particular kind in all packages.
143143
--
144-
| TargetAllPackages (Maybe ComponentKindFilter)
144+
| TargetAllPackages (Maybe ComponentKind)
145145

146146
-- | A specific component in a package within the project.
147147
--
@@ -167,7 +167,16 @@ data TargetImplicitCwd = TargetImplicitCwd | TargetExplicitNamed
167167
data ComponentKind = LibKind | FLibKind | ExeKind | TestKind | BenchKind
168168
deriving (Eq, Ord, Enum, Show)
169169

170-
type ComponentKindFilter = ComponentKind
170+
-- | Whenever there is an ambiguous TargetSelector from some user input, how
171+
-- should it be resolved?
172+
data AmbiguityResolver =
173+
-- | Treat ambiguity as an error
174+
AmbiguityResolverNone
175+
-- | Choose the first target
176+
| AmbiguityResolverFirst
177+
-- | Choose the target component with the specific kind
178+
| AmbiguityResolverKind ComponentKind
179+
deriving (Eq, Ord, Show)
171180

172181
-- | Either the component as a whole or detail about a file or module target
173182
-- within a component.
@@ -199,19 +208,25 @@ instance Structured SubComponentTarget
199208
-- the available packages (and their locations).
200209
--
201210
readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))]
202-
-> Maybe ComponentKindFilter
211+
-> AmbiguityResolver
203212
-- ^ This parameter is used when there are ambiguous selectors.
204-
-- If it is 'Just', then we attempt to resolve ambiguitiy
205-
-- by applying it, since otherwise there is no way to allow
206-
-- contextually valid yet syntactically ambiguous selectors.
213+
-- If it is 'AmbiguityResolverKind', then we attempt to resolve
214+
-- ambiguitiy by applying it, since otherwise there is no
215+
-- way to allow contextually valid yet syntactically ambiguous
216+
-- selectors.
207217
-- (#4676, #5461)
218+
-- If it is 'AmbiguityResolverFirst', then we resolve it by
219+
-- choosing just the first target. This is used by
220+
-- the show-build-info command.
221+
-- Otherwise, if it is 'AmbiguityResolverNone', we make
222+
-- ambiguity a 'TargetSelectorProblem'.
208223
-> [String]
209224
-> IO (Either [TargetSelectorProblem] [TargetSelector])
210225
readTargetSelectors = readTargetSelectorsWith defaultDirActions
211226

212227
readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m
213228
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
214-
-> Maybe ComponentKindFilter
229+
-> AmbiguityResolver
215230
-> [String]
216231
-> m (Either [TargetSelectorProblem] [TargetSelector])
217232
readTargetSelectorsWith dirActions@DirActions{} pkgs mfilter targetStrs =
@@ -457,7 +472,7 @@ copyFileStatus src dst =
457472
--
458473
resolveTargetSelectors :: KnownTargets
459474
-> [TargetStringFileStatus]
460-
-> Maybe ComponentKindFilter
475+
-> AmbiguityResolver
461476
-> ([TargetSelectorProblem],
462477
[TargetSelector])
463478
-- default local dir target if there's no given target:
@@ -478,7 +493,7 @@ resolveTargetSelectors knowntargets targetStrs mfilter =
478493
$ targetStrs
479494

480495
resolveTargetSelector :: KnownTargets
481-
-> Maybe ComponentKindFilter
496+
-> AmbiguityResolver
482497
-> TargetStringFileStatus
483498
-> Either TargetSelectorProblem TargetSelector
484499
resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
@@ -497,14 +512,17 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
497512
| otherwise -> Left (classifyMatchErrors errs)
498513

499514
Ambiguous _ targets
500-
| Just kfilter <- mfilter
515+
| AmbiguityResolverKind kfilter <- mfilter
501516
, [target] <- applyKindFilter kfilter targets -> Right target
502517

503518
Ambiguous exactMatch targets ->
504519
case disambiguateTargetSelectors
505520
matcher targetStrStatus exactMatch
506521
targets of
507-
Right targets' -> Left (TargetSelectorAmbiguous targetStr targets')
522+
Right targets' ->
523+
case (targets', mfilter) of
524+
((_,t):_, AmbiguityResolverFirst) -> Right t
525+
_ -> Left (TargetSelectorAmbiguous targetStr targets')
508526
Left ((m, ms):_) -> Left (MatchingInternalError targetStr m ms)
509527
Left [] -> internalError "resolveTargetSelector"
510528
where
@@ -559,7 +577,7 @@ resolveTargetSelector knowntargets@KnownTargets{..} mfilter targetStrStatus =
559577
= innerErr (Just (kind,thing)) m
560578
innerErr c m = (c,m)
561579

562-
applyKindFilter :: ComponentKindFilter -> [TargetSelector] -> [TargetSelector]
580+
applyKindFilter :: ComponentKind -> [TargetSelector] -> [TargetSelector]
563581
applyKindFilter kfilter = filter go
564582
where
565583
go (TargetPackage _ _ (Just filter')) = kfilter == filter'

0 commit comments

Comments
 (0)