Include package version in --promised-dependency flag

In the original implementation of promised dependencies I accidentally
left over the hard coded `currentCabalId` in the `configureDependencies`
function.

This led to several errors happening later when the package name and
version would be incorrect if you looked at this field (package
arguments are not computed using it), it is used when generating cabal
macros and something in the haddock options.

The solution is to pass the package version in the
`--promised-depenency` flag so the format is now

```
NAME-VER[:COMPONENT_NAME]=CID`
```

rather than

```
NAME[:COMPONENT_NAME]=CID
```

Fixes #10166

Author: mpickering

Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs

@@ -39,7 +39,7 @@ md5CheckGenericPackageDescription proxy = md5Check proxy
 md5CheckLocalBuildInfo :: Proxy LocalBuildInfo -> Assertion
 md5CheckLocalBuildInfo proxy = md5Check proxy
 #if MIN_VERSION_base(4,19,0)
-    0xc68e9c0758c4bf2d72fe82b3d55cee34
+    0x041c4f233ad92ae5c3fc4e0384f993ff
 #else
-    0xcf7e7bbcaec504d745fe086eec1786ff
+    0x26e4eb4ac4691ca0432e8622eb5a5016
 #endif

Cabal/src/Distribution/Backpack/Configure.hs

@@ -70,7 +70,7 @@ configureComponentLocalBuildInfos
   -> Flag String -- configIPID
   -> Flag ComponentId -- configCID
   -> PackageDescription
-  -> ([PreExistingComponent], [PromisedComponent])
+  -> ([PreExistingComponent], [ConfiguredPromisedComponent])
   -> FlagAssignment -- configConfigurationsFlags
   -> [(ModuleName, Module)] -- configInstantiateWith
   -> InstalledPackageIndex
@@ -118,7 +118,7 @@ configureComponentLocalBuildInfos
             `Map.union` Map.fromListWith
               Map.union
               [ (pkg, Map.singleton (ann_cname aid) aid)
-              | PromisedComponent pkg aid <- promisedPkgDeps
+              | ConfiguredPromisedComponent pkg aid <- promisedPkgDeps
               ]
     graph1 <-
       toConfiguredComponents
@@ -151,7 +151,7 @@ configureComponentLocalBuildInfos
                   , emptyModuleShape
                   )
                 )
-              | PromisedComponent _ aid <- promisedPkgDeps
+              | ConfiguredPromisedComponent _ aid <- promisedPkgDeps
               ]
         uid_lookup def_uid
           | Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid =
@@ -208,7 +208,7 @@ configureComponentLocalBuildInfos
 toComponentLocalBuildInfos
   :: Compiler
   -> InstalledPackageIndex -- FULL set
-  -> [PromisedComponent]
+  -> [ConfiguredPromisedComponent]
   -> PackageDescription
   -> [PreExistingComponent] -- external package deps
   -> [ReadyComponent]

Cabal/src/Distribution/Backpack/PreExistingComponent.hs

@@ -1,7 +1,7 @@
 -- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
 module Distribution.Backpack.PreExistingComponent
   ( PreExistingComponent (..)
-  , PromisedComponent (..)
+  , ConfiguredPromisedComponent (..)
   , ipiToPreExistingComponent
   ) where
 
@@ -24,12 +24,12 @@ import Distribution.Types.AnnotatedId
 -- These components are promised to @configure@ but are not yet built.
 --
 -- In other words this is 'PreExistingComponent' which doesn't yet exist.
-data PromisedComponent = PromisedComponent
+data ConfiguredPromisedComponent = ConfiguredPromisedComponent
   { pr_pkgname :: PackageName
   , pr_cid :: AnnotatedId ComponentId
   }
 
-instance Package PromisedComponent where
+instance Package ConfiguredPromisedComponent where
   packageId = packageId . pr_cid
 
 -- | Stripped down version of 'LinkedComponent' for things

Cabal/src/Distribution/Simple/Configure.hs

@@ -828,7 +828,7 @@ computeLocalBuildConfig cfg comp programDb = do
 
 data PackageInfo = PackageInfo
   { internalPackageSet :: Set LibraryName
-  , promisedDepsSet :: Map (PackageName, ComponentName) ComponentId
+  , promisedDepsSet :: Map (PackageName, ComponentName) PromisedComponent
   , installedPackageSet :: InstalledPackageIndex
   , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo
   }
@@ -1113,7 +1113,7 @@ finalCheckPackage
   -> LBC.PackageBuildDescr
   -> HookedBuildInfo
   -> PackageInfo
-  -> IO ([PreExistingComponent], [PromisedComponent])
+  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
 finalCheckPackage
   g_pkg_descr
   ( LBC.PackageBuildDescr
@@ -1210,7 +1210,7 @@ configureComponents
   :: LBC.LocalBuildConfig
   -> LBC.PackageBuildDescr
   -> PackageInfo
-  -> ([PreExistingComponent], [PromisedComponent])
+  -> ([PreExistingComponent], [ConfiguredPromisedComponent])
   -> IO LocalBuildInfo
 configureComponents
   lbc@(LBC.LocalBuildConfig{withPrograms = programDb})
@@ -1371,8 +1371,8 @@ configureComponents
 
       return lbi
 
-mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId
-mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps]
+mkPromisedDepsSet :: [PromisedComponent] -> Map (PackageName, ComponentName) PromisedComponent
+mkPromisedDepsSet comps = Map.fromList [((packageName pn, CLibName ln), p) | p@(PromisedComponent pn ln _) <- comps]
 
 -- | Adds the extra program paths from the flags provided to @configure@ as
 -- well as specified locations for certain known programs and their default
@@ -1475,7 +1475,7 @@ dependencySatisfiable
   -- ^ installed set
   -> Set LibraryName
   -- ^ library components
-  -> Map (PackageName, ComponentName) ComponentId
+  -> Map (PackageName, ComponentName) PromisedComponent
   -> Map (PackageName, ComponentName) InstalledPackageInfo
   -- ^ required dependencies
   -> (Dependency -> Bool)
@@ -1637,14 +1637,14 @@ configureDependencies
   :: Verbosity
   -> UseExternalInternalDeps
   -> Set LibraryName
-  -> Map (PackageName, ComponentName) ComponentId
+  -> Map (PackageName, ComponentName) PromisedComponent
   -> InstalledPackageIndex
   -- ^ installed packages
   -> Map (PackageName, ComponentName) InstalledPackageInfo
   -- ^ required deps
   -> PackageDescription
   -> ComponentRequestedSpec
-  -> IO ([PreExistingComponent], [PromisedComponent])
+  -> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
 configureDependencies
   verbosity
   use_external_internal_deps
@@ -1910,7 +1910,7 @@ data DependencyResolution
     -- we need to build packages in the interactive ghci session, no matter
     -- whether they have been built before.
     -- Building them in the configure phase is then redundant and costs time.
-    PromisedDependency PromisedComponent
+    PromisedDependency ConfiguredPromisedComponent
   | -- | An internal dependency ('PackageId' should be a library name)
     -- which we are going to have to build.  (The
     -- 'PackageId' here is a hack to get a modest amount of
@@ -1923,7 +1923,7 @@ selectDependency
   -- ^ Package id of current package
   -> Set LibraryName
   -- ^ package libraries
-  -> Map (PackageName, ComponentName) ComponentId
+  -> Map (PackageName, ComponentName) PromisedComponent
   -- ^ Set of components that are promised, i.e. are not installed already. See 'PromisedDependency' for more details.
   -> InstalledPackageIndex
   -- ^ Installed packages
@@ -1975,8 +1975,8 @@ selectDependency
       -- We have to look it up externally
       do_external_external :: LibraryName -> Either FailedDependency DependencyResolution
       do_external_external lib
-        | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =
-            return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid))
+        | Just pc <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =
+            return $ PromisedDependency (ConfiguredPromisedComponent dep_pkgname (AnnotatedId (promisedComponentPackage pc) (CLibName lib) (promisedComponentId pc)))
       do_external_external lib = do
         ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of
           -- If we know the exact pkg to use, then use it.
@@ -1989,8 +1989,8 @@ selectDependency
 
       do_external_internal :: LibraryName -> Either FailedDependency DependencyResolution
       do_external_internal lib
-        | Just cid <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =
-            return $ PromisedDependency (PromisedComponent dep_pkgname (AnnotatedId currentCabalId (CLibName lib) cid))
+        | Just pc <- Map.lookup (dep_pkgname, CLibName lib) promisedIndex =
+            return $ PromisedDependency (ConfiguredPromisedComponent dep_pkgname (AnnotatedId (promisedComponentPackage pc) (CLibName lib) (promisedComponentId pc)))
       do_external_internal lib = do
         ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of
           -- If we know the exact pkg to use, then use it.

Cabal/src/Distribution/Simple/GHC/Internal.hs

@@ -75,8 +75,8 @@ import Distribution.Simple.Program.GHC
 import Distribution.Simple.Setup.Common (extraCompilationArtifacts)
 import Distribution.Simple.Utils
 import Distribution.System
-import Distribution.Types.ComponentId (ComponentId)
 import Distribution.Types.ComponentLocalBuildInfo
+import Distribution.Types.GivenComponent
 import Distribution.Types.LocalBuildInfo
 import Distribution.Types.TargetInfo
 import Distribution.Types.UnitId
@@ -672,15 +672,15 @@ getHaskellObjects _implInfo lib lbi clbi pref wanted_obj_ext allow_split_objs
 -- and is a hack to avoid passing bogus `-package` arguments to GHC. The assumption being that
 -- in 99% of cases we will include the right `-package` so that the C file finds the right headers.
 mkGhcOptPackages
-  :: Map (PackageName, ComponentName) ComponentId
+  :: Map (PackageName, ComponentName) PromisedComponent
   -> ComponentLocalBuildInfo
   -> [(OpenUnitId, ModuleRenaming)]
 mkGhcOptPackages promisedPkgsMap clbi =
   [ i | i@(uid, _) <- componentIncludes clbi, abstractUnitId uid `Set.notMember` promised_cids
   ]
   where
     -- Promised deps are going to be simple UnitIds
-    promised_cids = Set.fromList (map newSimpleUnitId (Map.elems promisedPkgsMap))
+    promised_cids = Set.fromList (map (newSimpleUnitId . promisedComponentId) (Map.elems promisedPkgsMap))
 
 substTopDir :: FilePath -> IPI.InstalledPackageInfo -> IPI.InstalledPackageInfo
 substTopDir topDir ipo =

Cabal/src/Distribution/Simple/Setup/Config.hs

@@ -185,7 +185,7 @@ data ConfigFlags = ConfigFlags
   --  dependencies.
   , configDependencies :: [GivenComponent]
   -- ^ The packages depended on which already exist
-  , configPromisedDependencies :: [GivenComponent]
+  , configPromisedDependencies :: [PromisedComponent]
   -- ^ The packages depended on which doesn't yet exist (i.e. promised).
   --  Promising dependencies enables us to configure components in parallel,
   --  and avoids expensive builds if they are not necessary.
@@ -779,13 +779,13 @@ configureOptions showOrParseArgs =
        , option
           ""
           ["promised-dependency"]
-          "A list of promised dependencies. E.g., --promised-dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\""
+          "A list of promised dependencies. E.g., --promised-dependency=\"void,0.1.1=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\""
           configPromisedDependencies
           (\v flags -> flags{configPromisedDependencies = v})
           ( reqArg
-              "NAME[:COMPONENT_NAME]=CID"
-              (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecGivenComponent))
-              (map prettyGivenComponent)
+              "NAME-VER[:COMPONENT_NAME]=CID"
+              (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecPromisedComponent))
+              (map prettyPromisedComponent)
           )
        , option
           ""
@@ -923,6 +923,29 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String]
 showProfDetailLevelFlag NoFlag = []
 showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl]
 
+parsecPromisedComponent :: ParsecParser PromisedComponent
+parsecPromisedComponent = do
+  pn <- parsec
+  ln <- P.option LMainLibName $ do
+    _ <- P.char ':'
+    ucn <- parsec
+    return $
+      if unUnqualComponentName ucn == unPackageName (pkgName pn)
+        then LMainLibName
+        else LSubLibName ucn
+  _ <- P.char '='
+  cid <- parsec
+  return $ PromisedComponent pn ln cid
+
+prettyPromisedComponent :: PromisedComponent -> String
+prettyPromisedComponent (PromisedComponent pn cn cid) =
+  prettyShow pn
+    ++ case cn of
+      LMainLibName -> ""
+      LSubLibName n -> ":" ++ prettyShow n
+    ++ "="
+    ++ prettyShow cid
+
 parsecGivenComponent :: ParsecParser GivenComponent
 parsecGivenComponent = do
   pn <- parsec

Cabal/src/Distribution/Types/GivenComponent.hs

@@ -3,12 +3,14 @@
 
 module Distribution.Types.GivenComponent
   ( GivenComponent (..)
+  , PromisedComponent (..)
   ) where
 
 import Distribution.Compat.Prelude
 
 import Distribution.Types.ComponentId
 import Distribution.Types.LibraryName
+import Distribution.Types.PackageId
 import Distribution.Types.PackageName
 
 -- | A 'GivenComponent' represents a library depended on and explicitly
@@ -27,3 +29,20 @@ data GivenComponent = GivenComponent
 
 instance Binary GivenComponent
 instance Structured GivenComponent
+
+-- | A 'PromisedComponent' represents a promised library depended on and explicitly
+-- specified by the user/client with @--promised-dependency@
+--
+-- It enables Cabal to know which 'ComponentId' to associate with a library
+--
+-- @since 3.14.0.0
+data PromisedComponent = PromisedComponent
+  { promisedComponentPackage :: PackageId
+  , promisedComponentName :: LibraryName -- --dependency is for libraries
+  -- only, not for any component
+  , promisedComponentId :: ComponentId
+  }
+  deriving (Generic, Read, Show, Eq, Typeable)
+
+instance Binary PromisedComponent
+instance Structured PromisedComponent

Cabal/src/Distribution/Types/LocalBuildConfig.hs

@@ -22,9 +22,9 @@ module Distribution.Types.LocalBuildConfig
 import Distribution.Compat.Prelude
 import Prelude ()
 
-import Distribution.Types.ComponentId
 import Distribution.Types.ComponentLocalBuildInfo
 import Distribution.Types.ComponentRequestedSpec
+import Distribution.Types.GivenComponent
 import Distribution.Types.PackageDescription
 import Distribution.Types.UnitId
 
@@ -101,7 +101,7 @@ data ComponentBuildDescr = ComponentBuildDescr
   -- ^ A map from component name to all matching
   -- components.  These coincide with 'componentGraph'
   -- There may be more than one matching component because of backpack instantiations
-  , promisedPkgs :: Map (PackageName, ComponentName) ComponentId
+  , promisedPkgs :: Map (PackageName, ComponentName) PromisedComponent
   -- ^ The packages we were promised, but aren't already installed.
   -- MP: Perhaps this just needs to be a Set UnitId at this stage.
   , installedPkgs :: InstalledPackageIndex

Cabal/src/Distribution/Types/LocalBuildInfo.hs

@@ -103,6 +103,7 @@ import Prelude ()
 import Distribution.Types.ComponentId
 import Distribution.Types.ComponentLocalBuildInfo
 import Distribution.Types.ComponentRequestedSpec
+import Distribution.Types.GivenComponent
 import qualified Distribution.Types.LocalBuildConfig as LBC
 import Distribution.Types.PackageDescription
 import Distribution.Types.PackageId
@@ -160,7 +161,7 @@ pattern LocalBuildInfo
   -> Maybe (SymbolicPath Pkg File)
   -> Graph ComponentLocalBuildInfo
   -> Map ComponentName [ComponentLocalBuildInfo]
-  -> Map (PackageName, ComponentName) ComponentId
+  -> Map (PackageName, ComponentName) PromisedComponent
   -> InstalledPackageIndex
   -> PackageDescription
   -> ProgramDb

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -4017,7 +4017,7 @@ setupHsConfigureFlags
         ]
 
       configPromisedDependencies =
-        [ cidToGivenComponent cid
+        [ cidToPromisedComponent cid
         | (cid, is_internal) <- elabLibDependencies elab
         , is_internal
         ]
@@ -4058,6 +4058,15 @@ setupHsConfigureFlags
             Just _ -> error "non-library dependency"
             Nothing -> LMainLibName
 
+      cidToPromisedComponent :: ConfiguredId -> PromisedComponent
+      cidToPromisedComponent (ConfiguredId srcid mb_cn cid) =
+        PromisedComponent srcid ln cid
+        where
+          ln = case mb_cn of
+            Just (CLibName lname) -> lname
+            Just _ -> error "non-library dependency"
+            Nothing -> LMainLibName
+
       configCoverageFor = determineCoverageFor elabPkgSourceId plan
 
 setupHsConfigureArgs