Commit f28cf318 authored by Duncan Coutts's avatar Duncan Coutts

Remove the old InstallPlan.ready

There were two uses other than excuteInstallPlan. The new ready impl can
be used in both these cases, allowing the old one to be removed.
parent 713af703
......@@ -138,7 +138,7 @@ configure verbosity packageDBs repoCtxt comp platform conf
Right installPlan0 ->
let installPlan = InstallPlan.configureInstallPlan installPlan0
in case InstallPlan.ready installPlan of
in case fst (InstallPlan.ready' installPlan) of
[pkg@(ReadyPackage
(ConfiguredPackage _ (SourcePackage _ _ (LocalUnpackedPackage _) _)
_ _ _))] -> do
......
......@@ -345,7 +345,7 @@ processInstallPlan verbosity
where
installPlan = InstallPlan.configureInstallPlan installPlan0
dryRun = fromFlag (installDryRun installFlags)
nothingToInstall = null (InstallPlan.ready installPlan)
nothingToInstall = null (fst (InstallPlan.ready' installPlan))
-- ------------------------------------------------------------
-- * Installation planning
......@@ -581,7 +581,7 @@ checkPrintPlan verbosity installed installPlan sourcePkgDb
++ "\nTry using 'cabal fetch'."
where
nothingToInstall = null (InstallPlan.ready installPlan)
nothingToInstall = null (fst (InstallPlan.ready' installPlan))
dryRun = fromFlag (installDryRun installFlags)
overrideReinstall = fromFlag (installOverrideReinstall installFlags)
......
......@@ -28,8 +28,6 @@ module Distribution.Client.InstallPlan (
fromSolverInstallPlan,
configureInstallPlan,
ready,
remove,
preexisting,
......@@ -70,7 +68,6 @@ import Distribution.Text
import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
import Distribution.Solver.Types.ComponentDeps (ComponentDeps)
import qualified Distribution.Solver.Types.ComponentDeps as CD
import Distribution.Solver.Types.PackageFixedDeps
import Distribution.Solver.Types.Settings
......@@ -94,7 +91,6 @@ import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.Traversable as T
-- When cabal tries to install a number of packages, including all their
......@@ -302,58 +298,6 @@ remove shouldRemove plan =
newIndex = Graph.fromList $
filter (not . shouldRemove) (toList plan)
-- | The packages that are ready to be installed. That is they are in the
-- configured state and have all their dependencies installed already.
-- The plan is complete if the result is @[]@.
--
ready :: forall ipkg srcpkg iresult ifailure.
(HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> [GenericReadyPackage srcpkg]
ready plan = assert check readyPackages
where
check = if null readyPackages && null processingPackages
then null configuredPackages
else True
configuredPackages = [ pkg | Configured pkg <- toList plan ]
processingPackages = [ pkg | Processing pkg <- toList plan]
readyPackages :: [GenericReadyPackage srcpkg]
readyPackages = catMaybes (map (lookupReadyPackage plan) configuredPackages)
lookupReadyPackage :: forall ipkg srcpkg iresult ifailure.
(HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> srcpkg
-> Maybe (GenericReadyPackage srcpkg)
lookupReadyPackage plan pkg = do
_ <- hasAllInstalledDeps pkg
return (ReadyPackage pkg)
where
hasAllInstalledDeps :: srcpkg -> Maybe (ComponentDeps [ipkg])
hasAllInstalledDeps = T.mapM (mapM isInstalledDep) . depends
isInstalledDep :: UnitId -> Maybe ipkg
isInstalledDep pkgid =
case Graph.lookup pkgid (planIndex plan) of
Just (PreExisting ipkg) -> Just ipkg
Just (Configured _) -> Nothing
Just (Processing _) -> Nothing
Just (Installed _ (Just ipkg) _) -> Just ipkg
Just (Installed _ Nothing _) -> internalError (depOnNonLib pkgid)
Just (Failed _ _) -> internalError depOnFailed
Nothing -> internalError incomplete
incomplete = "install plan is not closed"
depOnFailed = "configured package depends on failed package"
depOnNonLib dep = "the configured package "
++ display (packageId pkg)
++ " depends on a non-library package "
++ display dep
-- | Replace a ready package with a pre-existing one. The pre-existing one
-- must have exactly the same dependencies as the source one was configured
-- with.
......
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