From f46d26312ff92d3d40ccc3bd11b3a0e23644e71f Mon Sep 17 00:00:00 2001
From: Duncan Coutts <duncan@community.haskell.org>
Date: Thu, 23 Jul 2015 00:51:50 +0100
Subject: [PATCH] Remove the now-unused Platform and CompilerInfo from the
InstallPlan
It wasn't used within the InstallPlan, but it had accessors and those
were used in a few places. Just pass them into those few places that
need it.
---
.../Client/BuildReports/Storage.hs | 14 +++++------
.../Distribution/Client/Configure.hs | 3 +--
.../Distribution/Client/Dependency.hs | 2 +-
cabal-install/Distribution/Client/Install.hs | 24 +++++++++++--------
.../Distribution/Client/InstallPlan.hs | 22 ++++-------------
.../Distribution/Client/InstallSymlink.hs | 16 +++++++------
6 files changed, 37 insertions(+), 44 deletions(-)
diff --git a/cabal-install/Distribution/Client/BuildReports/Storage.hs b/cabal-install/Distribution/Client/BuildReports/Storage.hs
index 26e4b6e272..78bcdf0d90 100644
--- a/cabal-install/Distribution/Client/BuildReports/Storage.hs
+++ b/cabal-install/Distribution/Client/BuildReports/Storage.hs
@@ -118,16 +118,16 @@ storeLocal cinfo templates reports platform = sequence_
-- * InstallPlan support
-- ------------------------------------------------------------
-fromInstallPlan :: InstallPlan InstalledPackageInfo
+fromInstallPlan :: Platform -> CompilerId
+ -> InstallPlan InstalledPackageInfo
ConfiguredPackage
BuildSuccess BuildFailure
-> [(BuildReport, Maybe Repo)]
-fromInstallPlan plan = catMaybes
- . map (fromPlanPackage platform comp)
- . InstallPlan.toList
- $ plan
- where platform = InstallPlan.planPlatform plan
- comp = compilerInfoId (InstallPlan.planCompiler plan)
+fromInstallPlan platform comp plan =
+ catMaybes
+ . map (fromPlanPackage platform comp)
+ . InstallPlan.toList
+ $ plan
fromPlanPackage :: Platform -> CompilerId
-> InstallPlan.PlanPackage InstalledPackageInfo
diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs
index 52557fbf3f..9e731beff4 100644
--- a/cabal-install/Distribution/Client/Configure.hs
+++ b/cabal-install/Distribution/Client/Configure.hs
@@ -122,8 +122,7 @@ configure verbosity packageDBs repos comp platform conf
_ _ _)
_)] -> do
configurePackage verbosity
- (InstallPlan.planPlatform installPlan)
- (InstallPlan.planCompiler installPlan)
+ platform (compilerInfo comp)
(setupScriptOptions installedPkgIndex (Just pkg))
configFlags pkg extraArgs
diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs
index 514e8fe869..cb1aeb74ce 100644
--- a/cabal-install/Distribution/Client/Dependency.hs
+++ b/cabal-install/Distribution/Client/Dependency.hs
@@ -618,7 +618,7 @@ validateSolverResult :: Platform
iresult ifailure
validateSolverResult platform comp indepGoals pkgs =
case planPackagesProblems platform comp pkgs of
- [] -> case InstallPlan.new platform comp indepGoals index of
+ [] -> case InstallPlan.new indepGoals index of
Right plan -> plan
Left problems -> error (formatPlanProblems problems)
problems -> error (formatPkgProblems problems)
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index 9942946b8c..aa285ae167 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -799,9 +799,12 @@ postInstallActions verbosity
[ World.WorldPkgInfo dep []
| UserTargetNamed dep <- targets ]
- let buildReports = BuildReports.fromInstallPlan installPlan
- BuildReports.storeLocal (compilerInfo comp) (fromNubList $ installSummaryFile installFlags) buildReports
- (InstallPlan.planPlatform installPlan)
+ let buildReports = BuildReports.fromInstallPlan platform (compilerId comp)
+ installPlan
+ BuildReports.storeLocal (compilerInfo comp)
+ (fromNubList $ installSummaryFile installFlags)
+ buildReports
+ platform
when (reportingLevel >= AnonymousReports) $
BuildReports.storeAnonymous buildReports
when (reportingLevel == DetailedReports) $
@@ -810,7 +813,7 @@ postInstallActions verbosity
regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
configFlags installFlags installPlan
- symlinkBinaries verbosity comp configFlags installFlags installPlan
+ symlinkBinaries verbosity platform comp configFlags installFlags installPlan
printBuildFailures installPlan
@@ -920,15 +923,17 @@ regenerateHaddockIndex verbosity packageDBs comp platform conf useSandbox
symlinkBinaries :: Verbosity
- -> Compiler
+ -> Platform -> Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan InstalledPackageInfo
ConfiguredPackage
iresult ifailure
-> IO ()
-symlinkBinaries verbosity comp configFlags installFlags plan = do
- failed <- InstallSymlink.symlinkBinaries comp configFlags installFlags plan
+symlinkBinaries verbosity platform comp configFlags installFlags plan = do
+ failed <- InstallSymlink.symlinkBinaries platform comp
+ configFlags installFlags
+ plan
case failed of
[] -> return ()
[(_, exe, path)] ->
@@ -1038,7 +1043,7 @@ performInstallations :: Verbosity
ConfiguredPackage
BuildSuccess BuildFailure)
performInstallations verbosity
- (packageDBs, _, comp, _, conf, useSandbox, _,
+ (packageDBs, _, comp, platform, conf, useSandbox, _,
globalFlags, configFlags, configExFlags, installFlags, haddockFlags)
installedPkgIndex installPlan = do
@@ -1071,8 +1076,7 @@ performInstallations verbosity
cinfo platform pkg pkgoverride mpath useLogFile
where
- platform = InstallPlan.planPlatform installPlan
- cinfo = InstallPlan.planCompiler installPlan
+ cinfo = compilerInfo comp
numJobs = determineNumJobs (installNumJobs installFlags)
numFetchJobs = 2
diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs
index 1f6617329f..d5b02b2893 100644
--- a/cabal-install/Distribution/Client/InstallPlan.hs
+++ b/cabal-install/Distribution/Client/InstallPlan.hs
@@ -27,10 +27,6 @@ module Distribution.Client.InstallPlan (
showPlanIndex,
showInstallPlan,
- -- ** Query functions
- planPlatform,
- planCompiler,
-
-- * Checking validity of plans
valid,
closed,
@@ -63,13 +59,9 @@ import Distribution.Client.PlanIndex
import qualified Distribution.Client.PlanIndex as PlanIndex
import Distribution.Text
( display )
-import Distribution.System
- ( Platform )
-import Distribution.Compiler
- ( CompilerInfo(..) )
-import Distribution.Simple.Utils
- ( intercalate )
+import Data.List
+ ( intercalate )
import Data.Maybe
( fromMaybe, maybeToList )
import qualified Data.Graph as Graph
@@ -176,8 +168,6 @@ data InstallPlan ipkg srcpkg iresult ifailure = InstallPlan {
planGraphRev :: Graph,
planPkgOf :: Graph.Vertex -> PlanPackage ipkg srcpkg iresult ifailure,
planVertexOf :: InstalledPackageId -> Graph.Vertex,
- planPlatform :: Platform,
- planCompiler :: CompilerInfo,
planIndepGoals :: Bool
}
@@ -222,11 +212,11 @@ showPlanPackageTag (Failed _ _) = "Failed"
--
new :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
HasInstalledPackageId srcpkg, PackageFixedDeps srcpkg)
- => Platform -> CompilerInfo -> Bool
+ => Bool
-> PlanIndex ipkg srcpkg iresult ifailure
-> Either [PlanProblem ipkg srcpkg iresult ifailure]
(InstallPlan ipkg srcpkg iresult ifailure)
-new platform cinfo indepGoals index =
+new indepGoals index =
-- NB: Need to pre-initialize the fake-map with pre-existing
-- packages
let isPreExisting (PreExisting _) = True
@@ -243,8 +233,6 @@ new platform cinfo indepGoals index =
planGraphRev = Graph.transposeG graph,
planPkgOf = vertexToPkgId,
planVertexOf = fromMaybe noSuchPkgId . pkgIdToVertex,
- planPlatform = platform, --TODO: now unused
- planCompiler = cinfo, --TODO: now unused
planIndepGoals = indepGoals
}
where (graph, vertexToPkgId, pkgIdToVertex) =
@@ -269,7 +257,7 @@ remove :: (HasInstalledPackageId ipkg, PackageFixedDeps ipkg,
-> Either [PlanProblem ipkg srcpkg iresult ifailure]
(InstallPlan ipkg srcpkg iresult ifailure)
remove shouldRemove plan =
- new (planPlatform plan) (planCompiler plan) (planIndepGoals plan) newIndex
+ new (planIndepGoals plan) newIndex
where
newIndex = PackageIndex.fromList $
filter (not . shouldRemove) (toList plan)
diff --git a/cabal-install/Distribution/Client/InstallSymlink.hs b/cabal-install/Distribution/Client/InstallSymlink.hs
index 71309d1e30..ceb03fb94a 100644
--- a/cabal-install/Distribution/Client/InstallSymlink.hs
+++ b/cabal-install/Distribution/Client/InstallSymlink.hs
@@ -23,15 +23,16 @@ import Distribution.Client.InstallPlan (InstallPlan)
import Distribution.Client.Setup (InstallFlags)
import Distribution.Simple.Setup (ConfigFlags)
import Distribution.Simple.Compiler
+import Distribution.System
-symlinkBinaries :: Compiler
+symlinkBinaries :: Platform -> Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan InstalledPackageInfo
ConfiguredPackage
iresult ifailure
-> IO [(PackageIdentifier, String, FilePath)]
-symlinkBinaries _ _ _ _ = return []
+symlinkBinaries _ _ _ _ _ = return []
symlinkBinary :: FilePath -> FilePath -> String -> String -> IO Bool
symlinkBinary _ _ _ _ = fail "Symlinking feature not available on Windows"
@@ -64,7 +65,9 @@ import Distribution.InstalledPackageInfo
( InstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Simple.Compiler
- ( Compiler, CompilerInfo(..), packageKeySupported )
+ ( Compiler, compilerInfo, CompilerInfo(..), packageKeySupported )
+import Distribution.System
+ ( Platform )
import System.Posix.Files
( getSymbolicLinkStatus, isSymbolicLink, createSymbolicLink
@@ -103,14 +106,14 @@ import Data.Maybe
-- controlled from the config file. Of course it only works on POSIX systems
-- with symlinks so is not available to Windows users.
--
-symlinkBinaries :: Compiler
+symlinkBinaries :: Platform -> Compiler
-> ConfigFlags
-> InstallFlags
-> InstallPlan InstalledPackageInfo
ConfiguredPackage
iresult ifailure
-> IO [(PackageIdentifier, String, FilePath)]
-symlinkBinaries comp configFlags installFlags plan =
+symlinkBinaries platform comp configFlags installFlags plan =
case flagToMaybe (installSymlinkBinDir installFlags) of
Nothing -> return []
Just symlinkBinDir
@@ -180,8 +183,7 @@ symlinkBinaries comp configFlags installFlags plan =
fromFlagTemplate = fromFlagOrDefault (InstallDirs.toPathTemplate "")
prefixTemplate = fromFlagTemplate (configProgPrefix configFlags)
suffixTemplate = fromFlagTemplate (configProgSuffix configFlags)
- platform = InstallPlan.planPlatform plan
- cinfo = InstallPlan.planCompiler plan
+ cinfo = compilerInfo comp
(CompilerId compilerFlavor _) = compilerInfoId cinfo
symlinkBinary :: FilePath -- ^ The canonical path of the public bin dir
--
GitLab