Commit 435725ef authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Add an Installed state to InstallPlan packages

This patch just adds the state without yet using it. That'll follow in
subsequent patches.

So why add an Installed state? Didn't we just remove the Installed,
Processing and Failed states? Those states were used when we followed
the approach of updating the InstallPlan as a build progressed (whereas
we now do traversals without altering the InstallPlan).

The idea of adding an Installed state now is that we can more usefully
represent the state of the plan when we "improve" the plan with packages
from the store or when we update the plan having checked if inplace
packages are up to date. Currently in these two places we replace
Configured source packages with PreExisting packages. There's a couple
problems with this. Firstly the PreExisting state only contains an
InstalledPackageInfo which means we loose information compared to all
the detail in the Configured source package. This is relevant for things
like plan.json output or other features that want to know the status of
a project. Secondly we have to fake things for executables since they
are not properly represented by InstalledPackageInfo.
parent c7d55c3c
......@@ -159,6 +159,7 @@ import Prelude hiding (lookup)
data GenericPlanPackage ipkg srcpkg
= PreExisting ipkg
| Configured srcpkg
| Installed srcpkg
deriving (Eq, Show, Generic)
type IsUnit a = (IsNode a, Key a ~ UnitId)
......@@ -172,9 +173,11 @@ instance (IsNode ipkg, IsNode srcpkg, Key ipkg ~ UnitId, Key srcpkg ~ UnitId)
=> IsNode (GenericPlanPackage ipkg srcpkg) where
type Key (GenericPlanPackage ipkg srcpkg) = UnitId
nodeKey (PreExisting ipkg) = nodeKey ipkg
nodeKey (Configured spkg) = nodeKey spkg
nodeKey (Configured spkg) = nodeKey spkg
nodeKey (Installed spkg) = nodeKey spkg
nodeNeighbors (PreExisting ipkg) = nodeNeighbors ipkg
nodeNeighbors (Configured spkg) = nodeNeighbors spkg
nodeNeighbors (Configured spkg) = nodeNeighbors spkg
nodeNeighbors (Installed spkg) = nodeNeighbors spkg
instance (Binary ipkg, Binary srcpkg)
=> Binary (GenericPlanPackage ipkg srcpkg)
......@@ -186,17 +189,20 @@ instance (Package ipkg, Package srcpkg) =>
Package (GenericPlanPackage ipkg srcpkg) where
packageId (PreExisting ipkg) = packageId ipkg
packageId (Configured spkg) = packageId spkg
packageId (Installed spkg) = packageId spkg
instance (HasUnitId ipkg, HasUnitId srcpkg) =>
HasUnitId
(GenericPlanPackage ipkg srcpkg) where
installedUnitId (PreExisting ipkg) = installedUnitId ipkg
installedUnitId (Configured spkg) = installedUnitId spkg
installedUnitId (Installed spkg) = installedUnitId spkg
instance (HasConfiguredId ipkg, HasConfiguredId srcpkg) =>
HasConfiguredId (GenericPlanPackage ipkg srcpkg) where
configuredId (PreExisting ipkg) = configuredId ipkg
configuredId (Configured pkg) = configuredId pkg
configuredId (Configured spkg) = configuredId spkg
configuredId (Installed spkg) = configuredId spkg
data GenericInstallPlan ipkg srcpkg = GenericInstallPlan {
planIndex :: !(PlanIndex ipkg srcpkg),
......@@ -255,6 +261,7 @@ showInstallPlan = showPlanIndex . planIndex
showPlanPackageTag :: GenericPlanPackage ipkg srcpkg -> String
showPlanPackageTag (PreExisting _) = "PreExisting"
showPlanPackageTag (Configured _) = "Configured"
showPlanPackageTag (Installed _) = "Installed"
-- | Build an installation plan from a valid set of resolved packages.
--
......@@ -509,17 +516,18 @@ ready plan =
!processing =
Processing
(Set.fromList [ nodeKey pkg | pkg <- readyPackages ])
(Set.fromList [ nodeKey pkg | PreExisting pkg <- toList plan ])
(Set.fromList [ nodeKey pkg | pkg <- toList plan, isInstalled pkg ])
Set.empty
readyPackages =
[ ReadyPackage pkg
| Configured pkg <- toList plan
, all isPreExisting (directDeps plan (nodeKey pkg))
, all isInstalled (directDeps plan (nodeKey pkg))
]
isPreExisting (PreExisting {}) = True
isPreExisting _ = False
isInstalled :: GenericPlanPackage a b -> Bool
isInstalled (PreExisting {}) = True
isInstalled (Installed {}) = True
isInstalled _ = False
-- | Given a package in the processing state, mark the package as completed
-- and return any packages that are newly in the processing state (ie ready to
......@@ -592,6 +600,7 @@ processingInvariant plan (Processing processingSet completedSet failedSet) =
&& and [ case Graph.lookup pkgid (planIndex plan) of
Just (Configured _) -> True
Just (PreExisting _) -> False
Just (Installed _) -> False
Nothing -> False
| pkgid <- Set.toList processingSet ++ Set.toList failedSet ]
where
......
......@@ -262,6 +262,9 @@ rebuildTargetsDryRun verbosity distDirLayout@DistDirLayout{..} shared = \install
dryRunPkg (InstallPlan.PreExisting _pkg) _depsBuildStatus =
return BuildStatusPreExisting
dryRunPkg (InstallPlan.Installed _pkg) _depsBuildStatus =
return BuildStatusPreExisting --TODO: distinguish installed state
dryRunPkg (InstallPlan.Configured pkg) depsBuildStatus = do
mloc <- checkFetched (elabPkgSourceLocation pkg)
case mloc of
......
......@@ -1221,6 +1221,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
case elabPkgOrComp elab of
ElabPackage _ -> True
ElabComponent comp -> compSolverName comp == CD.ComponentLib
is_lib (InstallPlan.Installed _) = unexpectedState
elaborateExeSolverId :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [ConfiguredId]
......@@ -1233,6 +1234,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
case compSolverName comp of
CD.ComponentExe _ -> True
_ -> False
is_exe (InstallPlan.Installed _) = unexpectedState
elaborateExePath :: (SolverId -> [ElaboratedPlanPackage])
-> SolverId -> [FilePath]
......@@ -1255,6 +1257,9 @@ elaborateInstallPlan platform compiler compilerprogdb pkgConfigDB
Just (Just n) -> n
_ -> ""
else InstallDirs.bindir (elabInstallDirs elab)]
get_exe_path (InstallPlan.Installed _) = unexpectedState
unexpectedState = error "elaborateInstallPlan: unexpected Installed state"
elaborateSolverToPackage :: (SolverId -> [ElaboratedPlanPackage])
-> SolverPackage UnresolvedPkgLoc
......@@ -1980,6 +1985,8 @@ mapConfiguredPackage :: (srcpkg -> srcpkg')
-> InstallPlan.GenericPlanPackage ipkg srcpkg'
mapConfiguredPackage f (InstallPlan.Configured pkg) =
InstallPlan.Configured (f pkg)
mapConfiguredPackage f (InstallPlan.Installed pkg) =
InstallPlan.Installed (f pkg)
mapConfiguredPackage _ (InstallPlan.PreExisting pkg) =
InstallPlan.PreExisting pkg
......
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