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

Be more careful about ComponentId versus UnitId.

Two big ideas:

    * @--dependency@ takes a ComponentId, not UnitId.
      I used to think it should be a UnitId but it is
      now clear that you want to finger the indefinite
      unit id, which can be uniquely identified with
      a ComponentId

    * When hashing for an InstalledPackageId in
      new-build, we should produce a ComponentId,
      not a UnitId.

While cleaning up the results, for any codepaths which we don't plan on
implementing Backpack (Distribution.Client.Install, I'm looking at you),
just coerce ComponentId into UnitIds as necessary.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 6764810d
......@@ -108,6 +108,9 @@ installedComponentId ipi = case installedUnitId ipi of
{-# DEPRECATED installedPackageId "Use installedUnitId instead" #-}
-- | Backwards compatibility with Cabal pre-1.24.
-- This type synonym is slightly awful because in cabal-install
-- we define an 'InstalledPackageId' but it's a ComponentId,
-- not a UnitId!
installedPackageId :: InstalledPackageInfo -> UnitId
installedPackageId = installedUnitId
......
......@@ -239,7 +239,7 @@ packageVersion = pkgVersion . packageId
instance Package PackageIdentifier where
packageId = id
-- | Packages that have an installed package ID
-- | Packages that have an installed unit ID
class Package pkg => HasUnitId pkg where
installedUnitId :: pkg -> UnitId
......
......@@ -1332,15 +1332,15 @@ newPackageDepsBehaviour pkg =
-- deps in the end. So we still need to remember which installed packages to
-- pick.
combinedConstraints :: [Dependency] ->
[(PackageName, UnitId)] ->
[(PackageName, ComponentId)] ->
InstalledPackageIndex ->
Either String ([Dependency],
Map PackageName InstalledPackageInfo)
combinedConstraints constraints dependencies installedPackages = do
when (not (null badUnitIds)) $
when (not (null badComponentIds)) $
Left $ render $ text "The following package dependencies were requested"
$+$ nest 4 (dispDependencies badUnitIds)
$+$ nest 4 (dispDependencies badComponentIds)
$+$ text "however the given installed package instance does not exist."
--TODO: we don't check that all dependencies are used!
......@@ -1359,26 +1359,26 @@ combinedConstraints constraints dependencies installedPackages = do
| (_, _, Just pkg) <- dependenciesPkgInfo ]
-- The dependencies along with the installed package info, if it exists
dependenciesPkgInfo :: [(PackageName, UnitId,
dependenciesPkgInfo :: [(PackageName, ComponentId,
Maybe InstalledPackageInfo)]
dependenciesPkgInfo =
[ (pkgname, ipkgid, mpkg)
| (pkgname, ipkgid) <- dependencies
, let mpkg = PackageIndex.lookupUnitId
installedPackages ipkgid
[ (pkgname, cid, mpkg)
| (pkgname, cid) <- dependencies
, let mpkg = PackageIndex.lookupComponentId
installedPackages cid
]
-- If we looked up a package specified by an installed package id
-- (i.e. someone has written a hash) and didn't find it then it's
-- an error.
badUnitIds =
[ (pkgname, ipkgid)
| (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ]
badComponentIds =
[ (pkgname, cid)
| (pkgname, cid, Nothing) <- dependenciesPkgInfo ]
dispDependencies deps =
hsep [ text "--dependency="
<<>> quotes (disp pkgname <<>> char '=' <<>> disp ipkgid)
| (pkgname, ipkgid) <- deps ]
<<>> quotes (disp pkgname <<>> char '=' <<>> disp cid)
| (pkgname, cid) <- deps ]
-- -----------------------------------------------------------------------------
-- Configuring program dependencies
......
......@@ -77,6 +77,7 @@ module Distribution.Simple.PackageIndex (
-- ** Precise lookups
lookupUnitId,
lookupComponentId,
lookupSourcePackageId,
lookupPackageId,
lookupPackageName,
......@@ -379,14 +380,21 @@ allPackagesBySourcePackageId (PackageIndex _ pnames) =
-- * Lookups
--
-- | Does a lookup by source package id (name & version).
-- | Does a lookup by unit identifier.
--
-- Since multiple package DBs mask each other by 'UnitId',
-- then we get back at most one package.
--
lookupUnitId :: PackageIndex a -> UnitId
-> Maybe a
lookupUnitId (PackageIndex pids _) pid = Map.lookup pid pids
lookupUnitId (PackageIndex m _) uid = Map.lookup uid m
-- | Does a lookup by component identifier. In the absence
-- of Backpack, this is just a 'lookupUnitId'.
--
lookupComponentId :: PackageIndex a -> ComponentId
-> Maybe a
lookupComponentId (PackageIndex m _) uid = Map.lookup (SimpleUnitId uid) m
-- | Backwards compatibility for Cabal pre-1.24.
{-# DEPRECATED lookupInstalledPackageId "Use lookupUnitId instead" #-}
......
......@@ -404,7 +404,7 @@ data ConfigFlags = ConfigFlags {
configStripLibs :: Flag Bool, -- ^Enable library stripping
configConstraints :: [Dependency], -- ^Additional constraints for
-- dependencies.
configDependencies :: [(PackageName, UnitId)],
configDependencies :: [(PackageName, ComponentId)],
-- ^The packages depended on.
configConfigurationsFlags :: FlagAssignment,
configTests :: Flag Bool, -- ^Enable test suite compilation
......@@ -709,7 +709,7 @@ configureOptions showOrParseArgs =
,option "" ["dependency"]
"A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\""
configDependencies (\v flags -> flags { configDependencies = v})
(reqArg "NAME=ID"
(reqArg "NAME=CID"
(readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parseDependency))
(map (\x -> display (fst x) ++ "=" ++ display (snd x))))
......@@ -795,7 +795,7 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String]
showProfDetailLevelFlag NoFlag = []
showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl]
parseDependency :: Parse.ReadP r (PackageName, UnitId)
parseDependency :: Parse.ReadP r (PackageName, ComponentId)
parseDependency = do
x <- parse
_ <- Parse.char '='
......
......@@ -55,7 +55,7 @@ import Distribution.Simple.PackageIndex
import Distribution.Simple.Utils
( defaultPackageDesc )
import Distribution.Package
( Package(..), UnitId, packageName
( Package(..), packageName
, Dependency(..), thisPackageVersion
)
import qualified Distribution.PackageDescription as PkgDesc
......@@ -244,14 +244,14 @@ configureSetupScript packageDBs
defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends
maybeSetupBuildInfo
explicitSetupDeps :: Maybe [(UnitId, PackageId)]
explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps = do
-- Check if there is an explicit setup stanza.
_buildInfo <- maybeSetupBuildInfo
-- Return the setup dependencies computed by the solver
ReadyPackage cpkg <- mpkg
return [ ( uid, srcid )
| ConfiguredId srcid uid <- CD.setupDeps (confPkgDeps cpkg)
return [ ( cid, srcid )
| ConfiguredId srcid cid <- CD.setupDeps (confPkgDeps cpkg)
]
-- | Warn if any constraints or preferences name packages that are not in the
......
......@@ -77,6 +77,7 @@ import Distribution.Client.Dependency.Types
import Distribution.Client.FetchUtils
import Distribution.Client.HttpUtils
( HttpTransport (..) )
import Distribution.Solver.Types.PackageFixedDeps
import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
......@@ -149,10 +150,9 @@ import Distribution.Simple.Register (registerPackage)
import Distribution.Simple.Program.HcPkg (MultiInstance(..))
import Distribution.Package
( PackageIdentifier(..), PackageId, packageName, packageVersion
, Package(..)
, Package(..), HasUnitId(..)
, Dependency(..), thisPackageVersion
, UnitId(..)
, HasUnitId(..) )
, UnitId(..) )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( PackageDescription, GenericPackageDescription(..), Flag(..)
......@@ -618,7 +618,7 @@ packageStatus installedPkgIndex cpkg =
-- deps of installed pkg
(resolveInstalledIds $ Installed.depends pkg)
-- deps of configured pkg
(resolveInstalledIds $ map confInstId (CD.nonSetupDeps (confPkgDeps pkg')))
(resolveInstalledIds $ CD.nonSetupDeps (depends pkg'))
-- convert to source pkg ids via index
resolveInstalledIds :: [UnitId] -> [PackageIdentifier]
......@@ -1156,12 +1156,11 @@ performInstallations verbosity
| otherwise = False
substLogFileName :: PathTemplate -> PackageIdentifier -> UnitId -> FilePath
substLogFileName template pkg ipid = fromPathTemplate
substLogFileName template pkg uid = fromPathTemplate
. substPathTemplate env
$ template
where env = initialPathTemplateEnv (packageId pkg)
ipid
(compilerInfo comp) platform
where env = initialPathTemplateEnv (packageId pkg) uid
(compilerInfo comp) platform
miscOptions = InstallMisc {
libVersion = flagToMaybe (configCabalVersion configExFlags)
......@@ -1179,7 +1178,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg =
InstallPlan.execute
jobCtl keepGoing depsFailure plan0 $ \pkg -> do
buildOutcome <- installPkg pkg
printBuildResult (packageId pkg) (installedPackageId pkg) buildOutcome
printBuildResult (packageId pkg) (installedUnitId pkg) buildOutcome
return buildOutcome
where
......@@ -1188,7 +1187,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg =
-- Print build log if something went wrong, and 'Installed $PKGID'
-- otherwise.
printBuildResult :: PackageId -> UnitId -> BuildOutcome -> IO ()
printBuildResult pkgid ipid buildOutcome = case buildOutcome of
printBuildResult pkgid uid buildOutcome = case buildOutcome of
(Right _) -> notice verbosity $ "Installed " ++ display pkgid
(Left _) -> do
notice verbosity $ "Failed to install " ++ display pkgid
......@@ -1196,7 +1195,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg =
case useLogFile of
Nothing -> return ()
Just (mkLogFileName, _) -> do
let logName = mkLogFileName pkgid ipid
let logName = mkLogFileName pkgid uid
putStr $ "Build log ( " ++ logName ++ " ):\n"
printFile logName
......@@ -1231,9 +1230,9 @@ installReadyPackage platform cinfo configFlags
-- In the end only one set gets passed to Setup.hs configure, depending on
-- the Cabal version we are talking to.
configConstraints = [ thisPackageVersion srcid
| ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName srcid, uid)
| ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
| ConfiguredId srcid _ipid <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName srcid, dep_ipid)
| ConfiguredId srcid dep_ipid <- CD.nonSetupDeps deps ],
-- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True,
configBenchmarks = toFlag False,
......@@ -1415,7 +1414,7 @@ installUnpackedPackage verbosity installLock numJobs
-- Install phase
onFailure InstallFailed $ criticalSection installLock $ do
-- Actual installation
withWin32SelfUpgrade verbosity ipid configFlags
withWin32SelfUpgrade verbosity uid configFlags
cinfo platform pkg $ do
setup Cabal.copyCommand copyFlags mLogPath
......@@ -1423,8 +1422,8 @@ installUnpackedPackage verbosity installLock numJobs
-- it can be incorporated into the final InstallPlan
ipkgs <- genPkgConfs mLogPath
let ipkgs' = case ipkgs of
[ipkg] -> [ipkg { Installed.installedUnitId = ipid }]
_ -> assert (any ((== ipid)
[ipkg] -> [ipkg { Installed.installedUnitId = uid }]
_ -> assert (any ((== uid)
. Installed.installedUnitId)
ipkgs) ipkgs
let packageDBs = interpretPackageDbFlags
......@@ -1439,7 +1438,7 @@ installUnpackedPackage verbosity installLock numJobs
where
pkgid = packageId pkg
ipid = installedUnitId rpkg
uid = installedUnitId rpkg
cinfo = compilerInfo comp
buildCommand' = buildCommand conf
buildFlags _ = emptyBuildFlags {
......@@ -1480,7 +1479,7 @@ installUnpackedPackage verbosity installLock numJobs
}
where
CompilerId flavor _ = compilerInfoId cinfo
env = initialPathTemplateEnv pkgid ipid cinfo platform
env = initialPathTemplateEnv pkgid uid cinfo platform
userInstall = fromFlagOrDefault defaultUserInstall
(configUserInstall configFlags')
......@@ -1527,7 +1526,7 @@ installUnpackedPackage verbosity installLock numJobs
case useLogFile of
Nothing -> return Nothing
Just (mkLogFileName, _) -> do
let logFileName = mkLogFileName (packageId pkg) ipid
let logFileName = mkLogFileName (packageId pkg) uid
logDir = takeDirectory logFileName
unless (null logDir) $ createDirectoryIfMissing True logDir
logFileExists <- doesFileExist logFileName
......@@ -1570,7 +1569,7 @@ withWin32SelfUpgrade :: Verbosity
-> PackageDescription
-> IO a -> IO a
withWin32SelfUpgrade _ _ _ _ _ _ action | buildOS /= Windows = action
withWin32SelfUpgrade verbosity ipid configFlags cinfo platform pkg action = do
withWin32SelfUpgrade verbosity uid configFlags cinfo platform pkg action = do
defaultDirs <- InstallDirs.defaultInstallDirs
compFlavor
......@@ -1598,10 +1597,10 @@ withWin32SelfUpgrade verbosity ipid configFlags cinfo platform pkg action = do
templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault
defaultDirs (configInstallDirs configFlags)
absoluteDirs = InstallDirs.absoluteInstallDirs
pkgid ipid
pkgid uid
cinfo InstallDirs.NoCopyDest
platform templateDirs
substTemplate = InstallDirs.fromPathTemplate
. InstallDirs.substPathTemplate env
where env = InstallDirs.initialPathTemplateEnv pkgid ipid
where env = InstallDirs.initialPathTemplateEnv pkgid uid
cinfo platform
......@@ -423,15 +423,12 @@ configureInstallPlan solverPlan =
-> ConfiguredPackage UnresolvedPkgLoc
configureSolverPackage mapDep spkg =
ConfiguredPackage {
confPkgId = SimpleUnitId
$ Configure.computeComponentId
confPkgId = Configure.computeComponentId
Cabal.NoFlag
Cabal.NoFlag
(packageId spkg)
PD.CLibName
-- TODO: this is a hack that won't work for Backpack.
(map ((\(SimpleUnitId cid0) -> cid0) . confInstId)
(CD.libraryDeps deps))
(map confInstId (CD.libraryDeps deps))
(solverPkgFlags spkg),
confPkgSource = solverPkgSource spkg,
confPkgFlags = solverPkgFlags spkg,
......
......@@ -29,7 +29,7 @@ module Distribution.Client.PackageHash (
) where
import Distribution.Package
( PackageId, PackageIdentifier(..), mkUnitId )
( PackageId, PackageIdentifier(..), ComponentId(..) )
import Distribution.System
( Platform, OS(Windows), buildOS )
import Distribution.PackageDescription
......@@ -86,7 +86,7 @@ hashedInstalledPackageId
--
hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkUnitId $
ComponentId $
display pkgHashPkgId -- to be a bit user friendly
++ "-"
++ showHashValue (hashPackageHashInputs pkghashinputs)
......@@ -111,7 +111,7 @@ hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} =
--
hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId
hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} =
mkUnitId $
ComponentId $
intercalate "-"
-- max length now 64
[ truncateStr 14 (display name)
......
......@@ -124,7 +124,7 @@ import System.Directory
--
-- This is used as the result of the dry-run of building an install plan.
--
type BuildStatusMap = Map InstalledPackageId BuildStatus
type BuildStatusMap = Map UnitId BuildStatus
-- | The build status for an individual package is the state that the
-- package is in /prior/ to initiating a (re)build.
......@@ -336,13 +336,13 @@ foldMInstallPlanDepOrder
=> GenericInstallPlan ipkg srcpkg
-> (GenericPlanPackage ipkg srcpkg ->
[b] -> m b)
-> m (Map InstalledPackageId b)
-> m (Map UnitId b)
foldMInstallPlanDepOrder plan0 visit =
go Map.empty (InstallPlan.reverseTopologicalOrder plan0)
where
go :: Map InstalledPackageId b
go :: Map UnitId b
-> [GenericPlanPackage ipkg srcpkg]
-> m (Map InstalledPackageId b)
-> m (Map UnitId b)
go !results [] = return results
go !results (pkg : pkgs) = do
......@@ -361,24 +361,24 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan
-> ElaboratedInstallPlan
improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus =
replaceWithPrePreExisting installPlan
[ (installedPackageId pkg, mipkg)
[ (installedUnitId pkg, mipkg)
| InstallPlan.Configured pkg
<- InstallPlan.reverseTopologicalOrder installPlan
, let ipkgid = installedPackageId pkg
Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus
, let uid = installedUnitId pkg
Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus
, BuildStatusUpToDate (BuildResult { buildResultLibInfo = mipkg })
<- [pkgBuildStatus]
]
where
replaceWithPrePreExisting =
foldl' (\plan (ipkgid, mipkg) ->
foldl' (\plan (uid, mipkg) ->
-- TODO: A grievous hack. Better to have a special type
-- of entry representing pre-existing executables.
let stub_ipkg = Installed.emptyInstalledPackageInfo {
Installed.installedUnitId = ipkgid
Installed.installedUnitId = uid
}
ipkg = fromMaybe stub_ipkg mipkg
in InstallPlan.preexisting ipkgid ipkg plan)
in InstallPlan.preexisting uid ipkg plan)
-----------------------------
......@@ -699,8 +699,8 @@ rebuildTargets verbosity
installPlan $ \pkg ->
handle (return . Left) $ fmap Right $ --TODO: review exception handling
let ipkgid = installedPackageId pkg
Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus in
let uid = installedUnitId pkg
Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus in
rebuildTarget
verbosity
......@@ -838,8 +838,8 @@ asyncDownloadPackages verbosity withRepoCtx installPlan pkgsBuildStatus body
[ pkgSourceLocation (getElaboratedPackage pkg_or_comp)
| InstallPlan.Configured pkg_or_comp
<- InstallPlan.reverseTopologicalOrder installPlan
, let ipkgid = installedPackageId pkg_or_comp
Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus
, let uid = installedUnitId pkg_or_comp
Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus
, BuildStatusDownload <- [pkgBuildStatus]
]
......@@ -1059,7 +1059,7 @@ buildAndInstallUnpackedPackage verbosity
-- grab and modify the InstalledPackageInfo. We decide what
-- the installed package id is, not the build system.
ipkg0 <- generateInstalledPackageInfo
let ipkg = ipkg0 { Installed.installedUnitId = ipkgid }
let ipkg = ipkg0 { Installed.installedUnitId = uid }
criticalSection registerLock $
Cabal.registerPackage verbosity compiler progdb
......@@ -1081,7 +1081,7 @@ buildAndInstallUnpackedPackage verbosity
where
pkgid = packageId rpkg
ipkgid = installedPackageId rpkg
uid = installedUnitId rpkg
isParallelBuild = buildSettingNumJobs >= 2
......@@ -1125,7 +1125,7 @@ buildAndInstallUnpackedPackage verbosity
mlogFile =
case buildSettingLogFile of
Nothing -> Nothing
Just mkLogFile -> Just (mkLogFile compiler platform pkgid ipkgid)
Just mkLogFile -> Just (mkLogFile compiler platform pkgid uid)
initLogFile =
case mlogFile of
......
......@@ -62,8 +62,7 @@ import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.ProjectBuilding
import Distribution.Client.Types
( InstalledPackageId, installedPackageId
, GenericReadyPackage(..), PackageLocation(..) )
( GenericReadyPackage(..), PackageLocation(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.BuildTarget
( UserBuildTarget, resolveUserBuildTargets
......@@ -318,14 +317,14 @@ resolveAndCheckTargets :: PackageTarget
-> ElaboratedInstallPlan
-> [BuildTarget PackageName]
-> Either [BuildTargetProblem]
(Map InstalledPackageId [PackageTarget])
(Map UnitId [PackageTarget])
resolveAndCheckTargets targetDefaultComponents
targetSpecificComponent
installPlan targets =
case partitionEithers (map checkTarget targets) of
([], targets') -> Right $ Map.fromListWith (++)
[ (ipkgid, [t]) | (ipkgids, t) <- targets'
, ipkgid <- ipkgids ]
[ (uid, [t]) | (uids, t) <- targets'
, uid <- uids ]
(problems, _) -> Left problems
where
-- TODO [required eventually] currently all build targets refer to packages
......@@ -369,15 +368,15 @@ resolveAndCheckTargets targetDefaultComponents
-- NB: It's a list of 'InstalledPackageId', because each component
-- in the install plan from a single package needs to be associated with
-- the same 'PackageName'.
projAllPkgs, projLocalPkgs :: Map PackageName [InstalledPackageId]
projAllPkgs, projLocalPkgs :: Map PackageName [UnitId]
projAllPkgs =
Map.fromListWith (++)
[ (packageName pkg, [installedPackageId pkg])
[ (packageName pkg, [installedUnitId pkg])
| pkg <- InstallPlan.toList installPlan ]
projLocalPkgs =
Map.fromListWith (++)
[ (packageName pkg, [installedPackageId pkg_or_comp])
[ (packageName pkg, [installedUnitId pkg_or_comp])
| InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan
, let pkg = getElaboratedPackage pkg_or_comp
, case pkgSourceLocation pkg of
......@@ -459,7 +458,7 @@ printPlan verbosity
ElabComponent comp ->
" (" ++ maybe "custom" display (elabComponentName comp) ++ ")") ++
showFlagAssignment (nonDefaultFlags pkg) ++
let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg_or_comp in
let buildStatus = pkgsBuildStatus Map.! installedUnitId pkg_or_comp in
" (" ++ showBuildStatus buildStatus ++ ")"
where
pkg = getElaboratedPackage pkg_or_comp
......
......@@ -10,6 +10,7 @@ module Distribution.Client.ProjectPlanOutput (
import Distribution.Client.ProjectPlanning.Types
import Distribution.Client.DistDirLayout
import Distribution.Client.Types
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.Utils.Json as J
......@@ -82,7 +83,7 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig =
flat_deps = ordNub (ComponentDeps.flatDeps (pkgDependencies pkg))
components = J.object
[ comp2str c J..= J.object
[ "depends" J..= map (jdisplay . installedUnitId) v ]
[ "depends" J..= map (jdisplay . confInstId) v ]
-- NB: does NOT contain order-only dependencies
| (c,v) <- ComponentDeps.toList (pkgDependencies pkg) ]
......@@ -96,7 +97,7 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig =
| (PD.FlagName fn,v) <-
pkgFlagAssignment pkg ]
-- NB: does NOT contain order-only dependencies
, "depends" J..= map (jdisplay . installedUnitId) (elabComponentDependencies comp)
, "depends" J..= map (jdisplay . confInstId) (elabComponentDependencies comp)
]
where
pkg = elabComponentPackage comp
......
......@@ -211,7 +211,7 @@ sanityCheckElaboratedPackage sharedConfig
-- the 'hashedInstalledPackageId' we would compute from
-- the elaborated configured package
. assert (pkgBuildStyle == BuildInplaceOnly ||
installedPackageId pkg == hashedInstalledPackageId
pkgInstalledId == hashedInstalledPackageId
(packageHashInputs sharedConfig (ElabPackage pkg)))
-- either a package is built inplace, or we are not attempting to
......@@ -1071,7 +1071,7 @@ elaborateInstallPlan platform compiler compilerprogdb
ecomp = ElaboratedComponent {
elabComponent = cname',
elabComponentName = Just cname,
elabComponentId = cid,
elabComponentId = SimpleUnitId cid, -- Backpack later!
elabComponentPackage = pkg,
elabComponentDependencies = deps,
-- TODO: track dependencies on executables
......@@ -1081,9 +1081,10 @@ elaborateInstallPlan platform compiler compilerprogdb
elabComponentReplTarget = Nothing,
elabComponentBuildHaddocks = False
}
cid :: ComponentId
cid = case pkgBuildStyle pkg of
BuildInplaceOnly ->
mkUnitId $
ComponentId $
display pkgid ++ "-inplace" ++
(case Cabal.componentNameString cname of
Nothing -> ""
......@@ -1129,7 +1130,7 @@ elaborateInstallPlan platform compiler compilerprogdb
pkgInstalledId
| shouldBuildInplaceOnly pkg
= mkUnitId (display pkgid ++ "-inplace")
= ComponentId (display pkgid ++ "-inplace")
| otherwise
= assert (isJust pkgSourceHash) $
......@@ -1253,12 +1254,13 @@ elaborateInstallPlan platform compiler compilerprogdb
pkgProgPrefix = perPkgOptionMaybe pkgid packageConfigProgPrefix
pkgProgSuffix = perPkgOptionMaybe pkgid packageConfigProgSuffix
-- TODO: This needs to be overridden in per-component mode
pkgInstallDirs
| shouldBuildInplaceOnly pkg
-- use the ordinary default install dirs
= (InstallDirs.absoluteInstallDirs
pkgid
pkgInstalledId
(SimpleUnitId pkgInstalledId)
(compilerInfo compiler)
InstallDirs.NoCopyDest
platform
......@@ -1513,7 +1515,7 @@ pkgBuildTargetWholeComponents (ElabComponent comp) =
-- targets. Also, update the package config to specify which optional stanzas
-- to enable, and which targets within each package to build.