Commit 137075dc authored by Edward Z. Yang's avatar Edward Z. Yang

Turn ReadyPackage into a newtype wrapper.

Previously, ReadyPackage was a ConfiguredPackage elaborated with
a dependencies data structure which had InstalledPackageInfo
rather than ConfiguredId. Well, it turned out that we only
used the data from ConfiguredId! So that extra info is useless.

Instead, ReadyPackage is now purely a newtype wrapper for type
safety; a reminder that not all ConfiguredPackages can be built,
only the ready ones.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent ca898191
......@@ -132,7 +132,7 @@ fromPlanPackage :: Platform -> CompilerId
-> InstallPlan.PlanPackage
-> Maybe (BuildReport, Maybe Repo)
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
InstallPlan.Installed (ReadyPackage (ConfiguredPackage srcPkg flags _ _) deps)
InstallPlan.Installed (ReadyPackage (ConfiguredPackage srcPkg flags _ deps))
_ result
-> Just $ ( BuildReport.new os arch comp
(packageId srcPkg) flags
......
......@@ -50,7 +50,6 @@ import Distribution.Simple.PackageIndex
( InstalledPackageIndex, lookupPackageName )
import Distribution.Simple.Utils
( defaultPackageDesc )
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Package
( Package(..), UnitId, packageName
, Dependency(..), thisPackageVersion
......@@ -134,8 +133,7 @@ configure verbosity packageDBs repoCtxt comp platform conf
Right installPlan -> case InstallPlan.ready installPlan of
[pkg@(ReadyPackage
(ConfiguredPackage (SourcePackage _ _ (LocalUnpackedPackage _) _)
_ _ _)
_)] -> do
_ _ _))] -> do
configurePackage verbosity
platform (compilerInfo comp)
(setupScriptOptions installedPkgIndex (Just pkg))
......@@ -228,15 +226,13 @@ configureSetupScript packageDBs
explicitSetupDeps :: Maybe [(UnitId, PackageId)]
explicitSetupDeps = do
ReadyPackage cpkg deps <- mpkg
ReadyPackage cpkg <- mpkg
let gpkg = packageDescription (confPkgSource cpkg)
-- Check if there is an explicit setup stanza
_buildInfo <- PkgDesc.setupBuildInfo (PkgDesc.packageDescription gpkg)
-- Return the setup dependencies computed by the solver
return [ ( Installed.installedUnitId deppkg
, Installed.sourcePackageId deppkg
)
| deppkg <- CD.setupDeps deps
return [ ( uid, srcid )
| ConfiguredId srcid uid <- CD.setupDeps (confPkgDeps cpkg)
]
-- | Warn if any constraints or preferences name packages that are not in the
......@@ -348,8 +344,7 @@ configurePackage :: Verbosity
-> [String]
-> IO ()
configurePackage verbosity platform comp scriptOptions configFlags
(ReadyPackage (ConfiguredPackage spkg flags stanzas _)
deps)
(ReadyPackage (ConfiguredPackage spkg flags stanzas deps))
extraArgs =
setupWrapper verbosity
......@@ -362,11 +357,10 @@ configurePackage verbosity platform comp scriptOptions configFlags
-- 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 the Cabal version we are talking to.
configConstraints = [ thisPackageVersion (packageId deppkg)
| deppkg <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
Installed.installedUnitId deppkg)
| deppkg <- CD.nonSetupDeps deps ],
configConstraints = [ thisPackageVersion srcid
| ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName srcid, uid)
| ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
-- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True,
configVerbosity = toFlag verbosity,
......
......@@ -656,7 +656,7 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
showPkg (pkg, _) = display (packageId pkg) ++
showLatest (pkg)
showPkgAndReason (ReadyPackage pkg' _, pr) = display (packageId pkg') ++
showPkgAndReason (ReadyPackage pkg', pr) = display (packageId pkg') ++
showLatest pkg' ++
showFlagAssignment (nonDefaultFlags pkg') ++
showStanzas (confPkgStanzas pkg') ++
......@@ -715,9 +715,9 @@ printPlan dryRun verbosity plan sourcePkgDb = case plan of
| otherwise = ""
revDepGraphEdges :: [(PackageId, PackageId)]
revDepGraphEdges = [ (rpid, packageId pkg)
| (pkg@(ReadyPackage _ deps), _) <- plan
, rpid <- Installed.sourcePackageId <$> CD.flatDeps deps ]
revDepGraphEdges = [ (rpid, packageId cpkg)
| (ReadyPackage cpkg, _) <- plan
, ConfiguredId rpid _ <- CD.flatDeps (confPkgDeps cpkg) ]
revDeps :: Map.Map PackageId [PackageId]
revDeps = Map.fromListWith (++) (map (fmap (:[])) revDepGraphEdges)
......@@ -1029,7 +1029,7 @@ updateSandboxTimestampsFile (UseSandbox sandboxDir)
withUpdateTimestamps sandboxDir (compilerId comp) platform $ \_ -> do
let allInstalled = [ pkg | InstallPlan.Installed pkg _ _
<- InstallPlan.toList installPlan ]
allSrcPkgs = [ confPkgSource cpkg | ReadyPackage cpkg _
allSrcPkgs = [ confPkgSource cpkg | ReadyPackage cpkg
<- allInstalled ]
allPaths = [ pth | LocalUnpackedPackage pth
<- map packageSource allSrcPkgs]
......@@ -1259,19 +1259,17 @@ installReadyPackage :: Platform -> CompilerInfo
installReadyPackage platform cinfo configFlags
(ReadyPackage (ConfiguredPackage
(SourcePackage _ gpkg source pkgoverride)
flags stanzas _)
deps)
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
-- the Cabal version we are talking to.
configConstraints = [ thisPackageVersion (packageId deppkg)
| deppkg <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
Installed.installedUnitId deppkg)
| deppkg <- CD.nonSetupDeps deps ],
configConstraints = [ thisPackageVersion srcid
| ConfiguredId srcid _uid <- CD.nonSetupDeps deps ],
configDependencies = [ (packageName srcid, uid)
| ConfiguredId srcid uid <- CD.nonSetupDeps deps ],
-- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True,
configBenchmarks = toFlag False,
......@@ -1416,7 +1414,7 @@ installUnpackedPackage verbosity buildLimit installLock numJobs
writeFileAtomic descFilePath pkgtxt
-- Compute the IPID of the *library*
let flags (ReadyPackage cpkg _) = confPkgFlags cpkg
let flags (ReadyPackage cpkg) = confPkgFlags cpkg
pkg_name = pkgName (PackageDescription.package pkg)
cid = Configure.computeComponentId
Cabal.NoFlag -- This would let us override the computation
......
......@@ -147,8 +147,8 @@ import qualified Data.Traversable as T
data GenericPlanPackage ipkg srcpkg iresult ifailure
= PreExisting ipkg
| Configured srcpkg
| Processing (GenericReadyPackage srcpkg ipkg)
| Installed (GenericReadyPackage srcpkg ipkg) (Maybe ipkg) iresult
| Processing (GenericReadyPackage srcpkg)
| Installed (GenericReadyPackage srcpkg) (Maybe ipkg) iresult
| Failed srcpkg ifailure
deriving (Eq, Show, Generic)
......@@ -168,7 +168,7 @@ instance (Package ipkg, Package srcpkg) =>
packageId (Failed spkg _) = packageId spkg
instance (PackageFixedDeps srcpkg,
PackageFixedDeps ipkg, HasUnitId ipkg) =>
PackageFixedDeps ipkg) =>
PackageFixedDeps (GenericPlanPackage ipkg srcpkg iresult ifailure) where
depends (PreExisting pkg) = depends pkg
depends (Configured pkg) = depends pkg
......@@ -348,7 +348,7 @@ remove shouldRemove plan =
--
ready :: forall ipkg srcpkg iresult ifailure. PackageFixedDeps srcpkg
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> [GenericReadyPackage srcpkg ipkg]
-> [GenericReadyPackage srcpkg]
ready plan = assert check readyPackages
where
check = if null readyPackages && null processingPackages
......@@ -357,17 +357,17 @@ ready plan = assert check readyPackages
configuredPackages = [ pkg | Configured pkg <- toList plan ]
processingPackages = [ pkg | Processing pkg <- toList plan]
readyPackages :: [GenericReadyPackage srcpkg ipkg]
readyPackages :: [GenericReadyPackage srcpkg]
readyPackages = catMaybes (map (lookupReadyPackage plan) configuredPackages)
lookupReadyPackage :: forall ipkg srcpkg iresult ifailure.
PackageFixedDeps srcpkg
=> GenericInstallPlan ipkg srcpkg iresult ifailure
-> srcpkg
-> Maybe (GenericReadyPackage srcpkg ipkg)
-> Maybe (GenericReadyPackage srcpkg)
lookupReadyPackage plan pkg = do
deps <- hasAllInstalledDeps pkg
return (ReadyPackage pkg deps)
_ <- hasAllInstalledDeps pkg
return (ReadyPackage pkg)
where
hasAllInstalledDeps :: srcpkg -> Maybe (ComponentDeps [ipkg])
......@@ -397,7 +397,7 @@ lookupReadyPackage plan pkg = do
--
processing :: (HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> [GenericReadyPackage srcpkg ipkg]
=> [GenericReadyPackage srcpkg]
-> GenericInstallPlan ipkg srcpkg iresult ifailure
-> GenericInstallPlan ipkg srcpkg iresult ifailure
processing pkgs plan = assert (invariant plan') plan'
......@@ -455,7 +455,7 @@ failed pkgid buildResult buildResult' plan = assert (invariant plan') plan'
plan' = plan {
planIndex = PackageIndex.merge (planIndex plan) failures
}
ReadyPackage srcpkg _deps = lookupProcessingPackage plan pkgid
ReadyPackage srcpkg = lookupProcessingPackage plan pkgid
failures = PackageIndex.fromList
$ Failed srcpkg buildResult
: [ Failed pkg' buildResult'
......@@ -477,7 +477,7 @@ packagesThatDependOn plan pkgid = map (planPkgOf plan)
--
lookupProcessingPackage :: GenericInstallPlan ipkg srcpkg iresult ifailure
-> UnitId
-> GenericReadyPackage srcpkg ipkg
-> GenericReadyPackage srcpkg
lookupProcessingPackage plan pkgid =
-- NB: processing packages are guaranteed to not indirect through
-- planFakeMap
......@@ -693,7 +693,7 @@ 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 :: (HasUnitId ipkg, PackageFixedDeps ipkg,
closed :: (PackageFixedDeps ipkg,
PackageFixedDeps srcpkg)
=> FakeMap -> PlanIndex ipkg srcpkg iresult ifailure -> Bool
closed fakeMap = null . PlanIndex.brokenPackages fakeMap
......
......@@ -123,7 +123,7 @@ symlinkBinaries platform comp configFlags installFlags plan =
then return Nothing
else return (Just (pkgid, publicExeName,
privateBinDir </> privateExeName))
| (ReadyPackage _cpkg _, pkg, exe) <- exes
| (ReadyPackage _cpkg, pkg, exe) <- exes
, let pkgid = packageId pkg
-- This is a bit dodgy; probably won't work for Backpack packages
ipid = fakeUnitId pkgid
......@@ -142,8 +142,7 @@ symlinkBinaries platform comp configFlags installFlags plan =
pkgDescription :: ReadyPackage -> PackageDescription
pkgDescription (ReadyPackage (ConfiguredPackage
(SourcePackage _ pkg _ _)
flags stanzas _)
_) =
flags stanzas _)) =
case finalizePackageDescription flags
(const True)
platform cinfo [] (enableStanzas stanzas pkg) of
......
......@@ -628,7 +628,7 @@ rebuildTarget verbosity
buildSettings downloadMap
buildLimit installLock cacheLock
sharedPackageConfig
rpkg@(ReadyPackage pkg _)
rpkg@(ReadyPackage pkg)
pkgBuildStatus =
-- We rely on the 'BuildStatus' to decide which phase to start from:
......@@ -779,10 +779,10 @@ executeInstallPlan
(HasUnitId ipkg, PackageFixedDeps ipkg,
HasUnitId srcpkg, PackageFixedDeps srcpkg)
=> Verbosity
-> JobControl IO ( GenericReadyPackage srcpkg ipkg
-> JobControl IO ( GenericReadyPackage srcpkg
, GenericBuildResult ipkg iresult BuildFailure )
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
-> ( GenericReadyPackage srcpkg ipkg
-> ( GenericReadyPackage srcpkg
-> IO (GenericBuildResult ipkg iresult BuildFailure))
-> IO (GenericInstallPlan ipkg srcpkg iresult BuildFailure)
executeInstallPlan verbosity jobCtl plan0 installPkg =
......@@ -813,7 +813,7 @@ executeInstallPlan verbosity jobCtl plan0 installPkg =
plan' = updatePlan pkg buildResult plan
tryNewTasks taskCount' plan'
updatePlan :: GenericReadyPackage srcpkg ipkg
updatePlan :: GenericReadyPackage srcpkg
-> GenericBuildResult ipkg iresult BuildFailure
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
-> GenericInstallPlan ipkg srcpkg iresult BuildFailure
......@@ -950,7 +950,7 @@ buildAndInstallUnpackedPackage verbosity
pkgConfigPlatform = platform,
pkgConfigProgramDb = progdb
}
rpkg@(ReadyPackage pkg _deps)
rpkg@(ReadyPackage pkg)
srcdir builddir = do
createDirectoryIfMissingVerbose verbosity False builddir
......@@ -1106,7 +1106,7 @@ buildInplaceUnpackedPackage verbosity
pkgConfigCompiler = compiler,
pkgConfigProgramDb = progdb
}
rpkg@(ReadyPackage pkg _deps)
rpkg@(ReadyPackage pkg)
buildStatus
srcdir builddir = do
......
......@@ -88,7 +88,6 @@ import qualified Distribution.PackageDescription as Cabal
import qualified Distribution.PackageDescription as PD
import qualified Distribution.PackageDescription.Configuration as PD
import Distribution.InstalledPackageInfo (InstalledPackageInfo)
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.Compiler hiding (Flag)
......@@ -366,7 +365,6 @@ instance Binary BuildStyle
type CabalFileText = LBS.ByteString
type ElaboratedReadyPackage = GenericReadyPackage ElaboratedConfiguredPackage
InstalledPackageInfo
--TODO: [code cleanup] this duplicates the InstalledPackageInfo quite a bit in an install plan
-- because the same ipkg is used by many packages. So the binary file will be big.
......@@ -1901,7 +1899,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage
-> Bool
-> Lock
-> SetupScriptOptions
setupHsScriptOptions (ReadyPackage ElaboratedConfiguredPackage{..} deps)
setupHsScriptOptions (ReadyPackage ElaboratedConfiguredPackage{..})
ElaboratedSharedConfig{..} srcdir builddir
isParallelBuild cacheLock =
SetupScriptOptions {
......@@ -1911,8 +1909,8 @@ setupHsScriptOptions (ReadyPackage ElaboratedConfiguredPackage{..} deps)
usePlatform = Just pkgConfigPlatform,
usePackageDB = pkgSetupPackageDBStack,
usePackageIndex = Nothing,
useDependencies = [ (installedPackageId ipkg, packageId ipkg)
| ipkg <- CD.setupDeps deps ],
useDependencies = [ (uid, srcid)
| ConfiguredId srcid uid <- CD.setupDeps pkgDependencies ],
useDependenciesExclusive = True,
useVersionMacros = pkgSetupScriptStyle == SetupCustomExplicitDeps,
useProgramConfig = pkgConfigProgramDb,
......@@ -1972,8 +1970,7 @@ setupHsConfigureFlags :: ElaboratedReadyPackage
-> FilePath
-> Cabal.ConfigFlags
setupHsConfigureFlags (ReadyPackage
pkg@ElaboratedConfiguredPackage{..}
pkgdeps)
pkg@ElaboratedConfiguredPackage{..})
sharedConfig@ElaboratedSharedConfig{..}
verbosity builddir =
assert (sanityCheckElaboratedConfiguredPackage sharedConfig pkg)
......@@ -2027,11 +2024,10 @@ setupHsConfigureFlags (ReadyPackage
-- we only use configDependencies, unless we're talking to an old Cabal
-- in which case we use configConstraints
configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
Installed.installedUnitId deppkg)
| deppkg <- CD.nonSetupDeps pkgdeps ]
configConstraints = [ thisPackageVersion (packageId deppkg)
| deppkg <- CD.nonSetupDeps pkgdeps ]
configDependencies = [ (packageName srcid, uid)
| ConfiguredId srcid uid <- CD.nonSetupDeps pkgDependencies ]
configConstraints = [ thisPackageVersion srcid
| ConfiguredId srcid _uid <- CD.nonSetupDeps pkgDependencies ]
-- explicitly clear, then our package db stack
-- TODO: [required eventually] have to do this differently for older Cabal versions
......
......@@ -2,6 +2,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
......@@ -165,26 +166,10 @@ instance HasUnitId (ConfiguredPackage loc) where
-- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be
-- installed already, hence itself ready to be installed.
data GenericReadyPackage srcpkg ipkg
= ReadyPackage
srcpkg -- see 'ConfiguredPackage'.
(ComponentDeps [ipkg]) -- Installed dependencies.
deriving (Eq, Show, Generic)
type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) InstalledPackageInfo
instance Package srcpkg => Package (GenericReadyPackage srcpkg ipkg) where
packageId (ReadyPackage srcpkg _deps) = packageId srcpkg
instance (Package srcpkg, HasUnitId ipkg) =>
PackageFixedDeps (GenericReadyPackage srcpkg ipkg) where
depends (ReadyPackage _ deps) = fmap (map installedUnitId) deps
instance HasUnitId srcpkg =>
HasUnitId (GenericReadyPackage srcpkg ipkg) where
installedUnitId (ReadyPackage pkg _) = installedUnitId pkg
newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPackage'.
deriving (Eq, Show, Generic, Package, PackageFixedDeps, HasUnitId, Binary)
instance (Binary srcpkg, Binary ipkg) => Binary (GenericReadyPackage srcpkg ipkg)
type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc)
-- | A package description along with the location of the package sources.
......
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