Skip to content

Commit

Permalink
Resolve haskell#6369: Allow cabal v2-install pkgname:exename
Browse files Browse the repository at this point in the history
  • Loading branch information
phadej committed Mar 11, 2020
1 parent 866f0f8 commit 65ca180
Show file tree
Hide file tree
Showing 4 changed files with 79 additions and 22 deletions.
37 changes: 15 additions & 22 deletions cabal-install/Distribution/Client/CmdInstall.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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(..)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Original file line number Diff line number Diff line change
@@ -0,0 +1,62 @@
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))
]
1 change: 1 addition & 0 deletions cabal-install/cabal-install.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions cabal-install/cabal-install.cabal.pp
Original file line number Diff line number Diff line change
Expand Up @@ -107,6 +107,7 @@
Distribution.Client.CmdHaddock
Distribution.Client.CmdInstall
Distribution.Client.CmdInstall.ClientInstallFlags
Distribution.Client.CmdInstall.ClientInstallTargetSelector
Distribution.Client.CmdRepl
Distribution.Client.CmdRun
Distribution.Client.CmdRun.ClientRunFlags
Expand Down

0 comments on commit 65ca180

Please sign in to comment.