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

Refactor MungedPackageId and PackageIndex.

This makes the necessary changes to 4dc0f30fc36914ee2f01bde016bee98b8e0bb0bb
to handle component configuring correctly.  It probably is a good step
towards pkg:lib style dependencies.

The big ideas:

* There's a new AnnotatedId type, which is any identifier (like
  ComponentId), but also with a PackageId and ComponentName.
  It's a bit like ConfiguredId, but ConfiguredId is specialized
  for ComponentId.  There's a conversion function
  annotatedIdToConfiguredId.

* We adopt a totally new strategy for handling MungedPackageId in
  InstalledPackageInfo.  Rather than store the munged package
  identifier in IPI, we NEVER store it, instead computing it
  from the package name and library name (which are stored.)
  There is now code to PARSE a munged package name into these
  two components, so that when we read 'name' we get the
  correct info.  The resulting code is splendidly clear.

* Some places where we took a ComponentName (notably
  computeCompatPackageName) we now take 'Maybe UnqualComponentName'.
  This is more accurate, because compatibility package names are
  only computed for libraries, not other components.  Some code
  in Distribution.Backpack.ReadyComponent is partial now,
  but the invariants should hold up.

* A number of places where MungedId was applied, I undid them.
  Most notable are macro generation (that should be PACKAGES,
  not components) and mkLegacyUnitId (since REALLY old style
  unit identifiers, we won't support internal libraries anyway.)

* Many functions in PackageIndex are monomorphized to
  InstalledPackageInfo.  Fortunately cabal-install's usage
  still works.

* Distribution/Client/SolverPlanIndex.hs, not used by anyone,
  got the axe.

* Dependency solving has a hack to solve the problem of how to
  interpret installed internal libraries in the package database.
  The basic idea is that, although in most cases where we used
  a MungedId, we say it explicitly, in the SOLVER, we munge
  *installed package names* only, and keep the type PackageName.
  It's a hack, but the alternative is to write a lot more code.
  Note that is MORALLY PN is indeed a PackageName, since we really
  are solving for honest to goodness packages, not components!
  See Note [Index conversion with internal libraries] for more
  details.

* ConfiguredId now records the ComponentName.  This is quite important,
  because we need to use it to figure out how we are going to phrase
  --dependency.  In fact, it is a miracle that this worked at all
  (and it only worked because of a very skeevy update to the PackageId
  in the creation of ConfiguredComponent).  Irritatingly, this must
  be a Maybe ComponentName, because a ConfiguredId MIGHT refer to
  a setup component. Very distressing.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent b0e6c311
......@@ -207,6 +207,7 @@ library
Distribution.TestSuite
Distribution.Text
Distribution.Types.AbiHash
Distribution.Types.AnnotatedId
Distribution.Types.Benchmark
Distribution.Types.BenchmarkInterface
Distribution.Types.BenchmarkType
......
......@@ -25,6 +25,7 @@ import Distribution.Backpack.ConfiguredComponent
import Distribution.Backpack.LinkedComponent
import Distribution.Backpack.ReadyComponent
import Distribution.Backpack.ComponentsGraph
import Distribution.Backpack.Id
import Distribution.Simple.Compiler hiding (Flag)
import Distribution.Package
......@@ -37,9 +38,9 @@ import Distribution.PackageDescription as PD hiding (Flag)
import Distribution.ModuleName
import Distribution.Simple.Setup as Setup
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentRequestedSpec
import Distribution.Types.ComponentInclude
import Distribution.Types.MungedPackageId
import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Graph, IsNode(..))
......@@ -82,7 +83,13 @@ configureComponentLocalBuildInfos
(dispComponentsGraph graph0)
let conf_pkg_map = Map.fromListWith Map.union
[(pc_pkgname pkg, Map.singleton (pc_compname pkg) (pc_cid pkg, packageId pkg))
[(pc_pkgname pkg,
Map.singleton (pc_compname pkg)
(AnnotatedId {
ann_id = pc_cid pkg,
ann_pid = packageId pkg,
ann_cname = pc_compname pkg
}))
| pkg <- prePkgDeps]
graph1 <- toConfiguredComponents use_external_internal_deps
flagAssignment
......@@ -110,7 +117,7 @@ configureComponentLocalBuildInfos
let pid_map = Map.fromList $
[ (pc_uid pkg, pc_munged_id pkg)
| pkg <- prePkgDeps] ++
[ (Installed.installedUnitId pkg, Installed.sourceMungedPackageId pkg)
[ (Installed.installedUnitId pkg, mungedId pkg)
| (_, Module uid _) <- instantiate_with
, Just pkg <- [PackageIndex.lookupUnitId
installedPackageSet (unDefUnitId uid)] ]
......@@ -205,12 +212,10 @@ toComponentLocalBuildInfos
-- TODO: This is probably wrong for Backpack
let pseudoTopPkg :: InstalledPackageInfo
pseudoTopPkg = emptyInstalledPackageInfo {
Installed.installedUnitId = mkLegacyUnitId munged_id,
Installed.sourceMungedPackageId = munged_id,
Installed.installedUnitId = mkLegacyUnitId (packageId pkg_descr),
Installed.sourcePackageId = packageId pkg_descr,
Installed.depends = map pc_uid externalPkgDeps
}
where munged_id = computeCompatPackageId (packageId pkg_descr)
CLibName
case PackageIndex.dependencyInconsistencies
. PackageIndex.insert pseudoTopPkg
$ packageDependsIndex of
......@@ -243,7 +248,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
isInternal x = Set.member x internalUnits
go rc =
case rc_component rc of
CLib _ ->
CLib lib ->
let convModuleExport (modname', (Module uid modname))
| this_uid == unDefUnitId uid
, modname' == modname
......@@ -271,6 +276,10 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
Left indefc -> [ (m, OpenModuleVar m) | m <- indefc_requires indefc ]
Right instc -> [ (m, OpenModule (DefiniteUnitId uid') m')
| (m, Module uid' m') <- instc_insts instc ]
compat_name = computeCompatPackageName (packageName rc) (libName lib)
compat_key = computeCompatPackageKey comp compat_name (packageVersion rc) this_uid
in LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentUnitId = this_uid,
......@@ -283,8 +292,8 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
componentIncludes = includes,
componentExposedModules = exports,
componentIsPublic = rc_public rc,
componentCompatPackageKey = rc_compat_key rc comp,
componentCompatPackageName = rc_compat_name rc
componentCompatPackageKey = compat_key,
componentCompatPackageName = compat_name
}
CFLib _ ->
FLibComponentLocalBuildInfo {
......@@ -332,7 +341,7 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
this_cid = rc_cid rc
cname = componentName (rc_component rc)
cpds = rc_depends rc
exe_deps = map fst $ rc_exe_deps rc
exe_deps = map ann_id $ rc_exe_deps rc
is_indefinite =
case rc_i rc of
Left _ -> True
......@@ -343,6 +352,6 @@ mkLinkedComponentsLocalBuildInfo comp rcs = map go rcs
Left indefc ->
indefc_includes indefc
Right instc ->
map (\ci -> ci { ci_id = DefiniteUnitId (ci_id ci) })
map (\ci -> ci { ci_ann_id = fmap DefiniteUnitId (ci_ann_id ci) })
(instc_includes instc)
internal_deps = filter isInternal (nodeNeighbors rc)
......@@ -3,6 +3,8 @@
module Distribution.Backpack.ConfiguredComponent (
ConfiguredComponent(..),
cc_name,
cc_cid,
cc_pkgid,
toConfiguredComponent,
toConfiguredComponents,
dispConfiguredComponent,
......@@ -19,6 +21,7 @@ import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack.Id
import Distribution.Types.AnnotatedId
import Distribution.Types.Dependency
import Distribution.Types.ExeDependency
import Distribution.Types.IncludeRenaming
......@@ -48,10 +51,8 @@ import Text.PrettyPrint
-- and the 'ComponentId's of the things it depends on.
data ConfiguredComponent
= ConfiguredComponent {
-- | Uniquely identifies a configured component.
cc_cid :: ComponentId,
-- | The package this component came from.
cc_pkgid :: PackageId,
-- | Unique identifier of component, plus extra useful info.
cc_ann_id :: AnnotatedId ComponentId,
-- | The fragment of syntax from the Cabal file describing this
-- component.
cc_component :: Component,
......@@ -63,7 +64,7 @@ data ConfiguredComponent
cc_public :: Bool,
-- | Dependencies on executables from @build-tools@ and
-- @build-tool-depends@.
cc_exe_deps :: [(ComponentId, PackageId)],
cc_exe_deps :: [AnnotatedId ComponentId],
-- | The mixins of this package, including both explicit (from
-- the @mixins@ field) and implicit (from @build-depends@). Not
-- mix-in linked yet; component configuration only looks at
......@@ -71,11 +72,20 @@ data ConfiguredComponent
cc_includes :: [ComponentInclude ComponentId IncludeRenaming]
}
-- | Uniquely identifies a configured component.
cc_cid :: ConfiguredComponent -> ComponentId
cc_cid = ann_id . cc_ann_id
-- | The package this component came from.
cc_pkgid :: ConfiguredComponent -> PackageId
cc_pkgid = ann_pid . cc_ann_id
-- | The 'ComponentName' of a component; this uniquely identifies
-- a fragment of syntax within a specified Cabal file describing the
-- component.
cc_name :: ConfiguredComponent -> ComponentName
cc_name = componentName . cc_component
cc_name = ann_cname . cc_ann_id
-- | Pretty-print a 'ConfiguredComponent'.
dispConfiguredComponent :: ConfiguredComponent -> Doc
......@@ -91,17 +101,16 @@ dispConfiguredComponent cc =
mkConfiguredComponent
:: PackageDescription
-> ComponentId
-> [((PackageName, ComponentName), (ComponentId, PackageId))]
-> [(ComponentId, PackageId)]
-> [AnnotatedId ComponentId] -- lib deps
-> [AnnotatedId ComponentId] -- exe deps
-> Component
-> LogProgress ConfiguredComponent
mkConfiguredComponent pkg_decr this_cid lib_deps exe_deps component = do
mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do
-- Resolve each @mixins@ into the actual dependency
-- from @lib_deps@.
explicit_includes <- forM (mixins bi) $ \(Mixin name rns) -> do
let keys@(_, cname) = fixFakePkgName pkg_decr name
(cid, pid) <-
case Map.lookup keys deps_map of
let keys = fixFakePkgName pkg_descr name
aid <- case Map.lookup keys deps_map of
Nothing ->
dieProgress $
text "Mix-in refers to non-existent package" <+>
......@@ -109,9 +118,7 @@ mkConfiguredComponent pkg_decr this_cid lib_deps exe_deps component = do
text "(did you forget to add the package to build-depends?)"
Just r -> return r
return ComponentInclude {
ci_id = cid,
ci_pkgid = pid,
ci_compname = cname,
ci_ann_id = aid,
ci_renaming = rns,
ci_implicit = False
}
......@@ -120,18 +127,19 @@ mkConfiguredComponent pkg_decr this_cid lib_deps exe_deps component = do
-- @backpack-include@ is converted into an "implicit" include.
let used_explicitly = Set.fromList (map ci_id explicit_includes)
implicit_includes
= map (\((_, cn), (cid, pid)) -> ComponentInclude {
ci_id = cid,
ci_pkgid = pid,
ci_compname = cn,
ci_renaming = defaultIncludeRenaming,
ci_implicit = True
})
$ filter (flip Set.notMember used_explicitly . fst . snd) lib_deps
= map (\aid -> ComponentInclude {
ci_ann_id = aid,
ci_renaming = defaultIncludeRenaming,
ci_implicit = True
})
$ filter (flip Set.notMember used_explicitly . ann_id) lib_deps
return ConfiguredComponent {
cc_cid = this_cid,
cc_pkgid = package pkg_decr,
cc_ann_id = AnnotatedId {
ann_id = this_cid,
ann_pid = package pkg_descr,
ann_cname = componentName component
},
cc_component = component,
cc_public = is_public,
cc_exe_deps = exe_deps,
......@@ -139,11 +147,12 @@ mkConfiguredComponent pkg_decr this_cid lib_deps exe_deps component = do
}
where
bi = componentBuildInfo component
deps_map = Map.fromList lib_deps
deps_map = Map.fromList [ ((packageName dep, ann_cname dep), dep)
| dep <- lib_deps ]
is_public = componentName component == CLibName
type ConfiguredComponentMap =
Map PackageName (Map ComponentName (ComponentId, PackageId))
Map PackageName (Map ComponentName (AnnotatedId ComponentId))
toConfiguredComponent
:: PackageDescription
......@@ -155,7 +164,7 @@ toConfiguredComponent pkg_descr this_cid dep_map component = do
lib_deps <-
if newPackageDepsBehaviour pkg_descr
then forM (targetBuildDepends bi) $ \(Dependency name _) -> do
let keys@(pn, cn) = fixFakePkgName pkg_descr name
let (pn, cn) = fixFakePkgName pkg_descr name
value <- case Map.lookup cn =<< Map.lookup pn dep_map of
Nothing ->
dieProgress $
......@@ -163,7 +172,7 @@ toConfiguredComponent pkg_descr this_cid dep_map component = do
text (showComponentName cn) <+>
text "from" <+> disp pn
Just v -> return v
return (keys, value)
return value
else return old_style_lib_deps
mkConfiguredComponent
pkg_descr this_cid
......@@ -177,7 +186,7 @@ toConfiguredComponent pkg_descr this_cid dep_map component = do
-- this is not supported by old-style deps behavior
-- because it would imply a cyclic dependency for the
-- library itself.
old_style_lib_deps = [ ((pn, cn), e)
old_style_lib_deps = [ e
| (pn, comp_map) <- Map.toList dep_map
, pn /= packageName pkg_descr
, (cn, e) <- Map.toList comp_map
......@@ -215,10 +224,11 @@ toConfiguredComponent' use_external_internal_deps flags
then cc { cc_public = True }
else cc
where
-- TODO: pass component names to it too!
this_cid = computeComponentId deterministic ipid_flag cid_flag (package pkg_descr)
(componentName component) (Just (deps, flags))
deps = [ cid | m <- Map.elems dep_map
, (cid, _) <- Map.elems m ]
deps = [ ann_id aid | m <- Map.elems dep_map
, aid <- Map.elems m ]
extendConfiguredComponentMap
:: ConfiguredComponent
......@@ -227,7 +237,7 @@ extendConfiguredComponentMap
extendConfiguredComponentMap cc =
Map.insertWith Map.union
(pkgName (cc_pkgid cc))
(Map.singleton (cc_name cc) (cc_cid cc, cc_pkgid cc))
(Map.singleton (cc_name cc) (cc_ann_id cc))
-- Compute the 'ComponentId's for a graph of 'Component's. The
-- list of internal components must be topologically sorted
......
......@@ -5,6 +5,8 @@ module Distribution.Backpack.LinkedComponent (
LinkedComponent(..),
lc_insts,
lc_uid,
lc_cid,
lc_pkgid,
toLinkedComponent,
toLinkedComponents,
dispLinkedComponent,
......@@ -24,12 +26,12 @@ import Distribution.Backpack.UnifyM
import Distribution.Backpack.MixLink
import Distribution.Utils.MapAccum
import Distribution.Types.AnnotatedId
import Distribution.Types.ComponentName
import Distribution.Types.ModuleRenaming
import Distribution.Types.IncludeRenaming
import Distribution.Types.ComponentInclude
import Distribution.Types.ComponentId
import Distribution.Types.MungedPackageId
import Distribution.Types.PackageId
import Distribution.Package
import Distribution.PackageDescription as PD hiding (Flag)
......@@ -54,16 +56,13 @@ import Data.Either
-- is then instantiated into 'ReadyComponent'.
data LinkedComponent
= LinkedComponent {
-- | Uniquely identifies a 'LinkedComponent'. Corresponds to
-- 'cc_cid'.
lc_cid :: ComponentId,
-- | Corresponds to 'cc_pkgid'.
lc_pkgid :: PackageId,
-- | Uniquely identifies linked component
lc_ann_id :: AnnotatedId ComponentId,
-- | Corresponds to 'cc_component'.
lc_component :: Component,
-- | @build-tools@ and @build-tool-depends@ dependencies.
-- Corresponds to 'cc_exe_deps'.
lc_exe_deps :: [(OpenUnitId, PackageId)],
lc_exe_deps :: [AnnotatedId OpenUnitId],
-- | Is this the public library of a package? Corresponds to
-- 'cc_public'.
lc_public :: Bool,
......@@ -81,6 +80,15 @@ data LinkedComponent
lc_shape :: ModuleShape
}
-- | Uniquely identifies a 'LinkedComponent'. Corresponds to
-- 'cc_cid'.
lc_cid :: LinkedComponent -> ComponentId
lc_cid = ann_id . lc_ann_id
-- | Corresponds to 'cc_pkgid'.
lc_pkgid :: LinkedComponent -> PackageId
lc_pkgid = ann_pid . lc_ann_id
-- | The 'OpenUnitId' of this component in the "default" instantiation.
-- See also 'lc_insts'. 'LinkedComponent's cannot be instantiated
-- (e.g., there is no 'ModSubst' instance for them).
......@@ -106,10 +114,6 @@ dispLinkedComponent lc =
instance Package LinkedComponent where
packageId = lc_pkgid
instance HasMungedPackageId LinkedComponent where
mungedId LinkedComponent { lc_pkgid = pkgid, lc_component = component }
= computeCompatPackageId pkgid (componentName component)
toLinkedComponent
:: Verbosity
-> FullDb
......@@ -118,8 +122,7 @@ toLinkedComponent
-> ConfiguredComponent
-> LogProgress LinkedComponent
toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
cc_cid = this_cid,
cc_pkgid = pkgid,
cc_ann_id = aid@AnnotatedId { ann_id = this_cid },
cc_component = component,
cc_exe_deps = exe_deps,
cc_public = is_public,
......@@ -142,8 +145,8 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- *unlinked* unit identity. We will use unification (relying
-- on the ModuleShape) to resolve these into linked identities.
unlinked_includes :: [ComponentInclude (OpenUnitId, ModuleShape) IncludeRenaming]
unlinked_includes = [ ComponentInclude (lookupUid cid) pid cn rns i
| ComponentInclude cid pid cn rns i <- cid_includes ]
unlinked_includes = [ ComponentInclude (fmap lookupUid dep_aid) rns i
| ComponentInclude dep_aid rns i <- cid_includes ]
lookupUid :: ComponentId -> (OpenUnitId, ModuleShape)
lookupUid cid = fromMaybe (error "linkComponent: lookupUid")
......@@ -183,12 +186,10 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
-- src_reqs_u <- mapM convertReq src_reqs
-- Read out all the final results by converting back
-- into a pure representation.
let convertIncludeU (ComponentInclude uid_u pid cn rns i) = do
uid <- convertUnitIdU uid_u
let convertIncludeU (ComponentInclude dep_aid rns i) = do
uid <- convertUnitIdU (ann_id dep_aid)
return (ComponentInclude {
ci_id = uid,
ci_pkgid = pid,
ci_compname = cn,
ci_ann_id = dep_aid { ann_id = uid },
ci_renaming = rns,
ci_implicit = i
})
......@@ -283,13 +284,11 @@ toLinkedComponent verbosity db this_pid pkg_map ConfiguredComponent {
let final_linked_shape = ModuleShape provs (Map.keysSet (modScopeRequires linked_shape))
return $ LinkedComponent {
lc_cid = this_cid,
lc_pkgid = pkgid,
lc_ann_id = aid,
lc_component = component,
lc_public = is_public,
-- These must be executables
lc_exe_deps =
map (\(cid, pid) -> (IndefFullUnitId cid Map.empty, pid)) exe_deps,
lc_exe_deps = map (fmap (\cid -> IndefFullUnitId cid Map.empty)) exe_deps,
lc_shape = final_linked_shape,
lc_includes = linked_includes,
lc_sig_includes = linked_sig_includes
......
......@@ -45,9 +45,9 @@ data PreExistingComponent
ipiToPreExistingComponent :: InstalledPackageInfo -> PreExistingComponent
ipiToPreExistingComponent ipi =
PreExistingComponent {
pc_pkgname = Installed.sourcePackageName' ipi,
pc_pkgname = packageName ipi,
pc_compname = libraryComponentName $ Installed.sourceLibName ipi,
pc_munged_id = Installed.sourceMungedPackageId ipi,
pc_munged_id = mungedId ipi,
pc_uid = Installed.installedUnitId ipi,
pc_cid = Installed.installedComponentId ipi,
pc_open_uid =
......
......@@ -5,9 +5,9 @@ module Distribution.Backpack.ReadyComponent (
ReadyComponent(..),
InstantiatedComponent(..),
IndefiniteComponent(..),
rc_compat_name,
rc_compat_key,
rc_depends,
rc_uid,
rc_pkgid,
dispReadyComponent,
toReadyComponents,
) where
......@@ -16,25 +16,26 @@ import Prelude ()
import Distribution.Compat.Prelude hiding ((<>))
import Distribution.Backpack
import Distribution.Backpack.Id
import Distribution.Backpack.LinkedComponent
import Distribution.Backpack.ModuleShape
import Distribution.Types.AnnotatedId
import Distribution.Types.ModuleRenaming
import Distribution.Types.Component
import Distribution.Types.ComponentInclude
import Distribution.Types.ComponentId
import Distribution.Types.ComponentName
import Distribution.Types.PackageId
import Distribution.Types.UnitId
import Distribution.Compat.Graph (IsNode(..))
import Distribution.Types.Module
import Distribution.Types.MungedPackageId
import Distribution.Types.MungedPackageName
import Distribution.Types.Library
import Distribution.ModuleName
import Distribution.Package
import Distribution.Simple.Utils
import Distribution.Simple.Compiler
import qualified Control.Applicative as A
import qualified Data.Traversable as T
......@@ -53,9 +54,7 @@ import Distribution.Text
--
data ReadyComponent
= ReadyComponent {
-- | The final, string 'UnitId' that will uniquely identify
-- the compilation products of this component.
rc_uid :: UnitId,
rc_ann_id :: AnnotatedId UnitId,
-- | The 'OpenUnitId' for this package. At the moment, this
-- is used in only one case, which is to determine if an
-- export is of a module from this library (indefinite
......@@ -67,14 +66,12 @@ data ReadyComponent
-- | Corresponds to 'lc_cid'. Invariant: if 'rc_open_uid'
-- records a 'ComponentId', it coincides with this one.
rc_cid :: ComponentId,
-- | Corresponds to 'lc_pkgid'.
rc_pkgid :: PackageId,
-- | Corresponds to 'lc_component'.
rc_component :: Component,
-- | Corresponds to 'lc_exe_deps'.
-- Build-tools don't participate in mix-in linking.
-- (but what if they could?)
rc_exe_deps :: [(UnitId, PackageId)],
rc_exe_deps :: [AnnotatedId UnitId],
-- | Corresponds to 'lc_public'.
rc_public :: Bool,
-- | Extra metadata depending on whether or not this is an
......@@ -83,6 +80,15 @@ data ReadyComponent
rc_i :: Either IndefiniteComponent InstantiatedComponent
}
-- | The final, string 'UnitId' that will uniquely identify
-- the compilation products of this component.
rc_uid :: ReadyComponent -> UnitId
rc_uid = ann_id . rc_ann_id
-- | Corresponds to 'lc_pkgid'.
rc_pkgid :: ReadyComponent -> PackageId
rc_pkgid = ann_pid . rc_ann_id
-- | An 'InstantiatedComponent' is a library which is fully instantiated
-- (or, possibly, has no requirements at all.)
data InstantiatedComponent
......@@ -128,16 +134,29 @@ rc_depends rc = ordNub $
(instc_includes instc)
++ instc_insts_deps instc
where
toMungedPackageId :: ComponentInclude x y -> MungedPackageId
toMungedPackageId ci = computeCompatPackageId (ci_pkgid ci) (ci_compname ci)
toMungedPackageId :: Text id => ComponentInclude id rn -> MungedPackageId
toMungedPackageId ci =
computeCompatPackageId
(ci_pkgid ci)
(case ci_cname ci of
CLibName -> Nothing
CSubLibName uqn -> Just uqn
_ -> error $ display (rc_cid rc) ++
" depends on non-library " ++ display (ci_id ci))
-- | Get the 'MungedPackageId' of a 'ReadyComponent' IF it is
-- a library.
rc_munged_id :: ReadyComponent -> MungedPackageId
rc_munged_id rc =
computeCompatPackageId
(rc_pkgid rc)
(case rc_component rc of
CLib lib -> libName lib
_ -> error "rc_munged_id: not library")
instance Package ReadyComponent where
packageId = rc_pkgid
instance HasMungedPackageId ReadyComponent where
mungedId ReadyComponent { rc_pkgid = pkgid, rc_component = component }
= computeCompatPackageId pkgid (componentName component)
instance HasUnitId ReadyComponent where
installedUnitId = rc_uid
......@@ -152,22 +171,7 @@ instance IsNode ReadyComponent where
-> [newSimpleUnitId (rc_cid rc)]
_ -> []) ++
ordNub (map fst (rc_depends rc)) ++
map fst (rc_exe_deps rc)
rc_compat_name :: ReadyComponent -> MungedPackageName
rc_compat_name ReadyComponent {
rc_pkgid = PackageIdentifier pkg_name _,
rc_component = component
}
= computeCompatPackageName pkg_name (componentName component)
rc_compat_key :: ReadyComponent -> Compiler -> String
rc_compat_key rc@ReadyComponent {
rc_pkgid = PackageIdentifier _ pkg_ver,
rc_uid = uid
} comp -- TODO: A wart. But the alternative is to store
-- the Compiler in the LinkedComponent
= computeCompatPackageKey comp (rc_compat_name rc) pkg_ver uid
map ann_id (rc_exe_deps rc)
dispReadyComponent :: ReadyComponent -> Doc
dispReadyComponent rc =
......@@ -256,7 +260,7 @@ toReadyComponents pid_map subst0 comps
provides <- T.mapM (substModule insts) (modShapeProvides (lc_shape lc))
includes <- forM (lc_includes lc) $ \ci -> do
uid' <- substUnitId insts (ci_id ci)
return ci { ci_id = uid' }
return ci { ci_ann_id = fmap (const uid') (ci_ann_id ci) }
exe_deps <- mapM (substExeDep insts) (lc_exe_deps lc)
s <- InstM $ \s -> (s, s)
let getDep (Module dep_def_uid _)
......@@ -265,7 +269,7 @@ toReadyComponents pid_map subst0 comps
= [(dep_uid,
fromMaybe err_pid $
Map.lookup dep_uid pid_map A.<|>
fmap mungedId (join (Map.lookup dep_uid s)))]
fmap rc_munged_id (join (Map.lookup dep_uid s)))]
where
err_pid = MungedPackageId
(mkMungedPackageName "nonexistent-package-this-is-a-cabal-bug")
......@@ -284,10 +288,9 @@ toReadyComponents pid_map subst0 comps
-- automatically
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_ann_id = (lc_ann_id lc) { ann_id = uid },
rc_open_uid = DefiniteUnitId (unsafeMkDefUnitId uid),
rc_cid = lc_cid lc,
rc_pkgid = lc_pkgid lc,
rc_component = lc_component lc,
rc_exe_deps = exe_deps,
rc_public = lc_public lc,
......@@ -317,10 +320,10 @@ toReadyComponents pid_map subst0 comps
return (Module uid' mod_name)
substExeDep :: Map ModuleName Module
-> (OpenUnitId, PackageId) -> InstM (UnitId, PackageId)
substExeDep insts (exe_uid, exe_pid) = do
exe_uid' <- substUnitId insts exe_uid
return (unDefUnitId exe_uid', exe_pid)
-> AnnotatedId OpenUnitId -> InstM (AnnotatedId UnitId)
substExeDep insts exe_aid = do
exe_uid' <- substUnitId insts (ann_id exe_aid)
return exe_aid { ann_id = unDefUnitId exe_uid' }
indefiniteUnitId :: ComponentId -> InstM UnitId
indefiniteUnitId cid = do
......@@ -338,10 +341,8 @@ toReadyComponents pid_map subst0 comps
indefc_includes = lc_includes lc ++ lc_sig_includes lc
}
return $ Just ReadyComponent {
rc_uid = uid,
rc_ann_id = (lc_ann_id lc) { ann_id = uid },
rc_open_uid = lc_uid lc,
rc_cid = lc_cid lc,