Commit d7bd9078 authored by Edward Z. Yang's avatar Edward Z. Yang

Introduce the new representation of UnitId

'SimpleUnitId' constructor renamed to 'UnitId', and augmented
with a new field 'Maybe String' recording a hash that uniquely
identifies an instantiated unit of the library 'ComponentId'.
'UnitId' can't be used to represent partially instantiated
unit identifiers; see Distribution.Backpack for how we handle that.

Previous uses of 'SimpleUnitId' should now use 'newSimpleUnitId'.
'unitIdComponentId' folded into a record selector for 'ComponentId'.
parent cbc1a1de
......@@ -104,8 +104,7 @@ data InstalledPackageInfo
deriving (Eq, Generic, Read, Show)
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi = case installedUnitId ipi of
SimpleUnitId cid -> cid
installedComponentId ipi = unitIdComponentId (installedUnitId ipi)
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Backwards compatibility with Cabal pre-1.24.
......
......@@ -26,8 +26,8 @@ module Distribution.Package (
ComponentId, unComponentId, mkComponentId,
UnitId(..),
mkUnitId,
newSimpleUnitId,
mkLegacyUnitId,
unitIdComponentId,
getHSLibraryName,
InstalledPackageId, -- backwards compat
......@@ -163,8 +163,11 @@ instance NFData Module where
rnf (Module uid mod_name) = rnf uid `seq` rnf mod_name
-- | A 'ComponentId' uniquely identifies the transitive source
-- code closure of a component. For non-Backpack components, it also
-- serves as the basis for install paths, symbols, etc.
-- code closure of a component (i.e. libraries, executables).
--
-- For non-Backpack components, this corresponds one to one with
-- the 'UnitId', which serves as the basis for install paths,
-- linker symbols, etc.
--
-- Use 'mkComponentId' and 'unComponentId' to convert from/to a
-- 'String'.
......@@ -208,24 +211,79 @@ instance NFData ComponentId where
-- | Returns library name prefixed with HS, suitable for filenames
getHSLibraryName :: UnitId -> String
getHSLibraryName (SimpleUnitId cid) = "HS" ++ unComponentId cid
getHSLibraryName uid = "HS" ++ display uid
-- | For now, there is no distinction between component IDs
-- and unit IDs in Cabal.
newtype UnitId = SimpleUnitId ComponentId
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, Binary, Text, NFData)
-- | A unit identifier identifies a (possibly instantiated)
-- package/component that can be installed the installed package
-- database. There are several types of components that can be
-- installed:
--
-- * A traditional library with no holes, so that 'unitIdHash'
-- is @Nothing@. In the absence of Backpack, 'UnitId'
-- is the same as a 'ComponentId'.
--
-- * An indefinite, Backpack library with holes. In this case,
-- 'unitIdHash' is still @Nothing@, but in the install,
-- there are only interfaces, no compiled objects.
--
-- * An instantiated Backpack library with all the holes
-- filled in. 'unitIdHash' is a @Just@ a hash of the
-- instantiating mapping.
--
-- A unit is a component plus the additional information on how the
-- holes are filled in. Thus there is a one to many relationship: for a
-- particular component there are many different ways of filling in the
-- holes, and each different combination is a unit (and has a separate
-- 'UnitId').
--
-- 'UnitId' is distinct from 'IndefUnitId', in that it is always
-- installed, whereas 'IndefUnitId' are intermediate unit identities
-- that arise during mixin linking, and don't necessarily correspond
-- to any actually installed unit. Since the mapping is not actually
-- recorded in a 'UnitId', you can't actually substitute over them
-- (but you can substitute over 'IndefUnitId'). See also
-- "Distribution.Backpack.FullUnitId" for a mechanism for expanding an
-- instantiated 'UnitId' to retrieve its mapping.
--
data UnitId
= UnitId {
unitIdComponentId :: ComponentId,
unitIdHash :: Maybe String
}
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
instance Binary UnitId
instance NFData UnitId where
rnf (UnitId cid str) = rnf cid `seq` rnf str
instance Text UnitId where
disp (UnitId cid Nothing) = disp cid
disp (UnitId cid (Just hash)) = disp cid <<>> text "+" <<>> text hash
parse = parseUnitId <++ parseSimpleUnitId
where
parseUnitId = do cid <- parse
_ <- Parse.char '+'
hash <- Parse.munch1 isAlphaNum
return (UnitId cid (Just hash))
parseSimpleUnitId = fmap newSimpleUnitId parse
-- | Create a unit identity with no associated hash directly
-- from a 'ComponentId'.
newSimpleUnitId :: ComponentId -> UnitId
newSimpleUnitId cid =
UnitId {
unitIdComponentId = cid,
unitIdHash = Nothing
}
-- | Makes a simple-style UnitId from a string.
mkUnitId :: String -> UnitId
mkUnitId = SimpleUnitId . mkComponentId
mkUnitId = newSimpleUnitId . mkComponentId
-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
mkLegacyUnitId = mkUnitId . display
-- | Extract 'ComponentId' from 'UnitId'.
unitIdComponentId :: UnitId -> ComponentId
unitIdComponentId (SimpleUnitId cid) = cid
mkLegacyUnitId = newSimpleUnitId . mkComponentId . display
-- ------------------------------------------------------------
-- * Package source dependencies
......
......@@ -1781,7 +1781,7 @@ computeCompatPackageKey
-> Version
-> UnitId
-> String
computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId cid)
computeCompatPackageKey comp pkg_name pkg_version (UnitId cid _)
| not (packageKeySupported comp) =
display pkg_name ++ "-" ++ display pkg_version
| not (unifiedIPIDRequired comp) =
......@@ -1901,7 +1901,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages
(componentName component)
(getDeps (componentName component))
flagAssignment
uid = SimpleUnitId cid
uid = newSimpleUnitId cid
PackageIdentifier pkg_name pkg_ver = package pkg_descr
compat_name = computeCompatPackageName pkg_name (componentName component)
compat_key = computeCompatPackageKey comp compat_name pkg_ver uid
......
......@@ -394,7 +394,8 @@ lookupUnitId index uid = Map.lookup uid (unitIdIndex index)
--
lookupComponentId :: PackageIndex a -> ComponentId
-> Maybe a
lookupComponentId index uid = Map.lookup (SimpleUnitId uid) (unitIdIndex index)
lookupComponentId index cid =
Map.lookup (newSimpleUnitId cid) (unitIdIndex index)
-- | Backwards compatibility for Cabal pre-1.24.
{-# DEPRECATED lookupInstalledPackageId "Use lookupUnitId instead" #-}
......
......@@ -315,7 +315,7 @@ mungePackagePaths pkgroot pkginfo =
-- field, so if it is missing then we fill it as the source package ID.
setUnitId :: InstalledPackageInfo -> InstalledPackageInfo
setUnitId pkginfo@InstalledPackageInfo {
installedUnitId = SimpleUnitId cid,
installedUnitId = UnitId cid _,
sourcePackageId = pkgid
} | cid == mkComponentId ""
= pkginfo {
......
......@@ -93,5 +93,4 @@ instance IsNode ComponentLocalBuildInfo where
nodeNeighbors = componentInternalDeps
componentComponentId :: ComponentLocalBuildInfo -> ComponentId
componentComponentId clbi = case componentUnitId clbi of
SimpleUnitId cid -> cid
componentComponentId clbi = unitIdComponentId (componentUnitId clbi)
......@@ -162,9 +162,7 @@ instance Binary LocalBuildInfo
-- 'LocalBuildInfo' if it exists, or make a fake component ID based
-- on the package ID.
localComponentId :: LocalBuildInfo -> ComponentId
localComponentId lbi
= case localUnitId lbi of
SimpleUnitId cid -> cid
localComponentId lbi = unitIdComponentId (localUnitId lbi)
-- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'.
-- This is a "safe" use of 'localPkgDescr'
......
......@@ -127,8 +127,9 @@ defaultDistDirLayout projectRootDirectory =
NoOptimisation -> "noopt"
NormalOptimisation -> ""
MaximumOptimisation -> "opt") </>
(case distParamUnitId params of -- For Backpack
SimpleUnitId _ -> "")
(case distParamUnitId params of
UnitId _ (Just hash) -> hash
UnitId _ Nothing -> "")
distUnpackedSrcRootDirectory = distDirectory </> "src"
distUnpackedSrcDirectory pkgid = distUnpackedSrcRootDirectory
......
......@@ -674,7 +674,7 @@ getInstalledStorePackages :: FilePath -- ^ store directory
-> Rebuild (Set UnitId)
getInstalledStorePackages storeDirectory = do
paths <- getDirectoryContentsMonitored storeDirectory
return $ Set.fromList [ SimpleUnitId (mkComponentId path)
return $ Set.fromList [ newSimpleUnitId (mkComponentId path)
| path <- paths, valid path ]
where
valid ('.':_) = False
......@@ -1099,7 +1099,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
((internal_map', exe_map'), elab)
where
elab = elab0 {
elabUnitId = SimpleUnitId cid, -- Backpack later!
elabUnitId = newSimpleUnitId cid, -- Backpack later!
elabInstallDirs = install_dirs,
elabRequiresRegistration = requires_reg,
elabPkgOrComp = ElabComponent $ ElaboratedComponent {..}
......@@ -1193,7 +1193,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
-- use the ordinary default install dirs
= (InstallDirs.absoluteInstallDirs
elabPkgSourceId
(SimpleUnitId cid)
(newSimpleUnitId cid)
(compilerInfo compiler)
InstallDirs.NoCopyDest
platform
......@@ -1272,7 +1272,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
where
elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep pkg
elab = elab0 {
elabUnitId = SimpleUnitId pkgInstalledId,
elabUnitId = newSimpleUnitId pkgInstalledId,
elabInstallDirs = install_dirs,
elabRequiresRegistration = requires_reg,
elabPkgOrComp = ElabPackage $ ElaboratedPackage {..}
......@@ -1316,7 +1316,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
-- use the ordinary default install dirs
= (InstallDirs.absoluteInstallDirs
pkgid
(SimpleUnitId pkgInstalledId)
(newSimpleUnitId pkgInstalledId)
(compilerInfo compiler)
InstallDirs.NoCopyDest
platform
......@@ -1967,13 +1967,13 @@ pruneInstallPlanPass2 pkgs =
hasReverseLibDeps :: Set UnitId
hasReverseLibDeps =
Set.fromList [ SimpleUnitId (confInstId depid)
Set.fromList [ newSimpleUnitId (confInstId depid)
| InstallPlan.Configured pkg <- pkgs
, depid <- elabLibDependencies pkg ]
hasReverseExeDeps :: Set UnitId
hasReverseExeDeps =
Set.fromList [ SimpleUnitId depid
Set.fromList [ newSimpleUnitId depid
| InstallPlan.Configured pkg <- pkgs
, depid <- elabExeDependencies pkg ]
......
......@@ -359,9 +359,9 @@ instance Binary ElaboratedComponent
compOrderDependencies :: ElaboratedComponent -> [UnitId]
compOrderDependencies comp =
-- TODO: Change this with Backpack!
map (SimpleUnitId . confInstId) (compLibDependencies comp)
++ map SimpleUnitId (compExeDependencies comp)
++ map (SimpleUnitId . confInstId) (compSetupDependencies comp)
map (newSimpleUnitId . confInstId) (compLibDependencies comp)
++ map newSimpleUnitId (compExeDependencies comp)
++ map (newSimpleUnitId . confInstId) (compSetupDependencies comp)
data ElaboratedPackage
= ElaboratedPackage {
......@@ -396,8 +396,8 @@ instance Binary ElaboratedPackage
pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId]
pkgOrderDependencies pkg =
fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend`
fmap (map (SimpleUnitId . confInstId)) (pkgExeDependencies pkg)
fmap (map (newSimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend`
fmap (map (newSimpleUnitId . confInstId)) (pkgExeDependencies pkg)
-- | This is used in the install plan to indicate how the package will be
-- built.
......
......@@ -31,7 +31,7 @@ import Distribution.Version
, intersectVersionRanges, orLaterVersion
, withinRange )
import Distribution.Package
( UnitId(..), ComponentId, PackageId, mkPackageName
( newSimpleUnitId, ComponentId, PackageId, mkPackageName
, PackageIdentifier(..), packageVersion, packageName, Dependency(..) )
import Distribution.PackageDescription
( GenericPackageDescription(packageDescription)
......@@ -817,7 +817,7 @@ getExternalSetupMethod verbosity options pkg bt = do
if any (isCabalPkgId . snd) (useDependencies options')
then []
else cabalDep
addRenaming (ipid, _) = (SimpleUnitId ipid, defaultRenaming)
addRenaming (ipid, _) = (newSimpleUnitId ipid, defaultRenaming)
cppMacrosFile = setupDir </> "setup_macros.h"
ghcOptions = mempty {
-- Respect -v0, but don't crank up verbosity on GHC if
......
......@@ -22,8 +22,8 @@ module Distribution.Client.Types where
import Distribution.Package
( PackageName, PackageId, Package(..)
, UnitId(..), ComponentId, HasUnitId(..)
, PackageInstalled(..), unitIdComponentId )
, UnitId, ComponentId, HasUnitId(..)
, PackageInstalled(..), unitIdComponentId, newSimpleUnitId )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import Distribution.PackageDescription
......@@ -113,11 +113,11 @@ instance HasConfiguredId (ConfiguredPackage loc) where
-- 'ConfiguredPackage' is the legacy codepath, we are guaranteed
-- to never have a nontrivial 'UnitId'
instance PackageFixedDeps (ConfiguredPackage loc) where
depends = fmap (map (SimpleUnitId . confInstId)) . confPkgDeps
depends = fmap (map (newSimpleUnitId . confInstId)) . confPkgDeps
instance IsNode (ConfiguredPackage loc) where
type Key (ConfiguredPackage loc) = UnitId
nodeKey = SimpleUnitId . confPkgId
nodeKey = newSimpleUnitId . confPkgId
-- TODO: if we update ConfiguredPackage to support order-only
-- dependencies, need to include those here.
-- NB: have to deduplicate, otherwise the planner gets confused
......@@ -153,7 +153,7 @@ instance Package (ConfiguredPackage loc) where
-- Never has nontrivial UnitId
instance HasUnitId (ConfiguredPackage loc) where
installedUnitId = SimpleUnitId . confPkgId
installedUnitId = newSimpleUnitId . confPkgId
instance PackageInstalled (ConfiguredPackage loc) where
installedDepends = CD.flatDeps . depends
......
......@@ -19,6 +19,7 @@ module Distribution.Solver.Modular.Package
import Data.List as L
import Distribution.Package -- from Cabal
import Distribution.Text (display)
import Distribution.Solver.Modular.Version
import Distribution.Solver.Types.PackagePath
......@@ -57,10 +58,9 @@ showI (I v InRepo) = showVer v
showI (I v (Inst uid)) = showVer v ++ "/installed" ++ shortId uid
where
-- A hack to extract the beginning of the package ABI hash
shortId (SimpleUnitId cid)
= snip (splitAt 4) (++ "...")
shortId = snip (splitAt 4) (++ "...")
. snip ((\ (x, y) -> (reverse x, y)) . break (=='-') . reverse) ('-':)
$ unComponentId cid
. display
snip p f xs = case p xs of
(ys, zs) -> (if L.null zs then id else f) ys
......
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