Commit f46d2631 authored by Duncan Coutts's avatar Duncan Coutts Committed by Mikhail Glushenkov

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.
parent 8ea6f33c
......@@ -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
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
......@@ -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
......
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