From 65ca18033b0dcdbbcbd307c9d413eb229947c05e Mon Sep 17 00:00:00 2001
From: Oleg Grenrus <oleg.grenrus@iki.fi>
Date: Wed, 11 Mar 2020 16:59:23 +0200
Subject: [PATCH] Resolve #6369: Allow cabal v2-install pkgname:exename

---
 .../Distribution/Client/CmdInstall.hs         | 37 +++++------
 .../CmdInstall/ClientInstallTargetSelector.hs | 62 +++++++++++++++++++
 cabal-install/cabal-install.cabal             |  1 +
 cabal-install/cabal-install.cabal.pp          |  1 +
 4 files changed, 79 insertions(+), 22 deletions(-)
 create mode 100644 cabal-install/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs

diff --git a/cabal-install/Distribution/Client/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs
index 2fe38fa963b..4c7a124b21b 100644
--- a/cabal-install/Distribution/Client/CmdInstall.hs
+++ b/cabal-install/Distribution/Client/CmdInstall.hs
@@ -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
diff --git a/cabal-install/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs b/cabal-install/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
new file mode 100644
index 00000000000..70ca5f247c8
--- /dev/null
+++ b/cabal-install/Distribution/Client/CmdInstall/ClientInstallTargetSelector.hs
@@ -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))
+        ]
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index 8a85e482a95..ea7bf9bc6f6 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -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
diff --git a/cabal-install/cabal-install.cabal.pp b/cabal-install/cabal-install.cabal.pp
index 15546093db9..23d26f7133f 100644
--- a/cabal-install/cabal-install.cabal.pp
+++ b/cabal-install/cabal-install.cabal.pp
@@ -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