Commit 579fd676 authored by Edward Z. Yang's avatar Edward Z. Yang

Refactor UnitId to be an abstract newtype around String.

The primary consequence is that we can't assume that we
have a ComponentId when we have a UnitId in hand.  Most
of the time, this just means we have to pass around
ComponentId explicitly.  No problem.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 55de3961
......@@ -13,7 +13,6 @@
module Distribution.Backpack (
-- * OpenUnitId
OpenUnitId(..),
openUnitIdComponentId,
openUnitIdFreeHoles,
mkOpenUnitId,
......@@ -117,11 +116,6 @@ instance Text OpenUnitId where
parseOpenModuleSubst
return (IndefFullUnitId cid insts)
-- | Get the 'ComponentId' of an 'OpenUnitId'.
openUnitIdComponentId :: OpenUnitId -> ComponentId
openUnitIdComponentId (IndefFullUnitId cid _) = cid
openUnitIdComponentId (DefiniteUnitId def_uid) = unitIdComponentId (unDefUnitId def_uid)
-- | Get the set of holes ('ModuleVar') embedded in a 'UnitId'.
openUnitIdFreeHoles :: OpenUnitId -> Set ModuleName
openUnitIdFreeHoles (IndefFullUnitId _ insts) = openModuleSubstFreeHoles insts
......@@ -129,11 +123,11 @@ openUnitIdFreeHoles _ = Set.empty
-- | Safe constructor from a UnitId. The only way to do this safely
-- is if the instantiation is provided.
mkOpenUnitId :: UnitId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId uid insts =
mkOpenUnitId :: UnitId -> ComponentId -> OpenModuleSubst -> OpenUnitId
mkOpenUnitId uid cid insts =
if Set.null (openModuleSubstFreeHoles insts)
then DefiniteUnitId (unsafeMkDefUnitId uid) -- invariant holds!
else IndefFullUnitId (unitIdComponentId uid) insts
else IndefFullUnitId cid insts
-----------------------------------------------------------------------
-- DefUnitId
......@@ -142,7 +136,9 @@ mkOpenUnitId uid insts =
-- with no holes.
mkDefUnitId :: ComponentId -> Map ModuleName Module -> DefUnitId
mkDefUnitId cid insts =
unsafeMkDefUnitId (UnitId cid (hashModuleSubst insts)) -- impose invariant!
unsafeMkDefUnitId (mkUnitId
(unComponentId cid ++ maybe "" ("+"++) (hashModuleSubst insts)))
-- impose invariant!
-----------------------------------------------------------------------
-- OpenModule
......
......@@ -107,14 +107,12 @@ configureComponentLocalBuildInfos
(vcat (map dispLinkedComponent graph2))
let pid_map = Map.fromList $
[ (pc_cid pkg, pc_pkgid pkg)
[ (pc_uid pkg, pc_pkgid pkg)
| pkg <- prePkgDeps] ++
[ (Installed.installedComponentId pkg, Installed.sourcePackageId pkg)
[ (Installed.installedUnitId pkg, Installed.sourcePackageId pkg)
| (_, Module uid _) <- instantiate_with
, Just pkg <- [PackageIndex.lookupUnitId
installedPackageSet (unDefUnitId uid)] ] ++
[ (lc_cid lc, lc_pkgid lc)
| lc <- graph2 ]
installedPackageSet (unDefUnitId uid)] ]
subst = Map.fromList instantiate_with
graph3 = toReadyComponents pid_map subst graph2
graph4 = Graph.revTopSort (Graph.fromList graph3)
......@@ -251,10 +249,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
= Installed.ExposedModule modname'
(Just (OpenModule (DefiniteUnitId uid) modname))
convOpenModuleExport (modname', modu@(OpenModule uid modname))
-- TODO: This isn't a good enough test if we have mutual
-- recursion (but maybe we'll get saved by the module name
-- check regardless.)
| openUnitIdComponentId uid == this_cid
| uid == this_open_uid
, modname' == modname
= Installed.ExposedModule modname' Nothing
| otherwise
......@@ -276,6 +271,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
in LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentUnitId = this_uid,
componentComponentId = this_cid,
componentInstantiatedWith = insts,
componentIsIndefinite_ = is_indefinite,
componentLocalName = cname,
......@@ -290,6 +286,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CExe _ ->
ExeComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -299,6 +296,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CTest _ ->
TestComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -308,6 +306,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
CBench _ ->
BenchComponentLocalBuildInfo {
componentUnitId = this_uid,
componentComponentId = this_cid,
componentLocalName = cname,
componentPackageDeps = cpds,
componentExeDeps = map unDefUnitId $ rc_internal_build_tools rc,
......@@ -315,8 +314,9 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
componentIncludes = includes
}
where
this_uid = rc_uid rc
this_cid = unitIdComponentId this_uid
this_uid = rc_uid rc
this_open_uid = rc_open_uid rc
this_cid = rc_cid rc
cname = componentName (rc_component rc)
cpds = rc_depends rc
is_indefinite =
......
......@@ -94,23 +94,16 @@ computeComponentId mb_ipid mb_cid pid cname mb_details =
-- When we have the public library, the compat-pkg-name is just the
-- package-name, no surprises there!
--
computeCompatPackageName :: PackageName -> ComponentName -> Maybe UnitId -> PackageName
computeCompatPackageName :: PackageName -> ComponentName -> PackageName
-- First handle the cases where we can just use the original 'PackageName'.
-- This is for the PRIMARY library, and it is non-Backpack, or the
-- indefinite package for us.
computeCompatPackageName pkg_name CLibName Nothing = pkg_name
computeCompatPackageName pkg_name CLibName (Just (UnitId _ Nothing))
= pkg_name
-- OK, we have to z-encode
computeCompatPackageName pkg_name cname mb_uid
computeCompatPackageName pkg_name CLibName = pkg_name
computeCompatPackageName pkg_name cname
= mkPackageName $ "z-" ++ zdashcode (display pkg_name)
++ (case componentNameString cname of
Just cname_str -> "-z-" ++ zdashcode cname_str
Nothing -> "")
++ (case mb_uid of
Just (UnitId _ (Just hash))
-> "-z-" ++ hash
_ -> "")
zdashcode :: String -> String
zdashcode s = go s (Nothing :: Maybe Int) []
......@@ -173,11 +166,11 @@ computeCompatPackageKey
-> Version
-> UnitId
-> String
computeCompatPackageKey comp pkg_name pkg_version (UnitId cid Nothing)
computeCompatPackageKey comp pkg_name pkg_version uid
| not (packageKeySupported comp) =
display pkg_name ++ "-" ++ display pkg_version
| not (unifiedIPIDRequired comp) =
let str = unComponentId cid
let str = unUnitId uid -- assume no Backpack support
mb_verbatim_key
= case simpleParse str :: Maybe PackageId of
-- Something like 'foo-0.1', use it verbatim.
......@@ -192,6 +185,4 @@ computeCompatPackageKey comp pkg_name pkg_version (UnitId cid Nothing)
else Nothing
rehashed_key = hashToBase62 str
in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key)
| otherwise = unComponentId cid
computeCompatPackageKey _comp _pkg_name _pkg_version uid@UnitId{}
= display uid
| otherwise = display uid
......@@ -3,7 +3,6 @@
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.LinkedComponent (
LinkedComponent(..),
lc_cid,
toLinkedComponent,
toLinkedComponents,
dispLinkedComponent,
......@@ -47,6 +46,7 @@ import Text.PrettyPrint
data LinkedComponent
= LinkedComponent {
lc_uid :: OpenUnitId,
lc_cid :: ComponentId,
lc_pkgid :: PackageId,
lc_insts :: [(ModuleName, OpenModule)],
lc_component :: Component,
......@@ -60,9 +60,6 @@ data LinkedComponent
lc_depends :: [(OpenUnitId, PackageId)]
}
lc_cid :: LinkedComponent -> ComponentId
lc_cid = openUnitIdComponentId . lc_uid
dispLinkedComponent :: LinkedComponent -> Doc
dispLinkedComponent lc =
hang (text "unit" <+> disp (lc_uid lc)) 4 $
......@@ -238,6 +235,7 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
return $ LinkedComponent {
lc_uid = this_uid,
lc_cid = this_cid,
lc_insts = insts,
lc_pkgid = pkgid,
lc_component = component,
......
-- | See <https://github.com/ezyang/ghc-proposals/blob/backpack/proposals/0000-backpack.rst>
module Distribution.Backpack.PreExistingComponent (
PreExistingComponent(..),
pc_cid,
ipiToPreExistingComponent,
) where
......@@ -27,14 +26,11 @@ data PreExistingComponent
pc_pkgname :: PackageName,
pc_pkgid :: PackageId,
pc_uid :: UnitId,
pc_cid :: ComponentId,
pc_open_uid :: OpenUnitId,
pc_shape :: ModuleShape
}
-- | The 'ComponentId' of a 'PreExistingComponent'.
pc_cid :: PreExistingComponent -> ComponentId
pc_cid pc = unitIdComponentId (pc_uid pc)
-- | Convert an 'InstalledPackageInfo' into a 'PreExistingComponent',
-- which was brought into scope under the 'PackageName' (important for
-- a package qualified reference.)
......@@ -44,6 +40,7 @@ ipiToPreExistingComponent (pn, ipi) =
pc_pkgname = pn,
pc_pkgid = Installed.sourcePackageId ipi,
pc_uid = Installed.installedUnitId ipi,
pc_cid = Installed.installedComponentId ipi,
pc_open_uid =
IndefFullUnitId (Installed.installedComponentId ipi)
(Map.fromList (Installed.instantiatedWith ipi)),
......
......@@ -35,6 +35,7 @@ import Control.Monad
import Text.PrettyPrint
import qualified Data.Map as Map
import Distribution.Version
import Distribution.Text
-- | An instantiated component is simply a linked component which
......@@ -62,6 +63,8 @@ data IndefiniteComponent
data ReadyComponent
= ReadyComponent {
rc_uid :: UnitId,
rc_open_uid :: OpenUnitId,
rc_cid :: ComponentId,
rc_pkgid :: PackageId,
rc_component :: Component,
-- build-tools don't participate in mix-in linking.
......@@ -85,18 +88,19 @@ instance IsNode ReadyComponent where
nodeKey = rc_uid
nodeNeighbors rc =
(case rc_i rc of
Right _ | UnitId cid (Just _)
<- rc_uid rc -> [newSimpleUnitId cid]
Right inst | [] <- instc_insts inst
-> []
| otherwise
-> [newSimpleUnitId (rc_cid rc)]
_ -> []) ++
ordNub (map fst (rc_depends rc))
rc_compat_name :: ReadyComponent -> PackageName
rc_compat_name ReadyComponent{
rc_pkgid = PackageIdentifier pkg_name _,
rc_component = component,
rc_uid = uid
rc_component = component
}
= computeCompatPackageName pkg_name (componentName component) (Just uid)
= computeCompatPackageName pkg_name (componentName component)
rc_compat_key :: ReadyComponent -> Compiler -> String
rc_compat_key rc@ReadyComponent {
......@@ -158,7 +162,7 @@ instance Monad InstM where
-- instantiated components are given 'HashedUnitId'.
--
toReadyComponents
:: Map ComponentId PackageId
:: Map UnitId PackageId
-> Map ModuleName Module -- subst for the public component
-> [LinkedComponent]
-> [ReadyComponent]
......@@ -198,12 +202,19 @@ toReadyComponents pid_map subst0 comps
x' <- substUnitId insts x
return (x', y)
build_tools <- mapM (substUnitId insts) (lc_internal_build_tools lc)
s <- InstM $ \s -> (s, s)
let getDep (Module dep_def_uid _)
| let dep_uid = unDefUnitId dep_def_uid
, Just pid <- Map.lookup (unitIdComponentId dep_uid) pid_map
-- Lose DefUnitId invariant for rc_depends
= [(dep_uid, pid)]
getDep _ = []
= [(dep_uid,
fromMaybe err_pid $
Map.lookup dep_uid pid_map A.<|>
fmap rc_pkgid (join (Map.lookup dep_uid s)))]
where
err_pid =
PackageIdentifier
(mkPackageName "nonexistent-package-this-is-a-cabal-bug")
(mkVersion [0])
instc = InstantiatedComponent {
instc_insts = Map.toList insts,
instc_provides = provides,
......@@ -211,6 +222,8 @@ toReadyComponents pid_map subst0 comps
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_open_uid = DefiniteUnitId (unsafeMkDefUnitId uid),
rc_cid = lc_cid lc,
rc_pkgid = lc_pkgid lc,
rc_component = lc_component lc,
rc_internal_build_tools = build_tools,
......@@ -263,7 +276,9 @@ toReadyComponents pid_map subst0 comps
indefc_includes = lc_includes lc
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_uid = uid,
rc_open_uid = lc_uid lc,
rc_cid = lc_cid lc,
rc_pkgid = lc_pkgid lc,
rc_component = lc_component lc,
rc_internal_build_tools = build_tools,
......
......@@ -29,8 +29,8 @@
module Distribution.InstalledPackageInfo (
InstalledPackageInfo(..),
installedComponentId,
installedPackageId,
installedComponentId,
requiredSignatures,
installedOpenUnitId,
ExposedModule(..),
......@@ -72,6 +72,7 @@ data InstalledPackageInfo
-- these parts are exactly the same as PackageDescription
sourcePackageId :: PackageId,
installedUnitId :: UnitId,
installedComponentId_ :: ComponentId,
-- INVARIANT: if this package is definite, OpenModule's
-- OpenUnitId directly records UnitId. If it is
-- indefinite, OpenModule is always an OpenModuleVar
......@@ -118,6 +119,12 @@ data InstalledPackageInfo
}
deriving (Eq, Generic, Read, Show)
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi =
case unComponentId (installedComponentId_ ipi) of
"" -> mkComponentId (unUnitId (installedUnitId ipi))
_ -> installedComponentId_ ipi
-- | Get the indefinite unit identity representing this package.
-- This IS NOT guaranteed to give you a substitution; for
-- instantiated packages you will get @DefiniteUnitId (installedUnitId ipi)@.
......@@ -125,16 +132,13 @@ data InstalledPackageInfo
-- an @OpenUnitId@ with the appropriate 'OpenModuleSubst'.
installedOpenUnitId :: InstalledPackageInfo -> OpenUnitId
installedOpenUnitId ipi
= mkOpenUnitId (installedUnitId ipi) (Map.fromList (instantiatedWith ipi))
= mkOpenUnitId (installedUnitId ipi) (installedComponentId ipi) (Map.fromList (instantiatedWith ipi))
-- | Returns the set of module names which need to be filled for
-- an indefinite package, or the empty set if the package is definite.
requiredSignatures :: InstalledPackageInfo -> Set ModuleName
requiredSignatures ipi = openModuleSubstFreeHoles (Map.fromList (instantiatedWith ipi))
installedComponentId :: InstalledPackageInfo -> ComponentId
installedComponentId ipi = unitIdComponentId (installedUnitId ipi)
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Backwards compatibility with Cabal pre-1.24.
-- This type synonym is slightly awful because in cabal-install
......@@ -164,6 +168,7 @@ emptyInstalledPackageInfo
= InstalledPackageInfo {
sourcePackageId = PackageIdentifier (mkPackageName "") nullVersion,
installedUnitId = mkUnitId "",
installedComponentId_ = mkComponentId "",
instantiatedWith = [],
compatPackageKey = "",
license = UnspecifiedLicense,
......
......@@ -24,11 +24,10 @@ module Distribution.Package (
-- * Package keys/installed package IDs (used for linker symbols)
ComponentId, unComponentId, mkComponentId,
UnitId(..),
UnitId, unUnitId, mkUnitId,
DefUnitId,
unsafeMkDefUnitId,
unDefUnitId,
mkUnitId,
newSimpleUnitId,
mkLegacyUnitId,
getHSLibraryName,
......@@ -248,28 +247,20 @@ getHSLibraryName uid = "HS" ++ display uid
-- "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)
newtype UnitId = UnitId String
deriving (Generic, Read, Show, Eq, Ord, Typeable, Data, NFData)
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
disp (UnitId str) = text str
parse = UnitId `fmap` Parse.munch1 (\c -> isAlphaNum c || c `elem` "-_.+")
unUnitId :: UnitId -> String
unUnitId (UnitId str) = str
mkUnitId :: String -> UnitId
mkUnitId str = UnitId str
-- | A 'UnitId' for a definite package. The 'DefUnitId' invariant says
-- that a 'UnitId' identified this way is definite; i.e., it has no
......@@ -285,15 +276,7 @@ unsafeMkDefUnitId = DefUnitId
-- | 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 = newSimpleUnitId . mkComponentId
newSimpleUnitId cid = UnitId (unComponentId cid)
-- | Make an old-style UnitId from a package identifier
mkLegacyUnitId :: PackageId -> UnitId
......
......@@ -424,7 +424,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- This is, like, the one place where we use a CTestName for a library.
-- Should NOT use library name, since that could conflict!
PackageIdentifier pkg_name pkg_ver = package pkg_descr
compat_name = computeCompatPackageName pkg_name (CTestName (testName test)) (Just (componentUnitId clbi))
compat_name = computeCompatPackageName pkg_name (CTestName (testName test))
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
......@@ -435,6 +435,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
, componentIsPublic = False
, componentIncludes = componentIncludes clbi
, componentUnitId = componentUnitId clbi
, componentComponentId = componentComponentId clbi
, componentInstantiatedWith = []
, componentCompatPackageName = compat_name
, componentCompatPackageKey = compat_key
......@@ -470,6 +471,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- TODO: this is a hack, but as long as this is unique
-- (doesn't clobber something) we won't run into trouble
componentUnitId = mkUnitId (stubName test),
componentComponentId = mkComponentId (stubName test),
componentInternalDeps = [componentUnitId clbi],
componentExeDeps = [],
componentLocalName = CExeName (stubName test),
......@@ -497,6 +499,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
}
exeClbi = ExeComponentLocalBuildInfo {
componentUnitId = componentUnitId clbi,
componentComponentId = componentComponentId clbi,
componentLocalName = CExeName (benchmarkName bm),
componentInternalDeps = componentInternalDeps clbi,
componentExeDeps = componentExeDeps clbi,
......
......@@ -1182,15 +1182,14 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
[] -> Left $
case is_internal of
Just cname -> DependencyMissingInternal dep_pkgname
(computeCompatPackageName
(packageName pkgid) cname Nothing)
(computeCompatPackageName (packageName pkgid) cname)
Nothing -> DependencyNotExists dep_pkgname
pkgs -> Right $ ExternalDependency dep $
case last pkgs of
(_ver, pkginstances) -> head pkginstances
where
dep' | Just cname <- is_internal
= Dependency (computeCompatPackageName (packageName pkgid) cname Nothing) vr
= Dependency (computeCompatPackageName (packageName pkgid) cname) vr
| otherwise = dep
-- NB: here computeCompatPackageName we want to pick up the INDEFINITE ones
-- which is why we pass 'Nothing' as 'UnitId'
......
......@@ -737,11 +737,10 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo { componentUnitId = lib_uid
, componentInstantiatedWith = insts } ->
LibComponentLocalBuildInfo { componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (unitIdComponentId lib_uid)
else toFlag (componentComponentId clbi)
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
......
......@@ -19,6 +19,7 @@ import Distribution.Compat.Prelude
import qualified Distribution.InstalledPackageInfo as Current
import qualified Distribution.Package as Current hiding (installedUnitId)
import Distribution.Simple.GHC.IPIConvert
import Distribution.Text
-- | This is the InstalledPackageInfo type used by ghc-6.4.2 and later.
--
......@@ -69,6 +70,7 @@ toCurrent ipi@InstalledPackageInfo{} =
in Current.InstalledPackageInfo {
Current.sourcePackageId = pid,
Current.installedUnitId = Current.mkLegacyUnitId pid,
Current.installedComponentId_ = Current.mkComponentId (display pid),
Current.instantiatedWith = [],
Current.compatPackageKey = "",
Current.abiHash = Current.mkAbiHash "", -- bogus but old GHCs don't care.
......
......@@ -290,11 +290,11 @@ componentGhcOptions verbosity lbi bi clbi odir =
-> toFlag pk
_ -> mempty,
ghcOptThisComponentId = case clbi of
LibComponentLocalBuildInfo { componentUnitId = uid
LibComponentLocalBuildInfo { componentComponentId = cid
, componentInstantiatedWith = insts } ->
if null insts
then mempty
else toFlag (unitIdComponentId uid)
else toFlag cid
_ -> mempty,
ghcOptInstantiatedWith = case clbi of
LibComponentLocalBuildInfo { componentInstantiatedWith = insts }
......
......@@ -33,7 +33,6 @@ module Distribution.Simple.LocalBuildInfo (
showComponentName,
componentNameString,
ComponentLocalBuildInfo(..),
componentComponentId,
componentBuildDir,
foldComponent,
componentName,
......@@ -106,12 +105,14 @@ componentBuildDir :: LocalBuildInfo -> ComponentLocalBuildInfo -> FilePath
componentBuildDir lbi clbi
= buildDir lbi </>
case componentLocalName clbi of
CLibName -> case unitIdHash (componentUnitId clbi) of
Just hash -> hash
Nothing -> ""
CSubLibName s -> case unitIdHash (componentUnitId clbi) of
Just hash -> s ++ "-" ++ hash
Nothing -> s
CLibName ->
if display (componentUnitId clbi) == display (componentComponentId clbi)
then ""
else display (componentUnitId clbi)
CSubLibName s ->
if display (componentUnitId clbi) == display (componentComponentId clbi)
then s
else display (componentUnitId clbi)
CExeName s -> s
CTestName s -> s
CBenchName s -> s
......
......@@ -315,11 +315,12 @@ 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 = UnitId cid _,
installedUnitId = uid,
sourcePackageId = pkgid
} | cid == mkComponentId ""
} | unUnitId uid == ""
= pkginfo {
installedUnitId = mkLegacyUnitId pkgid
installedUnitId = mkLegacyUnitId pkgid,
installedComponentId_ = mkComponentId (display pkgid)
}
setUnitId pkginfo = pkginfo
......
......@@ -389,6 +389,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi
pkgName = componentCompatPackageName clbi
},
IPI.installedUnitId = componentUnitId clbi,
IPI.installedComponentId_ = componentComponentId clbi,
IPI.instantiatedWith = componentInstantiatedWith clbi,
IPI.compatPackageKey = componentCompatPackageKey clbi,
IPI.license = license pkg,
......
......@@ -4,7 +4,6 @@
module Distribution.Types.ComponentLocalBuildInfo (
ComponentLocalBuildInfo(..),
componentIsIndefinite,
componentComponentId,
) where
import Prelude ()
......@@ -29,6 +28,8 @@ data ComponentLocalBuildInfo
-- PackageDescription. NB: eventually, this will NOT uniquely
-- identify the ComponentLocalBuildInfo.
componentLocalName :: ComponentName,
-- | The computed 'ComponentId' of this component.
componentComponentId :: ComponentId,
-- | The computed 'UnitId' which uniquely identifies this
-- component. Might be hashed.
componentUnitId :: UnitId,
......@@ -67,6 +68,7 @@ data ComponentLocalBuildInfo
}
| ExeComponentLocalBuildInfo {
componentLocalName :: ComponentName,
componentComponentId :: ComponentId,
componentUnitId :: UnitId,
componentPackageDeps :: [(UnitId, PackageId)],
componentIncludes :: [(OpenUnitId, ModuleRenaming)],
......@@ -75,6 +77,7 @@ data ComponentLocalBuildInfo
}
| TestComponentLocalBuildInfo {
componentLocalName :: ComponentName,
componentComponentId :: ComponentId,
componentUnitId :: UnitId,
componentPackageDeps :: [(UnitId, PackageId)],
componentIncludes :: [(OpenUnitId, ModuleRenaming)],
......@@ -84,6 +87,7 @@ data ComponentLocalBuildInfo
}
| BenchComponentLocalBuildInfo {