Skip to content

Commit

Permalink
Include package version in --promised-dependency flag
Browse files Browse the repository at this point in the history
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 haskell#10166
  • Loading branch information
mpickering committed Aug 14, 2024
1 parent 30d2a38 commit 8fc8b9b
Show file tree
Hide file tree
Showing 19 changed files with 178 additions and 41 deletions.
4 changes: 2 additions & 2 deletions Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
8 changes: 4 additions & 4 deletions Cabal/src/Distribution/Backpack/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -70,7 +70,7 @@ configureComponentLocalBuildInfos
-> Flag String -- configIPID
-> Flag ComponentId -- configCID
-> PackageDescription
-> ([PreExistingComponent], [PromisedComponent])
-> ([PreExistingComponent], [ConfiguredPromisedComponent])
-> FlagAssignment -- configConfigurationsFlags
-> [(ModuleName, Module)] -- configInstantiateWith
-> InstalledPackageIndex
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -151,7 +151,7 @@ configureComponentLocalBuildInfos
, emptyModuleShape
)
)
| PromisedComponent _ aid <- promisedPkgDeps
| ConfiguredPromisedComponent _ aid <- promisedPkgDeps
]
uid_lookup def_uid
| Just pkg <- PackageIndex.lookupUnitId installedPackageSet uid =
Expand Down Expand Up @@ -208,7 +208,7 @@ configureComponentLocalBuildInfos
toComponentLocalBuildInfos
:: Compiler
-> InstalledPackageIndex -- FULL set
-> [PromisedComponent]
-> [ConfiguredPromisedComponent]
-> PackageDescription
-> [PreExistingComponent] -- external package deps
-> [ReadyComponent]
Expand Down
6 changes: 3 additions & 3 deletions Cabal/src/Distribution/Backpack/PreExistingComponent.hs
Original file line number Diff line number Diff line change
@@ -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

Expand All @@ -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
Expand Down
28 changes: 14 additions & 14 deletions Cabal/src/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
}
Expand Down Expand Up @@ -1113,7 +1113,7 @@ finalCheckPackage
-> LBC.PackageBuildDescr
-> HookedBuildInfo
-> PackageInfo
-> IO ([PreExistingComponent], [PromisedComponent])
-> IO ([PreExistingComponent], [ConfiguredPromisedComponent])
finalCheckPackage
g_pkg_descr
( LBC.PackageBuildDescr
Expand Down Expand Up @@ -1210,7 +1210,7 @@ configureComponents
:: LBC.LocalBuildConfig
-> LBC.PackageBuildDescr
-> PackageInfo
-> ([PreExistingComponent], [PromisedComponent])
-> ([PreExistingComponent], [ConfiguredPromisedComponent])
-> IO LocalBuildInfo
configureComponents
lbc@(LBC.LocalBuildConfig{withPrograms = programDb})
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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.
Expand All @@ -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.
Expand Down
6 changes: 3 additions & 3 deletions Cabal/src/Distribution/Simple/GHC/Internal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand Down
33 changes: 28 additions & 5 deletions Cabal/src/Distribution/Simple/Setup/Config.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down Expand Up @@ -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
""
Expand Down Expand Up @@ -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
Expand Down
19 changes: 19 additions & 0 deletions Cabal/src/Distribution/Types/GivenComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
4 changes: 2 additions & 2 deletions Cabal/src/Distribution/Types/LocalBuildConfig.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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
Expand Down
3 changes: 2 additions & 1 deletion Cabal/src/Distribution/Types/LocalBuildInfo.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
11 changes: 10 additions & 1 deletion cabal-install/src/Distribution/Client/ProjectPlanning.hs
Original file line number Diff line number Diff line change
Expand Up @@ -4017,7 +4017,7 @@ setupHsConfigureFlags
]

configPromisedDependencies =
[ cidToGivenComponent cid
[ cidToPromisedComponent cid
| (cid, is_internal) <- elabLibDependencies elab
, is_internal
]
Expand Down Expand Up @@ -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
Expand Down
Loading

0 comments on commit 8fc8b9b

Please sign in to comment.