Skip to content

Commit ff9d62d

Browse files
committed
Resolve #6369: Allow cabal v2-install pkgname:exename
1 parent 097ee37 commit ff9d62d

File tree

4 files changed

+79
-22
lines changed

4 files changed

+79
-22
lines changed

cabal-install/Distribution/Client/CmdInstall.hs

Lines changed: 15 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ import Distribution.Client.CmdErrorMessages
2828
import Distribution.Client.CmdSdist
2929

3030
import Distribution.Client.CmdInstall.ClientInstallFlags
31+
import Distribution.Client.CmdInstall.ClientInstallTargetSelector
3132

3233
import Distribution.Client.Setup
3334
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..)
@@ -401,11 +402,7 @@ installAction ( configFlags, configExFlags, installFlags
401402

402403
withoutProject :: ProjectConfig -> IO ([PackageSpecifier pkg], [TargetSelector], ProjectConfig)
403404
withoutProject globalConfig = do
404-
let
405-
parsePkg pkgName
406-
| Just (pkg :: PackageId) <- simpleParse pkgName = return pkg
407-
| otherwise = die' verbosity ("Invalid package ID: " ++ pkgName)
408-
packageIds <- mapM parsePkg targetStrings'
405+
tss <- mapM (parseWithoutProjectTargetSelector verbosity) targetStrings'
409406

410407
cabalDir <- getCabalDir
411408
let
@@ -431,25 +428,21 @@ installAction ( configFlags, configExFlags, installFlags
431428
verbosity buildSettings
432429
(getSourcePackages verbosity)
433430

434-
for_ targetStrings' $ \case
435-
name
436-
| null (lookupPackageName packageIndex (mkPackageName name))
437-
, xs@(_:_) <- searchByName packageIndex name ->
438-
die' verbosity . concat $
439-
[ "Unknown package \"", name, "\". "
440-
, "Did you mean any of the following?\n"
441-
, unlines (("- " ++) . unPackageName . fst <$> xs)
442-
]
443-
_ -> return ()
431+
for_ (concatMap woPackageNames tss) $ \name -> do
432+
when (null (lookupPackageName packageIndex name)) $ do
433+
let xs = searchByName packageIndex (unPackageName name)
434+
let emptyIf True _ = []
435+
emptyIf False zs = zs
436+
die' verbosity $ concat $
437+
[ "Unknown package \"", unPackageName name, "\". "
438+
] ++ emptyIf (null xs)
439+
[ "Did you mean any of the following?\n"
440+
, unlines (("- " ++) . unPackageName . fst <$> xs)
441+
]
444442

445443
let
446-
packageSpecifiers = flip fmap packageIds $ \case
447-
PackageIdentifier{..}
448-
| pkgVersion == nullVersion -> NamedPackage pkgName []
449-
| otherwise -> NamedPackage pkgName
450-
[PackagePropertyVersion
451-
(thisVersion pkgVersion)]
452-
packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds
444+
packageSpecifiers = woPackageSpecifiers <$> tss
445+
packageTargets = woPackageTargets <$> tss
453446
return (packageSpecifiers, packageTargets, projectConfig)
454447

455448
let
Lines changed: 62 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,62 @@
1+
module Distribution.Client.CmdInstall.ClientInstallTargetSelector (
2+
WithoutProjectTargetSelector (..),
3+
parseWithoutProjectTargetSelector,
4+
woPackageNames,
5+
woPackageTargets,
6+
woPackageSpecifiers,
7+
) where
8+
9+
import Distribution.Client.Compat.Prelude
10+
import Prelude ()
11+
12+
import Distribution.Client.TargetSelector
13+
import Distribution.Client.Types
14+
import Distribution.Compat.CharParsing (char, optional)
15+
import Distribution.Package
16+
import Distribution.Parsec
17+
import Distribution.Simple.LocalBuildInfo (ComponentName (CExeName))
18+
import Distribution.Simple.Utils (die')
19+
import Distribution.Solver.Types.PackageConstraint (PackageProperty (..))
20+
import Distribution.Verbosity (Verbosity)
21+
import Distribution.Version
22+
23+
data WithoutProjectTargetSelector
24+
= WoPackageId PackageId
25+
| WoPackageComponent PackageId ComponentName
26+
-- | WoURI URI
27+
deriving (Show)
28+
29+
parseWithoutProjectTargetSelector :: Verbosity -> String -> IO WithoutProjectTargetSelector
30+
parseWithoutProjectTargetSelector verbosity input =
31+
case explicitEitherParsec parser input of
32+
Right ts -> return ts
33+
Left err -> die' verbosity $ "Invalid package ID: " ++ input ++ "\n" ++ err
34+
where
35+
parser :: ParsecParser WithoutProjectTargetSelector
36+
parser = do
37+
pid <- parsec
38+
cn <- optional (char ':' *> parsec)
39+
return $ case cn of
40+
Nothing -> WoPackageId pid
41+
Just cn' -> WoPackageComponent pid (CExeName cn')
42+
43+
woPackageNames :: WithoutProjectTargetSelector -> [PackageName]
44+
woPackageNames (WoPackageId pid) = [pkgName pid]
45+
woPackageNames (WoPackageComponent pid _) = [pkgName pid]
46+
47+
woPackageTargets :: WithoutProjectTargetSelector -> TargetSelector
48+
woPackageTargets (WoPackageId pid) =
49+
TargetPackageNamed (pkgName pid) Nothing
50+
woPackageTargets (WoPackageComponent pid cn) =
51+
TargetComponentUnknown (pkgName pid) (Right cn) WholeComponent
52+
53+
woPackageSpecifiers :: WithoutProjectTargetSelector -> PackageSpecifier pkg
54+
woPackageSpecifiers (WoPackageId pid) = pidPackageSpecifiers pid
55+
woPackageSpecifiers (WoPackageComponent pid _) = pidPackageSpecifiers pid
56+
57+
pidPackageSpecifiers :: PackageId -> PackageSpecifier pkg
58+
pidPackageSpecifiers pid
59+
| pkgVersion pid == nullVersion = NamedPackage (pkgName pid) []
60+
| otherwise = NamedPackage (pkgName pid)
61+
[ PackagePropertyVersion (thisVersion (pkgVersion pid))
62+
]

cabal-install/cabal-install.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -168,6 +168,7 @@ executable cabal
168168
Distribution.Client.CmdHaddock
169169
Distribution.Client.CmdInstall
170170
Distribution.Client.CmdInstall.ClientInstallFlags
171+
Distribution.Client.CmdInstall.ClientInstallTargetSelector
171172
Distribution.Client.CmdRepl
172173
Distribution.Client.CmdRun
173174
Distribution.Client.CmdRun.ClientRunFlags

cabal-install/cabal-install.cabal.pp

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -107,6 +107,7 @@
107107
Distribution.Client.CmdHaddock
108108
Distribution.Client.CmdInstall
109109
Distribution.Client.CmdInstall.ClientInstallFlags
110+
Distribution.Client.CmdInstall.ClientInstallTargetSelector
110111
Distribution.Client.CmdRepl
111112
Distribution.Client.CmdRun
112113
Distribution.Client.CmdRun.ClientRunFlags

0 commit comments

Comments
 (0)