diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs
index a4f20de32d50b494953b0a75bff2da5ad749049b..26e4b6e27266e97c5676af464934317bf29dcd7c 100644
--- a/cabal-install/Distribution/Client/BuildReports/Storage.hs
+++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs
@@ -36,6 +36,8 @@ import Distribution.Package
( PackageId, packageId )
import Distribution.PackageDescription
( FlagAssignment )
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo )
import Distribution.Simple.InstallDirs
( PathTemplate, fromPathTemplate
, initialPathTemplateEnv, substPathTemplate )
@@ -116,7 +118,10 @@ storeLocal cinfo templates reports platform = sequence_
-- * InstallPlan support
-- ------------------------------------------------------------
-fromInstallPlan :: InstallPlan -> [(BuildReport, Maybe Repo)]
+fromInstallPlan :: InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
+ -> [(BuildReport, Maybe Repo)]
fromInstallPlan plan = catMaybes
. map (fromPlanPackage platform comp)
. InstallPlan.toList
@@ -125,18 +130,23 @@ fromInstallPlan plan = catMaybes
comp = compilerInfoId (InstallPlan.planCompiler plan)
fromPlanPackage :: Platform -> CompilerId
- -> InstallPlan.PlanPackage
+ -> InstallPlan.PlanPackage InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
- InstallPlan.Installed (ReadyPackage srcPkg flags _ deps) result
+ InstallPlan.Installed (ReadyPackage (ConfiguredPackage srcPkg flags _ _) deps)
+ _ result
-> Just $ ( BuildReport.new os arch comp
- (packageId srcPkg) flags (map packageId (CD.nonSetupDeps deps))
+ (packageId srcPkg) flags
+ (map packageId (CD.nonSetupDeps deps))
(Right result)
, extractRepo srcPkg)
InstallPlan.Failed (ConfiguredPackage srcPkg flags _ deps) result
-> Just $ ( BuildReport.new os arch comp
- (packageId srcPkg) flags (map confSrcId (CD.nonSetupDeps deps))
+ (packageId srcPkg) flags
+ (map confSrcId (CD.nonSetupDeps deps))
(Left result)
, extractRepo srcPkg )
diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs
index b106cb5ee817683834aaf67f3f5cd7137b56a1b8..52557fbf3f2486afaaf58e38864487e8cd822fa2 100644
--- a/cabal-install/Distribution/Client/Configure.hs
+++ b/cabal-install/Distribution/Client/Configure.hs
@@ -42,6 +42,7 @@ import Distribution.Simple.Setup
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.Simple.Utils
( defaultPackageDesc )
+import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Package
( Package(..), InstalledPackageId, packageName
@@ -116,7 +117,10 @@ configure verbosity packageDBs repos comp platform conf
configureCommand (const configFlags) extraArgs
Right installPlan -> case InstallPlan.ready installPlan of
- [pkg@(ReadyPackage (SourcePackage _ _ (LocalUnpackedPackage _) _) _ _ _)] -> do
+ [pkg@(ReadyPackage
+ (ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _)
+ _ _ _)
+ _)] -> do
configurePackage verbosity
(InstallPlan.planPlatform installPlan)
(InstallPlan.planCompiler installPlan)
@@ -127,7 +131,10 @@ configure verbosity packageDBs repos comp platform conf
++ "one local ready package."
where
- setupScriptOptions :: InstalledPackageIndex -> Maybe ReadyPackage -> SetupScriptOptions
+ setupScriptOptions :: InstalledPackageIndex
+ -> Maybe (ReadyPackage ConfiguredPackage
+ InstalledPackageInfo)
+ -> SetupScriptOptions
setupScriptOptions =
configureSetupScript
packageDBs
@@ -154,7 +161,8 @@ configureSetupScript :: PackageDBStack
-> Maybe Lock
-> Bool
-> InstalledPackageIndex
- -> Maybe ReadyPackage
+ -> Maybe (ReadyPackage ConfiguredPackage
+ InstalledPackageInfo)
-> SetupScriptOptions
configureSetupScript packageDBs
comp
@@ -206,7 +214,8 @@ configureSetupScript packageDBs
explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)]
explicitSetupDeps = do
- ReadyPackage (SourcePackage _ gpkg _ _) _ _ deps <- mpkg
+ ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _) _ _ _) deps
+ <- mpkg
-- Check if there is an explicit setup stanza
_buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
-- Return the setup dependencies computed by the solver
@@ -224,7 +233,10 @@ planLocalPackage :: Verbosity -> Compiler
-> ConfigFlags -> ConfigExFlags
-> InstalledPackageIndex
-> SourcePackageDb
- -> IO (Progress String String InstallPlan)
+ -> IO (Progress String String
+ (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure))
planLocalPackage verbosity comp platform configFlags configExFlags installedPkgIndex
(SourcePackageDb _ packagePrefs) = do
pkg <- readPackageDescription verbosity =<< defaultPackageDesc verbosity
@@ -290,11 +302,14 @@ configurePackage :: Verbosity
-> Platform -> CompilerInfo
-> SetupScriptOptions
-> ConfigFlags
- -> ReadyPackage
+ -> ReadyPackage ConfiguredPackage InstalledPackageInfo
-> [String]
-> IO ()
configurePackage verbosity platform comp scriptOptions configFlags
- (ReadyPackage (SourcePackage _ gpkg _ _) flags stanzas deps) extraArgs =
+ (ReadyPackage (ConfiguredPackage (SourcePackage _ gpkg _ _)
+ flags stanzas _)
+ deps)
+ extraArgs =
setupWrapper verbosity
scriptOptions (Just pkg) configureCommand configureFlags extraArgs
diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs
index 6c431e5e395cccddbfeb05663cba9b2fc8185470..514e8fe869a433261d9bf2e1fd48931cb94f1113 100644
--- a/cabal-install/Distribution/Client/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency.hs
@@ -83,6 +83,8 @@ import Distribution.Client.Targets
import Distribution.Client.ComponentDeps (ComponentDeps)
import qualified Distribution.Client.ComponentDeps as CD
import qualified Distribution.InstalledPackageInfo as Installed
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo )
import Distribution.Package
( PackageName(..), PackageIdentifier(PackageIdentifier), PackageId
, Package(..), packageName, packageVersion
@@ -523,7 +525,10 @@ resolveDependencies :: Platform
-> CompilerInfo
-> Solver
-> DepResolverParams
- -> Progress String String InstallPlan
+ -> Progress String String
+ (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure)
--TODO: is this needed here? see dontUpgradeNonUpgradeablePackages
resolveDependencies platform comp _solver params
@@ -608,7 +613,9 @@ validateSolverResult :: Platform
-> CompilerInfo
-> Bool
-> [ResolverPackage]
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure
validateSolverResult platform comp indepGoals pkgs =
case planPackagesProblems platform comp pkgs of
[] -> case InstallPlan.new platform comp indepGoals index of
diff --git a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
index 01e2be67e716a0b24e3a57215f3c4cea728418a1..d0988c8e37badc89b5b19776e0c4c52ef99794a1 100644
--- a/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
+++ b/cabal-install/Distribution/Client/Dependency/TopDown/Types.hs
@@ -14,8 +14,7 @@
module Distribution.Client.Dependency.TopDown.Types where
import Distribution.Client.Types
- ( SourcePackage(..), ReadyPackage(..)
- , ConfiguredPackage(..)
+ ( SourcePackage(..), ConfiguredPackage(..)
, OptionalStanza, ConfiguredId(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
@@ -135,9 +134,6 @@ instance PackageSourceDeps InstalledPackageEx where
instance PackageSourceDeps ConfiguredPackage where
sourceDeps (ConfiguredPackage _ _ _ deps) = map confSrcId $ CD.nonSetupDeps deps
-instance PackageSourceDeps ReadyPackage where
- sourceDeps (ReadyPackage _ _ _ deps) = map packageId $ CD.nonSetupDeps deps
-
instance PackageSourceDeps InstalledPackage where
sourceDeps (InstalledPackage _ deps) = deps
diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs
index ecfe204667e51530958e51f5a8a3d9abb3277c4a..541e33d60baa082050705eb5ea27e56225888e9a 100644
--- a/cabal-install/Distribution/Client/Fetch.hs
+++ b/cabal-install/Distribution/Client/Fetch.hs
@@ -139,7 +139,7 @@ planPackages verbosity comp platform fetchFlags
-- that are in the 'InstallPlan.Configured' state.
return
[ pkg
- | (InstallPlan.Configured (InstallPlan.ConfiguredPackage pkg _ _ _))
+ | (InstallPlan.Configured (ConfiguredPackage pkg _ _ _))
<- InstallPlan.toList installPlan ]
| otherwise =
diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs
index f38512dbd59c618e76727e4c97a4c9fe15b51ca8..d75a2c07c44f5b95c3e92179ef487cf016592755 100644
--- a/cabal-install/Distribution/Client/Freeze.hs
+++ b/cabal-install/Distribution/Client/Freeze.hs
@@ -23,7 +23,7 @@ import Distribution.Client.Dependency
import Distribution.Client.IndexUtils as IndexUtils
( getSourcePackages, getInstalledPackages )
import Distribution.Client.InstallPlan
- ( PlanPackage )
+ ( InstallPlan, PlanPackage )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.Setup
( GlobalFlags(..), FreezeFlags(..), ConfigExFlags(..) )
@@ -36,7 +36,10 @@ import Distribution.Client.Sandbox.Types
( SandboxPackageInfo(..) )
import Distribution.Package
- ( Package, packageId, packageName, packageVersion )
+ ( Package, packageId, packageName, packageVersion
+ , HasInstalledPackageId )
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo )
import Distribution.Simple.Compiler
( Compiler, compilerInfo, PackageDBStack )
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
@@ -130,7 +133,9 @@ planPackages :: Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier SourcePackage]
- -> IO [PlanPackage]
+ -> IO [PlanPackage InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure]
planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
installedPkgIndex sourcePkgDb pkgSpecifiers = do
@@ -193,9 +198,11 @@ planPackages verbosity comp platform mSandboxPkgInfo freezeFlags
-- 2) not a dependency (directly or transitively) of the package we are
-- freezing. This is useful for removing previously installed packages
-- which are no longer required from the install plan.
-pruneInstallPlan :: InstallPlan.InstallPlan
+pruneInstallPlan :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => InstallPlan ipkg srcpkg iresult ifailure
-> [PackageSpecifier SourcePackage]
- -> [PlanPackage]
+ -> [PlanPackage ipkg srcpkg iresult ifailure]
pruneInstallPlan installPlan pkgSpecifiers =
either (const brokenPkgsErr)
(removeSelf pkgIds . PackageIndex.allPackages) $
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index 68fa7303ad576d1d214b79b09cc07005099fba1b..9942946b8c170800eb6996a43c1dbd5e039ed3b1 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -136,13 +136,17 @@ import Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Package
( PackageIdentifier(..), PackageId, packageName, packageVersion
, Package(..), LibraryName
- , Dependency(..), thisPackageVersion, InstalledPackageId, installedPackageId )
+ , Dependency(..), thisPackageVersion
+ , InstalledPackageId, installedPackageId
+ , HasInstalledPackageId(..) )
import qualified Distribution.PackageDescription as PackageDescription
import Distribution.PackageDescription
( PackageDescription, GenericPackageDescription(..), Flag(..)
, FlagName(..), FlagAssignment )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo )
import Distribution.ParseUtils
( showPWarning )
import Distribution.Version
@@ -279,7 +283,10 @@ makeInstallContext verbosity
-- | Make an install plan given install context and install arguments.
makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
- -> IO (Progress String String InstallPlan)
+ -> IO (Progress String String
+ (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure))
makeInstallPlan verbosity
(_, _, comp, platform, _, _, mSandboxPkgInfo,
_, configFlags, configExFlags, installFlags,
@@ -296,13 +303,15 @@ makeInstallPlan verbosity
-- | Given an install plan, perform the actual installations.
processInstallPlan :: Verbosity -> InstallArgs -> InstallContext
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
-> IO ()
processInstallPlan verbosity
- args@(_,_, comp, _, _, _, _, _, _, _, installFlags, _)
+ args@(_,_, _, _, _, _, _, _, _, _, installFlags, _)
(installedPkgIndex, sourcePkgDb,
userTargets, pkgSpecifiers, _) installPlan = do
- checkPrintPlan verbosity comp installedPkgIndex installPlan sourcePkgDb
+ checkPrintPlan verbosity installedPkgIndex installPlan sourcePkgDb
installFlags pkgSpecifiers
unless (dryRun || nothingToInstall) $ do
@@ -327,7 +336,10 @@ planPackages :: Compiler
-> InstalledPackageIndex
-> SourcePackageDb
-> [PackageSpecifier SourcePackage]
- -> Progress String String InstallPlan
+ -> Progress String String
+ (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure)
planPackages comp platform mSandboxPkgInfo solver
configFlags configExFlags installFlags
installedPkgIndex sourcePkgDb pkgSpecifiers =
@@ -407,8 +419,13 @@ planPackages comp platform mSandboxPkgInfo solver
allowNewer = fromFlag (configAllowNewer configExFlags)
-- | Remove the provided targets from the install plan.
-pruneInstallPlan :: Package pkg => [PackageSpecifier pkg] -> InstallPlan
- -> Progress String String InstallPlan
+pruneInstallPlan :: (Package targetpkg, Package srcpkg, Package ipkg,
+ PackageFixedDeps srcpkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, HasInstalledPackageId ipkg)
+ => [PackageSpecifier targetpkg]
+ -> InstallPlan ipkg srcpkg iresult ifailure
+ -> Progress String String
+ (InstallPlan ipkg srcpkg iresult ifailure)
pruneInstallPlan pkgSpecifiers =
-- TODO: this is a general feature and should be moved to D.C.Dependency
-- Also, the InstallPlan.remove should return info more precise to the
@@ -416,7 +433,7 @@ pruneInstallPlan pkgSpecifiers =
either (Fail . explain) Done
. InstallPlan.remove (\pkg -> packageName pkg `elem` targetnames)
where
- explain :: [InstallPlan.PlanProblem] -> String
+ explain :: [InstallPlan.PlanProblem ipkg srcpkg iresult ifailure] -> String
explain problems =
"Cannot select only the dependencies (as requested by the "
++ "'--only-dependencies' flag), "
@@ -441,14 +458,15 @@ pruneInstallPlan pkgSpecifiers =
-- | Perform post-solver checks of the install plan and print it if
-- either requested or needed.
checkPrintPlan :: Verbosity
- -> Compiler
-> InstalledPackageIndex
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess ifailure
-> SourcePackageDb
-> InstallFlags
-> [PackageSpecifier SourcePackage]
-> IO ()
-checkPrintPlan verbosity comp installed installPlan sourcePkgDb
+checkPrintPlan verbosity installed installPlan sourcePkgDb
installFlags pkgSpecifiers = do
-- User targets that are already installed.
@@ -465,7 +483,7 @@ checkPrintPlan verbosity comp installed installPlan sourcePkgDb
: map (display . packageId) preExistingTargets
++ ["Use --reinstall if you want to reinstall anyway."]
- let lPlan = linearizeInstallPlan comp installed installPlan
+ let lPlan = linearizeInstallPlan installed installPlan
-- Are any packages classified as reinstalls?
let reinstalledPkgs = concatMap (extractReinstalls . snd) lPlan
-- Packages that are already broken.
@@ -533,11 +551,13 @@ checkPrintPlan verbosity comp installed installPlan sourcePkgDb
dryRun = fromFlag (installDryRun installFlags)
overrideReinstall = fromFlag (installOverrideReinstall installFlags)
-linearizeInstallPlan :: Compiler
- -> InstalledPackageIndex
- -> InstallPlan
- -> [(ReadyPackage, PackageStatus)]
-linearizeInstallPlan comp installedPkgIndex plan =
+--TODO: this type is too specific
+linearizeInstallPlan :: (PackageFixedDeps srcpkg, HasInstalledPackageId srcpkg)
+ => InstalledPackageIndex
+ -> InstallPlan InstalledPackageInfo srcpkg
+ BuildSuccess ifailure
+ -> [(ReadyPackage srcpkg InstalledPackageInfo, PackageStatus)]
+linearizeInstallPlan installedPkgIndex plan =
unfoldr next plan
where
next plan' = case InstallPlan.ready plan' of
@@ -545,12 +565,13 @@ linearizeInstallPlan comp installedPkgIndex plan =
(pkg:_) -> Just ((pkg, status), plan'')
where
pkgid = installedPackageId pkg
- status = packageStatus comp installedPkgIndex pkg
- plan'' = InstallPlan.completed pkgid
- (BuildOk DocsNotTried TestsNotTried
- (Just $ Installed.emptyInstalledPackageInfo
- { Installed.sourcePackageId = packageId pkg
- , Installed.installedPackageId = pkgid }))
+ status = packageStatus installedPkgIndex pkg
+ ipkg = Installed.emptyInstalledPackageInfo {
+ Installed.sourcePackageId = packageId pkg,
+ Installed.installedPackageId = pkgid
+ }
+ plan'' = InstallPlan.completed pkgid (Just ipkg)
+ (BuildOk DocsNotTried TestsNotTried (Just ipkg))
(InstallPlan.processing [pkg] plan')
--FIXME: This is a bit of a hack,
-- pretending that each package is installed
@@ -567,8 +588,11 @@ extractReinstalls :: PackageStatus -> [InstalledPackageId]
extractReinstalls (Reinstall ipids _) = ipids
extractReinstalls _ = []
-packageStatus :: Compiler -> InstalledPackageIndex -> ReadyPackage -> PackageStatus
-packageStatus _comp installedPkgIndex cpkg =
+packageStatus :: (Package srcpkg, HasInstalledPackageId ipkg)
+ => InstalledPackageIndex
+ -> ReadyPackage srcpkg ipkg
+ -> PackageStatus
+packageStatus installedPkgIndex cpkg =
case PackageIndex.lookupPackageName installedPkgIndex
(packageName cpkg) of
[] -> NewPackage
@@ -580,8 +604,9 @@ packageStatus _comp installedPkgIndex cpkg =
where
- changes :: Installed.InstalledPackageInfo
- -> ReadyPackage
+ changes :: (Package srcpkg, HasInstalledPackageId ipkg)
+ => Installed.InstalledPackageInfo
+ -> ReadyPackage srcpkg ipkg
-> [MergeResult PackageIdentifier PackageIdentifier]
changes pkg pkg' = filter changed $
mergeBy (comparing packageName)
@@ -602,7 +627,7 @@ packageStatus _comp installedPkgIndex cpkg =
printPlan :: Bool -- is dry run
-> Verbosity
- -> [(ReadyPackage, PackageStatus)]
+ -> [(ReadyPackage ConfiguredPackage ipkg, PackageStatus)]
-> SourcePackageDb
-> IO ()
printPlan dryRun verbosity plan sourcePkgDb = case plan of
@@ -622,7 +647,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
showPkg (pkg, _) = display (packageId pkg) ++
showLatest (pkg)
- showPkgAndReason (pkg', pr) = display (packageId pkg') ++
+ showPkgAndReason (ReadyPackage pkg' _, pr) = display (packageId pkg') ++
showLatest pkg' ++
showFlagAssignment (nonDefaultFlags pkg') ++
showStanzas (stanzas pkg') ++ " " ++
@@ -633,7 +658,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
[] -> ""
diff -> " changes: " ++ intercalate ", " (map change diff)
- showLatest :: ReadyPackage -> String
+ showLatest :: Package srcpkg => srcpkg -> String
showLatest pkg = case mLatestVersion of
Just latestVersion ->
if packageVersion pkg < latestVersion
@@ -651,15 +676,15 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
toFlagAssignment :: [Flag] -> FlagAssignment
toFlagAssignment = map (\ f -> (flagName f, flagDefault f))
- nonDefaultFlags :: ReadyPackage -> FlagAssignment
- nonDefaultFlags (ReadyPackage spkg fa _ _) =
+ nonDefaultFlags :: ConfiguredPackage -> FlagAssignment
+ nonDefaultFlags (ConfiguredPackage spkg fa _ _) =
let defaultAssignment =
toFlagAssignment
(genPackageFlags (Source.packageDescription spkg))
in fa \\ defaultAssignment
- stanzas :: ReadyPackage -> [OptionalStanza]
- stanzas (ReadyPackage _ _ sts _) = sts
+ stanzas :: ConfiguredPackage -> [OptionalStanza]
+ stanzas (ConfiguredPackage _ _ sts _) = sts
showStanzas :: [OptionalStanza] -> String
showStanzas = concatMap ((' ' :) . showStanza)
@@ -759,7 +784,9 @@ theSpecifiedPackage pkgSpec =
postInstallActions :: Verbosity
-> InstallArgs
-> [UserTarget]
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
-> IO ()
postInstallActions verbosity
(packageDBs, _, comp, platform, conf, useSandbox, mSandboxPkgInfo
@@ -837,7 +864,7 @@ regenerateHaddockIndex :: Verbosity
-> UseSandbox
-> ConfigFlags
-> InstallFlags
- -> InstallPlan
+ -> InstallPlan ipkg srcpkg BuildSuccess ifailure
-> IO ()
regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
configFlags installFlags installPlan
@@ -874,8 +901,8 @@ regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
normalUserInstall = (UserPackageDB `elem` packageDBs)
&& all (not . isSpecificPackageDB) packageDBs
- installedDocs (InstallPlan.Installed _ (BuildOk DocsOk _ _)) = True
- installedDocs _ = False
+ installedDocs (InstallPlan.Installed _ _ (BuildOk DocsOk _ _)) = True
+ installedDocs _ = False
isSpecificPackageDB (SpecificPackageDB _) = True
isSpecificPackageDB _ = False
@@ -896,7 +923,10 @@ symlinkBinaries :: Verbosity
-> Compiler
-> ConfigFlags
-> InstallFlags
- -> InstallPlan -> IO ()
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure
+ -> IO ()
symlinkBinaries verbosity comp configFlags installFlags plan = do
failed <- InstallSymlink.symlinkBinaries comp configFlags installFlags plan
case failed of
@@ -920,7 +950,9 @@ symlinkBinaries verbosity comp configFlags installFlags plan = do
bindir = fromFlag (installSymlinkBinDir installFlags)
-printBuildFailures :: InstallPlan -> IO ()
+printBuildFailures :: Package srcpkg
+ => InstallPlan ipkg srcpkg iresult BuildFailure
+ -> IO ()
printBuildFailures plan =
case [ (pkg, reason)
| InstallPlan.Failed pkg reason <- InstallPlan.toList plan ] of
@@ -964,15 +996,18 @@ printBuildFailures plan =
-- | If we're working inside a sandbox and some add-source deps were installed,
-- update the timestamps of those deps.
updateSandboxTimestampsFile :: UseSandbox -> Maybe SandboxPackageInfo
- -> Compiler -> Platform -> InstallPlan
+ -> Compiler -> Platform
+ -> InstallPlan ipkg ConfiguredPackage
+ iresult ifailure
-> IO ()
updateSandboxTimestampsFile (UseSandbox sandboxDir)
(Just (SandboxPackageInfo _ _ _ allAddSourceDeps))
comp platform installPlan =
withUpdateTimestamps sandboxDir (compilerId comp) platform $ \_ -> do
- let allInstalled = [ pkg | InstallPlan.Installed pkg _
+ let allInstalled = [ pkg | InstallPlan.Installed pkg _ _
<- InstallPlan.toList installPlan ]
- allSrcPkgs = [ pkg | ReadyPackage pkg _ _ _ <- allInstalled ]
+ allSrcPkgs = [ pkg | ReadyPackage (ConfiguredPackage pkg _ _ _) _
+ <- allInstalled ]
allPaths = [ pth | LocalUnpackedPackage pth
<- map packageSource allSrcPkgs]
allPathsCanonical <- mapM tryCanonicalizePath allPaths
@@ -996,8 +1031,12 @@ type UseLogFile = Maybe (PackageIdentifier -> LibraryName -> FilePath, Verbosity
performInstallations :: Verbosity
-> InstallArgs
-> InstalledPackageIndex
- -> InstallPlan
- -> IO InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
+ -> IO (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure)
performInstallations verbosity
(packageDBs, _, comp, _, conf, useSandbox, _,
globalFlags, configFlags, configExFlags, installFlags, haddockFlags)
@@ -1115,9 +1154,15 @@ executeInstallPlan :: Verbosity
-> Compiler
-> JobControl IO (PackageId, LibraryName, BuildResult)
-> UseLogFile
- -> InstallPlan
- -> (ReadyPackage -> IO BuildResult)
- -> IO InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure
+ -> (ReadyPackage ConfiguredPackage
+ InstalledPackageInfo
+ -> IO BuildResult)
+ -> IO (InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ BuildSuccess BuildFailure)
executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
tryNewTasks 0 plan0
where
@@ -1147,12 +1192,18 @@ executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
plan' = updatePlan pkgid buildResult plan
tryNewTasks taskCount' plan'
- updatePlan :: PackageIdentifier -> BuildResult -> InstallPlan -> InstallPlan
- updatePlan pkgid (Right buildSuccess) =
- InstallPlan.completed (Source.fakeInstalledPackageId pkgid) buildSuccess
+ updatePlan :: PackageIdentifier -> BuildResult
+ -> InstallPlan InstalledPackageInfo ConfiguredPackage
+ BuildSuccess BuildFailure
+ -> InstallPlan InstalledPackageInfo ConfiguredPackage
+ BuildSuccess BuildFailure
+ updatePlan pkgid (Right buildSuccess@(BuildOk _ _ mipkg)) =
+ InstallPlan.completed (Source.fakeInstalledPackageId pkgid)
+ mipkg buildSuccess
updatePlan pkgid (Left buildFailure) =
- InstallPlan.failed (Source.fakeInstalledPackageId pkgid) buildFailure depsFailure
+ InstallPlan.failed (Source.fakeInstalledPackageId pkgid)
+ buildFailure depsFailure
where
depsFailure = DependentFailed pkgid
-- So this first pkgid failed for whatever reason (buildFailure).
@@ -1187,16 +1238,21 @@ executeInstallPlan verbosity comp jobCtl useLogFile plan0 installPkg =
-- NB: when updating this function, don't forget to also update
-- 'configurePackage' in D.C.Configure.
installReadyPackage :: Platform -> CompilerInfo
- -> ConfigFlags
- -> ReadyPackage
- -> (ConfigFlags -> PackageLocation (Maybe FilePath)
- -> PackageDescription
- -> PackageDescriptionOverride -> a)
- -> a
+ -> ConfigFlags
+ -> ReadyPackage ConfiguredPackage
+ InstalledPackageInfo
+ -> (ConfigFlags -> PackageLocation (Maybe FilePath)
+ -> PackageDescription
+ -> PackageDescriptionOverride
+ -> a)
+ -> a
installReadyPackage platform cinfo configFlags
- (ReadyPackage (SourcePackage _ gpkg source pkgoverride)
- flags stanzas deps)
- installPkg = installPkg configFlags {
+ (ReadyPackage (ConfiguredPackage
+ (SourcePackage _ gpkg source pkgoverride)
+ flags stanzas _)
+ deps)
+ installPkg =
+ installPkg configFlags {
configConfigurationsFlags = flags,
-- We generate the legacy constraints as well as the new style precise deps.
-- In the end only one set gets passed to Setup.hs configure, depending on
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index 0822ee5a39c47f30d5f21de4c30959c403b74fd4..1f6617329fd6958ff840490b9e6172341fedf2fc 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
-- Module : Distribution.Client.InstallPlan
@@ -13,7 +14,6 @@
-----------------------------------------------------------------------------
module Distribution.Client.InstallPlan (
InstallPlan,
- ConfiguredPackage(..),
PlanPackage(..),
-- * Operations on 'InstallPlan's
@@ -46,16 +46,11 @@ module Distribution.Client.InstallPlan (
dependencyClosure,
) where
-import Distribution.Client.Types
- ( ConfiguredPackage(..)
- , ReadyPackage(..), readyPackageToConfiguredPackage
- , BuildFailure, BuildSuccess(..)
- , PackageFixedDeps(..)
- , fakeInstalledPackageId
- )
import Distribution.Package
( PackageIdentifier(..), PackageName(..), Package(..)
, InstalledPackageId, HasInstalledPackageId(..) )
+import Distribution.Client.Types
+ ( PackageFixedDeps(..), ReadyPackage(..), fakeInstalledPackageId )
import Distribution.Version
( Version )
import Distribution.Client.ComponentDeps (ComponentDeps)
@@ -74,9 +69,6 @@ import Distribution.Compiler
( CompilerInfo(..) )
import Distribution.Simple.Utils
( intercalate )
-import Distribution.InstalledPackageInfo
- ( InstalledPackageInfo )
-import qualified Distribution.InstalledPackageInfo as Installed
import Data.Maybe
( fromMaybe, maybeToList )
@@ -88,7 +80,6 @@ import Data.Maybe (catMaybes)
import qualified Data.Map as Map
import qualified Data.Traversable as T
-type PlanIndex = PackageIndex PlanPackage
-- When cabal tries to install a number of packages, including all their
-- dependencies it has a non-trivial problem to solve.
@@ -143,50 +134,59 @@ type PlanIndex = PackageIndex PlanPackage
-- 'PackageInstalled' instance it would be too easy to get this wrong (and,
-- for instance, call graph traversal functions from Cabal rather than from
-- cabal-install). Instead, see 'PackageFixedDeps'.
-data PlanPackage = PreExisting InstalledPackageInfo
- | Configured ConfiguredPackage
- | Processing ReadyPackage
- | Installed ReadyPackage BuildSuccess
- | Failed ConfiguredPackage BuildFailure
- -- ^ NB: packages in the Failed state can be *either* Ready
- -- or Configured.
-
-instance Package PlanPackage where
- packageId (PreExisting pkg) = packageId pkg
- packageId (Configured pkg) = packageId pkg
- packageId (Processing pkg) = packageId pkg
- packageId (Installed pkg _) = packageId pkg
- packageId (Failed pkg _) = packageId pkg
-
-instance PackageFixedDeps PlanPackage where
- depends (PreExisting pkg) = depends pkg
- depends (Configured pkg) = depends pkg
- depends (Processing pkg) = depends pkg
- depends (Installed pkg _) = depends pkg
- depends (Failed pkg _) = depends pkg
-
-instance HasInstalledPackageId PlanPackage where
- installedPackageId (PreExisting pkg) = installedPackageId pkg
- installedPackageId (Configured pkg) = installedPackageId pkg
- installedPackageId (Processing pkg) = installedPackageId pkg
+data PlanPackage ipkg srcpkg iresult ifailure
+ = PreExisting ipkg
+ | Configured srcpkg
+ | Processing (ReadyPackage srcpkg ipkg)
+ | Installed (ReadyPackage srcpkg ipkg) (Maybe ipkg) iresult
+ | Failed srcpkg ifailure
+
+instance (Package ipkg, Package srcpkg) =>
+ Package (PlanPackage ipkg srcpkg iresult ifailure) where
+ packageId (PreExisting ipkg) = packageId ipkg
+ packageId (Configured spkg) = packageId spkg
+ packageId (Processing rpkg) = packageId rpkg
+ packageId (Installed rpkg _ _) = packageId rpkg
+ packageId (Failed spkg _) = packageId spkg
+
+instance (PackageFixedDeps srcpkg,
+ PackageFixedDeps ipkg, HasInstalledPackageId ipkg) =>
+ PackageFixedDeps (PlanPackage ipkg srcpkg iresult ifailure) where
+ depends (PreExisting pkg) = depends pkg
+ depends (Configured pkg) = depends pkg
+ depends (Processing pkg) = depends pkg
+ depends (Installed pkg _ _) = depends pkg
+ depends (Failed pkg _) = depends pkg
+
+instance (HasInstalledPackageId ipkg, HasInstalledPackageId srcpkg) =>
+ HasInstalledPackageId (PlanPackage ipkg srcpkg iresult ifailure) where
+ installedPackageId (PreExisting ipkg ) = installedPackageId ipkg
+ installedPackageId (Configured spkg) = installedPackageId spkg
+ installedPackageId (Processing rpkg) = installedPackageId rpkg
-- NB: defer to the actual installed package info in this case
- installedPackageId (Installed _ (BuildOk _ _ (Just ipkg))) = installedPackageId ipkg
- installedPackageId (Installed pkg _) = installedPackageId pkg
- installedPackageId (Failed pkg _) = installedPackageId pkg
+ installedPackageId (Installed _ (Just ipkg) _) = installedPackageId ipkg
+ installedPackageId (Installed rpkg _ _) = installedPackageId rpkg
+ installedPackageId (Failed spkg _) = installedPackageId spkg
-data InstallPlan = InstallPlan {
- planIndex :: PlanIndex,
+
+data InstallPlan ipkg srcpkg iresult ifailure = InstallPlan {
+ planIndex :: (PlanIndex ipkg srcpkg iresult ifailure),
planFakeMap :: FakeMap,
planGraph :: Graph,
planGraphRev :: Graph,
- planPkgOf :: Graph.Vertex -> PlanPackage,
+ planPkgOf :: Graph.Vertex -> PlanPackage ipkg srcpkg iresult ifailure,
planVertexOf :: InstalledPackageId -> Graph.Vertex,
planPlatform :: Platform,
planCompiler :: CompilerInfo,
planIndepGoals :: Bool
}
-invariant :: InstallPlan -> Bool
+type PlanIndex ipkg srcpkg iresult ifailure =
+ PackageIndex (PlanPackage ipkg srcpkg iresult ifailure)
+
+invariant :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => InstallPlan ipkg srcpkg iresult ifailure -> Bool
invariant plan =
valid (planFakeMap plan)
(planIndepGoals plan)
@@ -195,7 +195,8 @@ invariant plan =
internalError :: String -> a
internalError msg = error $ "InstallPlan: internal error: " ++ msg
-showPlanIndex :: PlanIndex -> String
+showPlanIndex :: (HasInstalledPackageId ipkg, HasInstalledPackageId srcpkg)
+ => PlanIndex ipkg srcpkg iresult ifailure -> String
showPlanIndex index =
intercalate "\n" (map showPlanPackage (PackageIndex.allPackages index))
where showPlanPackage p =
@@ -203,23 +204,28 @@ showPlanIndex index =
++ display (packageId p) ++ " ("
++ display (installedPackageId p) ++ ")"
-showInstallPlan :: InstallPlan -> String
+showInstallPlan :: (HasInstalledPackageId ipkg, HasInstalledPackageId srcpkg)
+ => InstallPlan ipkg srcpkg iresult ifailure -> String
showInstallPlan plan =
showPlanIndex (planIndex plan) ++ "\n" ++
"fake map:\n " ++ intercalate "\n " (map showKV (Map.toList (planFakeMap plan)))
where showKV (k,v) = display k ++ " -> " ++ display v
-showPlanPackageTag :: PlanPackage -> String
-showPlanPackageTag (PreExisting _) = "PreExisting"
-showPlanPackageTag (Configured _) = "Configured"
-showPlanPackageTag (Processing _) = "Processing"
-showPlanPackageTag (Installed _ _) = "Installed"
-showPlanPackageTag (Failed _ _) = "Failed"
+showPlanPackageTag :: PlanPackage ipkg srcpkg iresult ifailure -> String
+showPlanPackageTag (PreExisting _) = "PreExisting"
+showPlanPackageTag (Configured _) = "Configured"
+showPlanPackageTag (Processing _) = "Processing"
+showPlanPackageTag (Installed _ _ _) = "Installed"
+showPlanPackageTag (Failed _ _) = "Failed"
-- | Build an installation plan from a valid set of resolved packages.
--
-new :: Platform -> CompilerInfo -> Bool -> PlanIndex
- -> Either [PlanProblem] InstallPlan
+new :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => Platform -> CompilerInfo -> Bool
+ -> PlanIndex ipkg srcpkg iresult ifailure
+ -> Either [PlanProblem ipkg srcpkg iresult ifailure]
+ (InstallPlan ipkg srcpkg iresult ifailure)
new platform cinfo indepGoals index =
-- NB: Need to pre-initialize the fake-map with pre-existing
-- packages
@@ -246,7 +252,8 @@ new platform cinfo indepGoals index =
noSuchPkgId = internalError "package is not in the graph"
probs -> Left probs
-toList :: InstallPlan -> [PlanPackage]
+toList :: InstallPlan ipkg srcpkg iresult ifailure
+ -> [PlanPackage ipkg srcpkg iresult ifailure]
toList = PackageIndex.allPackages . planIndex
-- | Remove packages from the install plan. This will result in an
@@ -255,9 +262,12 @@ toList = PackageIndex.allPackages . planIndex
-- the dependencies of a package or set of packages without actually
-- installing the package itself, as when doing development.
--
-remove :: (PlanPackage -> Bool)
- -> InstallPlan
- -> Either [PlanProblem] InstallPlan
+remove :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => (PlanPackage ipkg srcpkg iresult ifailure -> Bool)
+ -> InstallPlan ipkg srcpkg iresult ifailure
+ -> Either [PlanProblem ipkg srcpkg iresult ifailure]
+ (InstallPlan ipkg srcpkg iresult ifailure)
remove shouldRemove plan =
new (planPlatform plan) (planCompiler plan) (planIndepGoals plan) newIndex
where
@@ -268,7 +278,9 @@ remove shouldRemove plan =
-- configured state and have all their dependencies installed already.
-- The plan is complete if the result is @[]@.
--
-ready :: InstallPlan -> [ReadyPackage]
+ready :: forall ipkg srcpkg iresult ifailure. PackageFixedDeps srcpkg
+ => InstallPlan ipkg srcpkg iresult ifailure
+ -> [ReadyPackage srcpkg ipkg]
ready plan = assert check readyPackages
where
check = if null readyPackages && null processingPackages
@@ -277,29 +289,29 @@ ready plan = assert check readyPackages
configuredPackages = [ pkg | Configured pkg <- toList plan ]
processingPackages = [ pkg | Processing pkg <- toList plan]
- readyPackages :: [ReadyPackage]
+ readyPackages :: [ReadyPackage srcpkg ipkg]
readyPackages =
- [ ReadyPackage srcPkg flags stanzas deps
- | pkg@(ConfiguredPackage srcPkg flags stanzas _) <- configuredPackages
+ [ ReadyPackage srcpkg deps
+ | srcpkg <- configuredPackages
-- select only the package that have all of their deps installed:
- , deps <- maybeToList (hasAllInstalledDeps pkg)
+ , deps <- maybeToList (hasAllInstalledDeps srcpkg)
]
- hasAllInstalledDeps :: ConfiguredPackage -> Maybe (ComponentDeps [Installed.InstalledPackageInfo])
+ hasAllInstalledDeps :: srcpkg -> Maybe (ComponentDeps [ipkg])
hasAllInstalledDeps = T.mapM (mapM isInstalledDep) . depends
- isInstalledDep :: InstalledPackageId -> Maybe Installed.InstalledPackageInfo
+ isInstalledDep :: InstalledPackageId -> Maybe ipkg
isInstalledDep pkgid =
-- NB: Need to check if the ID has been updated in planFakeMap, in which case we
-- might be dealing with an old pointer
case PlanIndex.fakeLookupInstalledPackageId (planFakeMap plan) (planIndex plan) pkgid of
- Just (Configured _) -> Nothing
- Just (Processing _) -> Nothing
- Just (Failed _ _) -> internalError depOnFailed
- Just (PreExisting instPkg) -> Just instPkg
- Just (Installed _ (BuildOk _ _ (Just instPkg))) -> Just instPkg
- Just (Installed _ (BuildOk _ _ Nothing)) -> internalError depOnNonLib
- Nothing -> internalError incomplete
+ Just (PreExisting ipkg) -> Just ipkg
+ Just (Configured _) -> Nothing
+ Just (Processing _) -> Nothing
+ Just (Installed _ (Just ipkg) _) -> Just ipkg
+ Just (Installed _ Nothing _) -> internalError depOnNonLib
+ Just (Failed _ _) -> internalError depOnFailed
+ Nothing -> internalError incomplete
incomplete = "install plan is not closed"
depOnFailed = "configured package depends on failed package"
depOnNonLib = "configured package depends on a non-library package"
@@ -308,7 +320,11 @@ ready plan = assert check readyPackages
--
-- * The package must exist in the graph and be in the configured state.
--
-processing :: [ReadyPackage] -> InstallPlan -> InstallPlan
+processing :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => [ReadyPackage srcpkg ipkg]
+ -> InstallPlan ipkg srcpkg iresult ifailure
+ -> InstallPlan ipkg srcpkg iresult ifailure
processing pkgs plan = assert (invariant plan') plan'
where
plan' = plan {
@@ -322,15 +338,18 @@ processing pkgs plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the processing state.
-- * The package must have had no uninstalled dependent packages.
--
-completed :: InstalledPackageId
- -> BuildSuccess
- -> InstallPlan -> InstallPlan
-completed pkgid buildResult plan = assert (invariant plan') plan'
+completed :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => InstalledPackageId
+ -> Maybe ipkg -> iresult
+ -> InstallPlan ipkg srcpkg iresult ifailure
+ -> InstallPlan ipkg srcpkg iresult ifailure
+completed pkgid mipkg buildResult plan = assert (invariant plan') plan'
where
plan' = plan {
-- NB: installation can change the IPID, so better
-- record it in the fake mapping...
- planFakeMap = insert_fake_mapping buildResult
+ planFakeMap = insert_fake_mapping mipkg
$ planFakeMap plan,
planIndex = PackageIndex.insert installed
. PackageIndex.deleteInstalledPackageId pkgid
@@ -338,9 +357,9 @@ completed pkgid buildResult plan = assert (invariant plan') plan'
}
-- ...but be sure to use the *old* IPID for the lookup for the
-- preexisting record
- installed = Installed (lookupProcessingPackage plan pkgid) buildResult
- insert_fake_mapping (BuildOk _ _ (Just ipi)) = Map.insert pkgid (installedPackageId ipi)
- insert_fake_mapping _ = id
+ installed = Installed (lookupProcessingPackage plan pkgid) mipkg buildResult
+ insert_fake_mapping (Just ipkg) = Map.insert pkgid (installedPackageId ipkg)
+ insert_fake_mapping _ = id
-- | Marks a package in the graph as having failed. It also marks all the
-- packages that depended on it as having failed.
@@ -348,28 +367,31 @@ completed pkgid buildResult plan = assert (invariant plan') plan'
-- * The package must exist in the graph and be in the processing
-- state.
--
-failed :: InstalledPackageId -- ^ The id of the package that failed to install
- -> BuildFailure -- ^ The build result to use for the failed package
- -> BuildFailure -- ^ The build result to use for its dependencies
- -> InstallPlan
- -> InstallPlan
+failed :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => InstalledPackageId -- ^ The id of the package that failed to install
+ -> ifailure -- ^ The build result to use for the failed package
+ -> ifailure -- ^ The build result to use for its dependencies
+ -> InstallPlan ipkg srcpkg iresult ifailure
+ -> InstallPlan ipkg srcpkg iresult ifailure
failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
where
-- NB: failures don't update IPIDs
plan' = plan {
planIndex = PackageIndex.merge (planIndex plan) failures
}
- pkg = lookupProcessingPackage plan pkgid
+ ReadyPackage srcpkg _deps = lookupProcessingPackage plan pkgid
failures = PackageIndex.fromList
- $ Failed (readyPackageToConfiguredPackage pkg) buildResult
+ $ Failed srcpkg buildResult
: [ Failed pkg' buildResult'
| Just pkg' <- map checkConfiguredPackage
$ packagesThatDependOn plan pkgid ]
-- | Lookup the reachable packages in the reverse dependency graph.
--
-packagesThatDependOn :: InstallPlan
- -> InstalledPackageId -> [PlanPackage]
+packagesThatDependOn :: InstallPlan ipkg srcpkg iresult ifailure
+ -> InstalledPackageId
+ -> [PlanPackage ipkg srcpkg iresult ifailure]
packagesThatDependOn plan pkgid = map (planPkgOf plan)
. tail
. Graph.reachable (planGraphRev plan)
@@ -378,8 +400,9 @@ packagesThatDependOn plan pkgid = map (planPkgOf plan)
-- | Lookup a package that we expect to be in the processing state.
--
-lookupProcessingPackage :: InstallPlan
- -> InstalledPackageId -> ReadyPackage
+lookupProcessingPackage :: InstallPlan ipkg srcpkg iresult ifailure
+ -> InstalledPackageId
+ -> ReadyPackage srcpkg ipkg
lookupProcessingPackage plan pkgid =
-- NB: processing packages are guaranteed to not indirect through
-- planFakeMap
@@ -389,7 +412,9 @@ lookupProcessingPackage plan pkgid =
-- | Check a package that we expect to be in the configured or failed state.
--
-checkConfiguredPackage :: PlanPackage -> Maybe ConfiguredPackage
+checkConfiguredPackage :: (Package srcpkg, Package ipkg)
+ => PlanPackage ipkg srcpkg iresult ifailure
+ -> Maybe srcpkg
checkConfiguredPackage (Configured pkg) = Just pkg
checkConfiguredPackage (Failed _ _) = Nothing
checkConfiguredPackage pkg =
@@ -405,17 +430,24 @@ checkConfiguredPackage pkg =
--
-- * if the result is @False@ use 'problems' to get a detailed list.
--
-valid :: FakeMap -> Bool -> PlanIndex -> Bool
+valid :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => FakeMap -> Bool
+ -> PlanIndex ipkg srcpkg iresult ifailure
+ -> Bool
valid fakeMap indepGoals index =
null $ problems fakeMap indepGoals index
-data PlanProblem =
- PackageMissingDeps PlanPackage [PackageIdentifier]
- | PackageCycle [PlanPackage]
+data PlanProblem ipkg srcpkg iresult ifailure =
+ PackageMissingDeps (PlanPackage ipkg srcpkg iresult ifailure)
+ [PackageIdentifier]
+ | PackageCycle [PlanPackage ipkg srcpkg iresult ifailure]
| PackageInconsistency PackageName [(PackageIdentifier, Version)]
- | PackageStateInvalid PlanPackage PlanPackage
+ | PackageStateInvalid (PlanPackage ipkg srcpkg iresult ifailure)
+ (PlanPackage ipkg srcpkg iresult ifailure)
-showPlanProblem :: PlanProblem -> String
+showPlanProblem :: (Package ipkg, Package srcpkg)
+ => PlanProblem ipkg srcpkg iresult ifailure -> String
showPlanProblem (PackageMissingDeps pkg missingDeps) =
"Package " ++ display (packageId pkg)
++ " depends on the following packages which are missing from the plan: "
@@ -440,17 +472,21 @@ showPlanProblem (PackageStateInvalid pkg pkg') =
++ " which is in the " ++ showPlanState pkg'
++ " state"
where
- showPlanState (PreExisting _) = "pre-existing"
- showPlanState (Configured _) = "configured"
- showPlanState (Processing _) = "processing"
- showPlanState (Installed _ _) = "installed"
- showPlanState (Failed _ _) = "failed"
+ showPlanState (PreExisting _) = "pre-existing"
+ showPlanState (Configured _) = "configured"
+ showPlanState (Processing _) = "processing"
+ showPlanState (Installed _ _ _) = "installed"
+ showPlanState (Failed _ _) = "failed"
-- | For an invalid plan, produce a detailed list of problems as human readable
-- error messages. This is mainly intended for debugging purposes.
-- Use 'showPlanProblem' for a human readable explanation.
--
-problems :: FakeMap -> Bool -> PlanIndex -> [PlanProblem]
+problems :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => FakeMap -> Bool
+ -> PlanIndex ipkg srcpkg iresult ifailure
+ -> [PlanProblem ipkg srcpkg iresult ifailure]
problems fakeMap indepGoals index =
[ PackageMissingDeps pkg (catMaybes (map (fmap packageId . PlanIndex.fakeLookupInstalledPackageId fakeMap index) missingDeps))
@@ -472,7 +508,9 @@ problems fakeMap indepGoals index =
-- * if the result is @False@ use 'PackageIndex.dependencyCycles' to find out
-- which packages are involved in dependency cycles.
--
-acyclic :: FakeMap -> PlanIndex -> Bool
+acyclic :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => FakeMap -> PlanIndex ipkg srcpkg iresult ifailure -> Bool
acyclic fakeMap = null . PlanIndex.dependencyCycles fakeMap
-- | An installation plan is closed if for every package in the set, all of
@@ -482,7 +520,9 @@ acyclic fakeMap = null . PlanIndex.dependencyCycles fakeMap
-- * if the result is @False@ use 'PackageIndex.brokenPackages' to find out
-- which packages depend on packages not in the index.
--
-closed :: FakeMap -> PlanIndex -> Bool
+closed :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ PackageFixedDeps srcpkg)
+ => FakeMap -> PlanIndex ipkg srcpkg iresult ifailure -> Bool
closed fakeMap = null . PlanIndex.brokenPackages fakeMap
-- | An installation plan is consistent if all dependencies that target a
@@ -501,46 +541,52 @@ closed fakeMap = null . PlanIndex.brokenPackages fakeMap
-- * if the result is @False@ use 'PackageIndex.dependencyInconsistencies' to
-- find out which packages are.
--
-consistent :: FakeMap -> PlanIndex -> Bool
+consistent :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => FakeMap -> PlanIndex ipkg srcpkg iresult ifailure -> Bool
consistent fakeMap = null . PlanIndex.dependencyInconsistencies fakeMap False
-- | The states of packages have that depend on each other must respect
-- this relation. That is for very case where package @a@ depends on
-- package @b@ we require that @dependencyStatesOk a b = True@.
--
-stateDependencyRelation :: PlanPackage -> PlanPackage -> Bool
-stateDependencyRelation (PreExisting _) (PreExisting _) = True
+stateDependencyRelation :: PlanPackage ipkg srcpkg iresult ifailure
+ -> PlanPackage ipkg srcpkg iresult ifailure
+ -> Bool
+stateDependencyRelation (PreExisting _) (PreExisting _) = True
-stateDependencyRelation (Configured _) (PreExisting _) = True
-stateDependencyRelation (Configured _) (Configured _) = True
-stateDependencyRelation (Configured _) (Processing _) = True
-stateDependencyRelation (Configured _) (Installed _ _) = True
+stateDependencyRelation (Configured _) (PreExisting _) = True
+stateDependencyRelation (Configured _) (Configured _) = True
+stateDependencyRelation (Configured _) (Processing _) = True
+stateDependencyRelation (Configured _) (Installed _ _ _) = True
-stateDependencyRelation (Processing _) (PreExisting _) = True
-stateDependencyRelation (Processing _) (Installed _ _) = True
+stateDependencyRelation (Processing _) (PreExisting _) = True
+stateDependencyRelation (Processing _) (Installed _ _ _) = True
-stateDependencyRelation (Installed _ _) (PreExisting _) = True
-stateDependencyRelation (Installed _ _) (Installed _ _) = True
+stateDependencyRelation (Installed _ _ _) (PreExisting _) = True
+stateDependencyRelation (Installed _ _ _) (Installed _ _ _) = True
-stateDependencyRelation (Failed _ _) (PreExisting _) = True
+stateDependencyRelation (Failed _ _) (PreExisting _) = True
-- failed can depends on configured because a package can depend on
-- several other packages and if one of the deps fail then we fail
-- but we still depend on the other ones that did not fail:
-stateDependencyRelation (Failed _ _) (Configured _) = True
-stateDependencyRelation (Failed _ _) (Processing _) = True
-stateDependencyRelation (Failed _ _) (Installed _ _) = True
-stateDependencyRelation (Failed _ _) (Failed _ _) = True
+stateDependencyRelation (Failed _ _) (Configured _) = True
+stateDependencyRelation (Failed _ _) (Processing _) = True
+stateDependencyRelation (Failed _ _) (Installed _ _ _) = True
+stateDependencyRelation (Failed _ _) (Failed _ _) = True
-stateDependencyRelation _ _ = False
+stateDependencyRelation _ _ = False
-- | Compute the dependency closure of a _source_ package in a install plan
--
-- See `Distribution.Client.PlanIndex.dependencyClosure`
-dependencyClosure :: InstallPlan
+dependencyClosure :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
+ HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
+ => InstallPlan ipkg srcpkg iresult ifailure
-> [PackageIdentifier]
- -> Either [(PlanPackage, [InstalledPackageId])]
- (PackageIndex PlanPackage)
+ -> Either [(PlanPackage ipkg srcpkg iresult ifailure, [InstalledPackageId])]
+ (PackageIndex (PlanPackage ipkg srcpkg iresult ifailure))
dependencyClosure installPlan pids =
PlanIndex.dependencyClosure
(planFakeMap installPlan)
diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs
index 6a171986ea786bd3cc8a90eb9fca44cd5b4433c4..71309d1e305ae72bdcab8f8523e7329a32864e26 100644
--- a/cabal-install/Distribution/Client/InstallSymlink.hs
+++ b/cabal-install/Distribution/Client/InstallSymlink.hs
@@ -27,7 +27,9 @@ import Distribution.Simple.Compiler
symlinkBinaries :: Compiler
-> ConfigFlags
-> InstallFlags
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure
-> IO [(PackageIdentifier, String, FilePath)]
symlinkBinaries _ _ _ _ = return []
@@ -37,7 +39,8 @@ symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"
#else
import Distribution.Client.Types
- ( SourcePackage(..), ReadyPackage(..), enableStanzas )
+ ( SourcePackage(..), ReadyPackage(..), enableStanzas
+ , ConfiguredPackage(..) )
import Distribution.Client.Setup
( InstallFlags(installSymlinkBinDir) )
import qualified Distribution.Client.InstallPlan as InstallPlan
@@ -57,6 +60,8 @@ import Distribution.PackageDescription.Configuration
import Distribution.Simple.Setup
( ConfigFlags(..), fromFlag, fromFlagOrDefault, flagToMaybe )
import qualified Distribution.Simple.InstallDirs as InstallDirs
+import Distribution.InstalledPackageInfo
+ ( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Simple.Compiler
( Compiler, CompilerInfo(..), packageKeySupported )
@@ -101,7 +106,9 @@ import Data.Maybe
symlinkBinaries :: Compiler
-> ConfigFlags
-> InstallFlags
- -> InstallPlan
+ -> InstallPlan InstalledPackageInfo
+ ConfiguredPackage
+ iresult ifailure
-> IO [(PackageIdentifier, String, FilePath)]
symlinkBinaries comp configFlags installFlags plan =
case flagToMaybe (installSymlinkBinDir installFlags) of
@@ -121,7 +128,7 @@ symlinkBinaries comp configFlags installFlags plan =
then return Nothing
else return (Just (pkgid, publicExeName,
privateBinDir </> privateExeName))
- | (ReadyPackage _ _flags _ deps, pkg, exe) <- exes
+ | (ReadyPackage (ConfiguredPackage _ _flags _ _) deps, pkg, exe) <- exes
, let pkgid = packageId pkg
pkg_key = mkPackageKey (packageKeySupported comp) pkgid
(map Installed.libraryName (CD.nonSetupDeps deps))
@@ -133,13 +140,16 @@ symlinkBinaries comp configFlags installFlags plan =
where
exes =
[ (cpkg, pkg, exe)
- | InstallPlan.Installed cpkg _ <- InstallPlan.toList plan
+ | InstallPlan.Installed cpkg _ _ <- InstallPlan.toList plan
, let pkg = pkgDescription cpkg
, exe <- PackageDescription.executables pkg
, PackageDescription.buildable (PackageDescription.buildInfo exe) ]
- pkgDescription :: ReadyPackage -> PackageDescription
- pkgDescription (ReadyPackage (SourcePackage _ pkg _ _) flags stanzas _) =
+ pkgDescription :: ReadyPackage ConfiguredPackage ipkg -> PackageDescription
+ pkgDescription (ReadyPackage (ConfiguredPackage
+ (SourcePackage _ pkg _ _)
+ flags stanzas _)
+ _) =
case finalizePackageDescription flags
(const True)
platform cinfo [] (enableStanzas stanzas pkg) of
diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs
index 2d67b1be331136a68f43d2f502bf54d1938e4183..5eb05606c80b6493ff6ed5689068883f46719930 100644
--- a/cabal-install/Distribution/Client/Types.hs
+++ b/cabal-install/Distribution/Client/Types.hs
@@ -131,51 +131,42 @@ instance HasInstalledPackageId ConfiguredPackage where
-- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be
-- installed already, hence itself ready to be installed.
-data ReadyPackage = ReadyPackage
- SourcePackage -- see 'ConfiguredPackage'.
- FlagAssignment --
- [OptionalStanza] --
- (ComponentDeps [InstalledPackageInfo]) -- Installed dependencies.
- deriving Show
+data ReadyPackage srcpkg ipkg
+ = ReadyPackage
+ srcpkg -- see 'ConfiguredPackage'.
+ (ComponentDeps [ipkg]) -- Installed dependencies.
+ deriving (Eq, Show)
-instance Package ReadyPackage where
- packageId (ReadyPackage pkg _ _ _) = packageId pkg
+instance Package srcpkg => Package (ReadyPackage srcpkg ipkg) where
+ packageId (ReadyPackage srcpkg _deps) = packageId srcpkg
-instance PackageFixedDeps ReadyPackage where
- depends (ReadyPackage _ _ _ deps) = fmap (map installedPackageId) deps
+instance (Package srcpkg, HasInstalledPackageId ipkg) =>
+ PackageFixedDeps (ReadyPackage srcpkg ipkg) where
+ depends (ReadyPackage _ deps) = fmap (map installedPackageId) deps
-instance HasInstalledPackageId ReadyPackage where
- installedPackageId = fakeInstalledPackageId . packageId
+instance HasInstalledPackageId srcpkg =>
+ HasInstalledPackageId (ReadyPackage srcpkg ipkg) where
+ installedPackageId (ReadyPackage pkg _) = installedPackageId pkg
-- | Extracts a package key from ReadyPackage, a common operation needed
-- to calculate build paths.
-readyPackageKey :: Compiler -> ReadyPackage -> PackageKey
-readyPackageKey comp (ReadyPackage pkg _ _ deps) =
+readyPackageKey :: Compiler
+ -> ReadyPackage ConfiguredPackage InstalledPackageInfo
+ -> PackageKey
+readyPackageKey comp (ReadyPackage pkg deps) =
mkPackageKey (packageKeySupported comp) (packageId pkg)
(map Info.libraryName (CD.nonSetupDeps deps))
-- | Extracts a library name from ReadyPackage, a common operation needed
-- to calculate build paths.
-readyLibraryName :: Compiler -> ReadyPackage -> LibraryName
-readyLibraryName comp ready@(ReadyPackage pkg _ _ _) =
+readyLibraryName :: Compiler
+ -> ReadyPackage ConfiguredPackage InstalledPackageInfo
+ -> LibraryName
+readyLibraryName comp ready@(ReadyPackage pkg _) =
packageKeyLibraryName (packageId pkg) (readyPackageKey comp ready)
--- | Sometimes we need to convert a 'ReadyPackage' back to a
--- 'ConfiguredPackage'. For example, a failed 'PlanPackage' can be *either*
--- Ready or Configured.
-readyPackageToConfiguredPackage :: ReadyPackage -> ConfiguredPackage
-readyPackageToConfiguredPackage (ReadyPackage srcpkg flags stanzas deps) =
- ConfiguredPackage srcpkg flags stanzas (fmap (map aux) deps)
- where
- aux :: InstalledPackageInfo -> ConfiguredId
- aux info = ConfiguredId {
- confSrcId = Info.sourcePackageId info
- , confInstId = installedPackageId info
- }
-
-
-- | A package description along with the location of the package sources.
--
data SourcePackage = SourcePackage {
diff --git a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
index e5e3dd6e5825adc7446b29e6c88fed5413933cc7..b7a9e97809e0749e2f36eefcb12b2730e34baf8b 100644
--- a/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
+++ b/cabal-install/tests/UnitTests/Distribution/Client/Dependency/Modular/DSL.hs
@@ -261,7 +261,11 @@ exInstIdx = C.PackageIndex.fromList . map exInstInfo
exResolve :: ExampleDb
-> [ExamplePkgName]
-> Bool
- -> ([String], Either String CI.InstallPlan.InstallPlan)
+ -> ([String], Either String
+ (CI.InstallPlan.InstallPlan
+ C.InstalledPackageInfo
+ ConfiguredPackage
+ isuccess ifailure))
exResolve db targets indepGoals = runProgress $
resolveDependencies C.buildPlatform
(C.unknownCompilerInfo C.buildCompilerId C.NoAbiTag)
@@ -282,11 +286,14 @@ exResolve db targets indepGoals = runProgress $
depResolverIndependentGoals = indepGoals
}
-extractInstallPlan :: CI.InstallPlan.InstallPlan
+extractInstallPlan :: CI.InstallPlan.InstallPlan ipkg ConfiguredPackage
+ isuccess ifailure
-> [(ExamplePkgName, ExamplePkgVersion)]
extractInstallPlan = catMaybes . map confPkg . CI.InstallPlan.toList
where
- confPkg :: CI.InstallPlan.PlanPackage -> Maybe (String, Int)
+ confPkg :: CI.InstallPlan.PlanPackage ipkg ConfiguredPackage
+ isuccess ifailure
+ -> Maybe (String, Int)
confPkg (CI.InstallPlan.Configured pkg) = Just $ srcPkg pkg
confPkg _ = Nothing