Commit ff9d62dc authored by Oleg Grenrus's avatar Oleg Grenrus

Resolve #6369: Allow cabal v2-install pkgname:exename

parent 097ee377
......@@ -28,6 +28,7 @@ import Distribution.Client.CmdErrorMessages
import Distribution.Client.CmdSdist
import Distribution.Client.CmdInstall.ClientInstallFlags
import Distribution.Client.CmdInstall.ClientInstallTargetSelector
import Distribution.Client.Setup
( GlobalFlags(..), ConfigFlags(..), ConfigExFlags, InstallFlags(..)
......@@ -401,11 +402,7 @@ installAction ( configFlags, configExFlags, installFlags
withoutProject :: ProjectConfig -> IO ([PackageSpecifier pkg], [TargetSelector], ProjectConfig)
withoutProject globalConfig = do
let
parsePkg pkgName
| Just (pkg :: PackageId) <- simpleParse pkgName = return pkg
| otherwise = die' verbosity ("Invalid package ID: " ++ pkgName)
packageIds <- mapM parsePkg targetStrings'
tss <- mapM (parseWithoutProjectTargetSelector verbosity) targetStrings'
cabalDir <- getCabalDir
let
......@@ -431,25 +428,21 @@ installAction ( configFlags, configExFlags, installFlags
verbosity buildSettings
(getSourcePackages verbosity)
for_ targetStrings' $ \case
name
| null (lookupPackageName packageIndex (mkPackageName name))
, xs@(_:_) <- searchByName packageIndex name ->
die' verbosity . concat $
[ "Unknown package \"", name, "\". "
, "Did you mean any of the following?\n"
, unlines (("- " ++) . unPackageName . fst <$> xs)
]
_ -> return ()
for_ (concatMap woPackageNames tss) $ \name -> do
when (null (lookupPackageName packageIndex name)) $ do
let xs = searchByName packageIndex (unPackageName name)
let emptyIf True _ = []
emptyIf False zs = zs
die' verbosity $ concat $
[ "Unknown package \"", unPackageName name, "\". "
] ++ emptyIf (null xs)
[ "Did you mean any of the following?\n"
, unlines (("- " ++) . unPackageName . fst <$> xs)
]
let
packageSpecifiers = flip fmap packageIds $ \case
PackageIdentifier{..}
| pkgVersion == nullVersion -> NamedPackage pkgName []
| otherwise -> NamedPackage pkgName
[PackagePropertyVersion
(thisVersion pkgVersion)]
packageTargets = flip TargetPackageNamed Nothing . pkgName <$> packageIds
packageSpecifiers = woPackageSpecifiers <$> tss
packageTargets = woPackageTargets <$> tss
return (packageSpecifiers, packageTargets, projectConfig)
let
......
module Distribution.Client.CmdInstall.ClientInstallTargetSelector (
WithoutProjectTargetSelector (..),
parseWithoutProjectTargetSelector,
woPackageNames,
woPackageTargets,
woPackageSpecifiers,
) where
import Distribution.Client.Compat.Prelude
import Prelude ()
import Distribution.Client.TargetSelector
import Distribution.Client.Types
import Distribution.Compat.CharParsing (char, optional)
import Distribution.Package
import Distribution.Parsec
import Distribution.Simple.LocalBuildInfo (ComponentName (CExeName))
import Distribution.Simple.Utils (die')
import Distribution.Solver.Types.PackageConstraint (PackageProperty (..))
import Distribution.Verbosity (Verbosity)
import Distribution.Version
data WithoutProjectTargetSelector
= WoPackageId PackageId
| WoPackageComponent PackageId ComponentName
-- | WoURI URI
deriving (Show)
parseWithoutProjectTargetSelector :: Verbosity -> String -> IO WithoutProjectTargetSelector
parseWithoutProjectTargetSelector verbosity input =
case explicitEitherParsec parser input of
Right ts -> return ts
Left err -> die' verbosity $ "Invalid package ID: " ++ input ++ "\n" ++ err
where
parser :: ParsecParser WithoutProjectTargetSelector
parser = do
pid <- parsec
cn <- optional (char ':' *> parsec)
return $ case cn of
Nothing -> WoPackageId pid
Just cn' -> WoPackageComponent pid (CExeName cn')
woPackageNames :: WithoutProjectTargetSelector -> [PackageName]
woPackageNames (WoPackageId pid) = [pkgName pid]
woPackageNames (WoPackageComponent pid _) = [pkgName pid]
woPackageTargets :: WithoutProjectTargetSelector -> TargetSelector
woPackageTargets (WoPackageId pid) =
TargetPackageNamed (pkgName pid) Nothing
woPackageTargets (WoPackageComponent pid cn) =
TargetComponentUnknown (pkgName pid) (Right cn) WholeComponent
woPackageSpecifiers :: WithoutProjectTargetSelector -> PackageSpecifier pkg
woPackageSpecifiers (WoPackageId pid) = pidPackageSpecifiers pid
woPackageSpecifiers (WoPackageComponent pid _) = pidPackageSpecifiers pid
pidPackageSpecifiers :: PackageId -> PackageSpecifier pkg
pidPackageSpecifiers pid
| pkgVersion pid == nullVersion = NamedPackage (pkgName pid) []
| otherwise = NamedPackage (pkgName pid)
[ PackagePropertyVersion (thisVersion (pkgVersion pid))
]
......@@ -168,6 +168,7 @@ executable cabal
Distribution.Client.CmdHaddock
Distribution.Client.CmdInstall
Distribution.Client.CmdInstall.ClientInstallFlags
Distribution.Client.CmdInstall.ClientInstallTargetSelector
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
Distribution.Client.CmdRun.ClientRunFlags
......
......@@ -107,6 +107,7 @@ Version: 3.3.0.0
Distribution.Client.CmdHaddock
Distribution.Client.CmdInstall
Distribution.Client.CmdInstall.ClientInstallFlags
Distribution.Client.CmdInstall.ClientInstallTargetSelector
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
Distribution.Client.CmdRun.ClientRunFlags
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment