Commit 87a79be9 authored by Edsko de Vries's avatar Edsko de Vries
Browse files

Keep fine-grained deps after solver

The crucial change in this commit is the change to PackageFixedDeps to return a
ComponentDeps structure, rather than a flat list of dependencies, as long with
corresponding changes in ConfiguredPackage and ReadyPackage to accomodate this.

We don't actually take _advantage_ of these more fine-grained dependencies yet;
any use of

    depends

is now a use of

   CD.flatDeps . depends

but we will :)

Note that I have not updated the top-down solver, so in the output of the
top-down solver we cheat and pretend that all dependencies are library
dependencies.
parent 6b77ea23
......@@ -28,6 +28,7 @@ import Distribution.Client.BuildReports.Anonymous (BuildReport)
import Distribution.Client.Types
import qualified Distribution.Client.InstallPlan as InstallPlan
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Client.InstallPlan
( InstallPlan )
......@@ -129,13 +130,13 @@ fromPlanPackage :: Platform -> CompilerId
fromPlanPackage (Platform arch os) comp planPackage = case planPackage of
InstallPlan.Installed (ReadyPackage srcPkg flags _ deps) result
-> Just $ ( BuildReport.new os arch comp
(packageId srcPkg) flags (map packageId deps)
(packageId srcPkg) flags (map packageId (CD.flatDeps deps))
(Right result)
, extractRepo srcPkg)
InstallPlan.Failed (ConfiguredPackage srcPkg flags _ deps) result
-> Just $ ( BuildReport.new os arch comp
(packageId srcPkg) flags (map confSrcId deps)
(packageId srcPkg) flags (map confSrcId (CD.flatDeps deps))
(Left result)
, extractRepo srcPkg )
......
......@@ -29,6 +29,7 @@ import Distribution.Client.SetupWrapper
( setupWrapper, SetupScriptOptions(..), defaultSetupScriptOptions )
import Distribution.Client.Targets
( userToPackageConstraint )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Simple.Compiler
( Compiler, CompilerInfo, compilerInfo, PackageDB(..), PackageDBStack )
......@@ -236,10 +237,10 @@ configurePackage verbosity platform comp scriptOptions configFlags
-- 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 <- deps ],
| deppkg <- CD.flatDeps deps ],
configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
Installed.installedPackageId deppkg)
| deppkg <- deps ],
| deppkg <- CD.flatDeps deps ],
-- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True,
configVerbosity = toFlag verbosity,
......
......@@ -13,6 +13,7 @@ import Distribution.System
import Distribution.Client.Dependency.Modular.Configured
import Distribution.Client.Dependency.Modular.Package
import Distribution.Client.ComponentDeps (ComponentDeps)
import qualified Distribution.Client.ComponentDeps as CD
mkPlan :: Platform -> CompilerInfo -> Bool ->
......@@ -27,15 +28,15 @@ convCP iidx sidx (CP qpi fa es ds) =
case convPI qpi of
Left pi -> PreExisting $ InstalledPackage
(fromJust $ SI.lookupInstalledPackageId iidx pi)
(map confSrcId ds')
(map confSrcId $ CD.flatDeps ds')
Right pi -> Configured $ ConfiguredPackage
(fromJust $ CI.lookupPackageId sidx pi)
fa
es
ds'
where
ds' :: [ConfiguredId]
ds' = CD.flatDeps $ fmap (map convConfId) ds
ds' :: ComponentDeps [ConfiguredId]
ds' = fmap (map convConfId) ds
convPI :: PI QPN -> Either InstalledPackageId PackageId
convPI (PI _ (I _ (Inst pi))) = Left pi
......
......@@ -33,6 +33,9 @@ import Distribution.Client.Dependency.Types
, Progress(..), foldProgress )
import qualified Distribution.Client.PackageIndex as PackageIndex
import Distribution.Client.ComponentDeps
( ComponentDeps )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Client.PackageIndex
( PackageIndex )
import Distribution.Package
......@@ -562,7 +565,10 @@ finaliseSelectedPackages pref selected constraints =
finaliseSource mipkg (SemiConfiguredPackage pkg flags stanzas deps) =
InstallPlan.Configured (ConfiguredPackage pkg flags stanzas deps')
where
deps' = map (confId . pickRemaining mipkg) deps
-- We cheat in the cabal solver, and classify all dependencies as
-- library dependencies.
deps' :: ComponentDeps [ConfiguredId]
deps' = CD.fromLibraryDeps $ map (confId . pickRemaining mipkg) deps
-- InstalledOrSource indicates that we either have a source package
-- available, or an installed one, or both. In the case that we have both
......
......@@ -10,6 +10,7 @@
--
-- Types for the top-down dependency resolver.
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module Distribution.Client.Dependency.TopDown.Types where
import Distribution.Client.Types
......@@ -17,6 +18,7 @@ import Distribution.Client.Types
, OptionalStanza, ConfiguredId(..) )
import Distribution.Client.InstallPlan
( ConfiguredPackage(..), PlanPackage(..) )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Package
( PackageIdentifier, Dependency
......@@ -113,10 +115,10 @@ instance PackageSourceDeps InstalledPackageEx where
sourceDeps (InstalledPackageEx _ _ deps) = deps
instance PackageSourceDeps ConfiguredPackage where
sourceDeps (ConfiguredPackage _ _ _ deps) = map confSrcId deps
sourceDeps (ConfiguredPackage _ _ _ deps) = map confSrcId $ CD.flatDeps deps
instance PackageSourceDeps ReadyPackage where
sourceDeps (ReadyPackage _ _ _ deps) = map packageId deps
sourceDeps (ReadyPackage _ _ _ deps) = map packageId $ CD.flatDeps deps
instance PackageSourceDeps InstalledPackage where
sourceDeps (InstalledPackage _ deps) = deps
......
......@@ -103,6 +103,7 @@ import qualified Distribution.Client.World as World
import qualified Distribution.InstalledPackageInfo as Installed
import Distribution.Client.Compat.ExecutablePath
import Distribution.Client.JobControl
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Utils.NubList
import Distribution.Simple.Compiler
......@@ -563,8 +564,8 @@ packageStatus _comp installedPkgIndex cpkg =
-> [MergeResult PackageIdentifier PackageIdentifier]
changes pkg pkg' = filter changed $
mergeBy (comparing packageName)
(resolveInstalledIds $ Installed.depends pkg) -- deps of installed pkg
(resolveInstalledIds $ depends $ pkg') -- deps of configured pkg
(resolveInstalledIds $ Installed.depends pkg) -- deps of installed pkg
(resolveInstalledIds $ CD.flatDeps (depends pkg')) -- deps of configured pkg
-- convert to source pkg ids via index
resolveInstalledIds :: [InstalledPackageId] -> [PackageIdentifier]
......@@ -1191,10 +1192,10 @@ installReadyPackage platform cinfo configFlags
-- 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 <- deps ],
| deppkg <- CD.flatDeps deps ],
configDependencies = [ (packageName (Installed.sourcePackageId deppkg),
Installed.installedPackageId deppkg)
| deppkg <- deps ],
| deppkg <- CD.flatDeps deps ],
-- Use '--exact-configuration' if supported.
configExactConfiguration = toFlag True,
configBenchmarks = toFlag False,
......
......@@ -70,6 +70,8 @@ import Distribution.Client.PackageUtils
( externalBuildDepends )
import Distribution.Client.PackageIndex
( PackageFixedDeps(..) )
import Distribution.Client.ComponentDeps (ComponentDeps)
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.PackageDescription.Configuration
( finalizePackageDescription )
import Distribution.Simple.PackageIndex
......@@ -100,6 +102,7 @@ import Control.Exception
( assert )
import Data.Maybe (catMaybes)
import qualified Data.Map as Map
import qualified Data.Traversable as T
type PlanIndex = PackageIndex PlanPackage
......@@ -300,8 +303,8 @@ ready plan = assert check readyPackages
, deps <- maybeToList (hasAllInstalledDeps pkg)
]
hasAllInstalledDeps :: ConfiguredPackage -> Maybe [Installed.InstalledPackageInfo]
hasAllInstalledDeps = mapM isInstalledDep . depends
hasAllInstalledDeps :: ConfiguredPackage -> Maybe (ComponentDeps [Installed.InstalledPackageInfo])
hasAllInstalledDeps = T.mapM (mapM isInstalledDep) . depends
isInstalledDep :: InstalledPackageId -> Maybe Installed.InstalledPackageInfo
isInstalledDep pkgid =
......@@ -491,7 +494,7 @@ problems platform cinfo fakeMap indepGoals index =
++ [ PackageStateInvalid pkg pkg'
| pkg <- PackageIndex.allPackages index
, Just pkg' <- map (PlanIndex.fakeLookupInstalledPackageId fakeMap index) (depends pkg)
, Just pkg' <- map (PlanIndex.fakeLookupInstalledPackageId fakeMap index) (CD.flatDeps (depends pkg))
, not (stateDependencyRelation pkg pkg') ]
-- | The graph of packages (nodes) and dependencies (edges) must be acyclic.
......@@ -612,24 +615,19 @@ configuredPackageProblems platform cinfo
++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ]
++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ]
++ [ DuplicateDeps pkgs
| pkgs <- duplicatesBy (comparing packageName) specifiedDeps ]
| pkgs <- CD.flatDeps (fmap (duplicatesBy (comparing packageName)) specifiedDeps) ]
++ [ MissingDep dep | OnlyInLeft dep <- mergedDeps ]
++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ]
++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps
, not (packageSatisfiesDependency pkgid dep) ]
where
specifiedDeps :: [PackageId]
specifiedDeps = map confSrcId specifiedDeps'
specifiedDeps :: ComponentDeps [PackageId]
specifiedDeps = fmap (map confSrcId) specifiedDeps'
mergedFlags = mergeBy compare
(sort $ map flagName (genPackageFlags (packageDescription pkg)))
(sort $ map fst specifiedFlags)
mergedDeps = mergeBy
(\dep pkgid -> dependencyName dep `compare` packageName pkgid)
(sortBy (comparing dependencyName) requiredDeps)
(sortBy (comparing packageName) specifiedDeps)
packageSatisfiesDependency
(PackageIdentifier name version)
(Dependency name' versionRange) = assert (name == name') $
......@@ -637,6 +635,20 @@ configuredPackageProblems platform cinfo
dependencyName (Dependency name _) = name
mergedDeps :: [MergeResult Dependency PackageId]
mergedDeps = mergeDeps requiredDeps (CD.flatDeps specifiedDeps)
mergeDeps :: [Dependency] -> [PackageId] -> [MergeResult Dependency PackageId]
mergeDeps required specified =
mergeBy
(\dep pkgid -> dependencyName dep `compare` packageName pkgid)
(sortBy (comparing dependencyName) required)
(sortBy (comparing packageName) specified)
-- TODO: It would be nicer to use PackageDeps here so we can be more precise
-- in our checks. That's a bit tricky though, as this currently relies on
-- the 'buildDepends' field of 'PackageDescription'. (OTOH, that field is
-- deprecated and should be removed anyway.)
requiredDeps :: [Dependency]
requiredDeps =
--TODO: use something lower level than finalizePackageDescription
......
......@@ -48,6 +48,7 @@ import Distribution.Package
import Distribution.Compiler
( CompilerId(..) )
import qualified Distribution.PackageDescription as PackageDescription
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.PackageDescription
( PackageDescription )
import Distribution.PackageDescription.Configuration
......@@ -122,7 +123,7 @@ symlinkBinaries comp configFlags installFlags plan =
| (ReadyPackage _ _flags _ deps, pkg, exe) <- exes
, let pkgid = packageId pkg
pkg_key = mkPackageKey (packageKeySupported comp) pkgid
(map Installed.packageKey deps) []
(map Installed.packageKey (CD.flatDeps deps)) []
publicExeName = PackageDescription.exeName exe
privateExeName = prefix ++ publicExeName ++ suffix
prefix = substTemplate pkgid pkg_key prefixTemplate
......
......@@ -70,6 +70,9 @@ import Distribution.InstalledPackageInfo
import Distribution.Simple.Utils
( lowercase, comparing )
import Distribution.Client.ComponentDeps (ComponentDeps)
import qualified Distribution.Client.ComponentDeps as CD
-- | Subclass of packages that have specific versioned dependencies.
--
-- So for example a not-yet-configured package has dependencies on version
......@@ -78,10 +81,10 @@ import Distribution.Simple.Utils
-- dependency graphs) only make sense on this subclass of package types.
--
class Package pkg => PackageFixedDeps pkg where
depends :: pkg -> [InstalledPackageId]
depends :: pkg -> ComponentDeps [InstalledPackageId]
instance PackageFixedDeps (InstalledPackageInfo_ str) where
depends info = installedDepends info
depends = CD.fromInstalled . installedDepends
-- | The collection of information about packages from one or more 'PackageDB's.
--
......
......@@ -40,6 +40,8 @@ import Distribution.Package
import Distribution.Version
( Version )
import Distribution.Client.ComponentDeps (ComponentDeps)
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Client.PackageIndex
( PackageFixedDeps(..) )
import Distribution.Simple.PackageIndex
......@@ -84,8 +86,8 @@ type FakeMap = Map InstalledPackageId InstalledPackageId
-- | Variant of `depends` which accepts a `FakeMap`
--
-- Analogous to `fakeInstalledDepends`. See Note [FakeMap].
fakeDepends :: PackageFixedDeps pkg => FakeMap -> pkg -> [InstalledPackageId]
fakeDepends fakeMap = map resolveFakeId . depends
fakeDepends :: PackageFixedDeps pkg => FakeMap -> pkg -> ComponentDeps [InstalledPackageId]
fakeDepends fakeMap = fmap (map resolveFakeId) . depends
where
resolveFakeId :: InstalledPackageId -> InstalledPackageId
resolveFakeId ipid = Map.findWithDefault ipid ipid fakeMap
......@@ -109,7 +111,7 @@ brokenPackages fakeMap index =
[ (pkg, missing)
| pkg <- allPackages index
, let missing =
[ pkg' | pkg' <- depends pkg
[ pkg' | pkg' <- CD.flatDeps (depends pkg)
, isNothing (fakeLookupInstalledPackageId fakeMap index pkg') ]
, not (null missing) ]
......@@ -186,7 +188,7 @@ dependencyInconsistencies' fakeMap index =
| -- For each package @pkg@
pkg <- allPackages index
-- Find out which @ipid@ @pkg@ depends on
, ipid <- fakeDepends fakeMap pkg
, ipid <- CD.flatDeps (fakeDepends fakeMap pkg)
-- And look up those @ipid@ (i.e., @ipid@ is the ID of @dep@)
, Just dep <- [fakeLookupInstalledPackageId fakeMap index ipid]
]
......@@ -202,8 +204,8 @@ dependencyInconsistencies' fakeMap index =
reallyIsInconsistent [p1, p2] =
let pid1 = installedPackageId p1
pid2 = installedPackageId p2
in Map.findWithDefault pid1 pid1 fakeMap `notElem` fakeDepends fakeMap p2
&& Map.findWithDefault pid2 pid2 fakeMap `notElem` fakeDepends fakeMap p1
in Map.findWithDefault pid1 pid1 fakeMap `notElem` CD.flatDeps (fakeDepends fakeMap p2)
&& Map.findWithDefault pid2 pid2 fakeMap `notElem` CD.flatDeps (fakeDepends fakeMap p1)
reallyIsInconsistent _ = True
......@@ -223,7 +225,7 @@ dependencyCycles :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
dependencyCycles fakeMap index =
[ vs | Graph.CyclicSCC vs <- Graph.stronglyConnComp adjacencyList ]
where
adjacencyList = [ (pkg, installedPackageId pkg, fakeDepends fakeMap pkg)
adjacencyList = [ (pkg, installedPackageId pkg, CD.flatDeps (fakeDepends fakeMap pkg))
| pkg <- allPackages index ]
......@@ -254,7 +256,7 @@ dependencyClosure fakeMap index pkgids0 = case closure mempty [] pkgids0 of
Just _ -> closure completed failed pkgids
Nothing -> closure completed' failed pkgids'
where completed' = insert pkg completed
pkgids' = depends pkg ++ pkgids
pkgids' = CD.flatDeps (depends pkg) ++ pkgids
topologicalOrder :: (PackageFixedDeps pkg, HasInstalledPackageId pkg)
......@@ -320,5 +322,5 @@ dependencyGraph fakeMap index = (graph, vertexToPkg, idToVertex)
resolve pid = Map.findWithDefault pid pid fakeMap
edgesFrom pkg = ( ()
, resolve (installedPackageId pkg)
, fakeDepends fakeMap pkg
, CD.flatDeps (fakeDepends fakeMap pkg)
)
......@@ -27,6 +27,9 @@ import Distribution.PackageDescription.Configuration
( mapTreeData )
import Distribution.Client.PackageIndex
( PackageIndex, PackageFixedDeps(..) )
import Distribution.Client.ComponentDeps
( ComponentDeps )
import qualified Distribution.Client.ComponentDeps as CD
import Distribution.Version
( VersionRange )
import Distribution.Simple.Compiler
......@@ -91,7 +94,8 @@ data ConfiguredPackage = ConfiguredPackage
SourcePackage -- package info, including repo
FlagAssignment -- complete flag assignment for the package
[OptionalStanza] -- list of enabled optional stanzas for the package
[ConfiguredId] -- set of exact dependencies (installed or source).
(ComponentDeps [ConfiguredId])
-- set of exact dependencies (installed or source).
-- These must be consistent with the 'buildDepends'
-- in the 'PackageDescription' that you'd get by
-- applying the flag assignment and optional stanzas.
......@@ -121,7 +125,7 @@ instance Package ConfiguredPackage where
packageId (ConfiguredPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ConfiguredPackage where
depends (ConfiguredPackage _ _ _ deps) = map confInstId deps
depends (ConfiguredPackage _ _ _ deps) = fmap (map confInstId) deps
instance HasInstalledPackageId ConfiguredPackage where
installedPackageId = fakeInstalledPackageId . packageId
......@@ -129,17 +133,17 @@ 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] --
[InstalledPackageInfo] -- Installed dependencies.
SourcePackage -- see 'ConfiguredPackage'.
FlagAssignment --
[OptionalStanza] --
(ComponentDeps [InstalledPackageInfo]) -- Installed dependencies.
deriving Show
instance Package ReadyPackage where
packageId (ReadyPackage pkg _ _ _) = packageId pkg
instance PackageFixedDeps ReadyPackage where
depends (ReadyPackage _ _ _ deps) = map installedPackageId deps
depends (ReadyPackage _ _ _ deps) = fmap (map installedPackageId) deps
instance HasInstalledPackageId ReadyPackage where
installedPackageId = fakeInstalledPackageId . packageId
......@@ -150,7 +154,7 @@ instance HasInstalledPackageId ReadyPackage where
readyPackageKey :: Compiler -> ReadyPackage -> PackageKey
readyPackageKey comp (ReadyPackage pkg _ _ deps) =
mkPackageKey (packageKeySupported comp) (packageId pkg)
(map Info.packageKey deps) []
(map Info.packageKey (CD.flatDeps deps)) []
-- | Sometimes we need to convert a 'ReadyPackage' back to a
......@@ -158,7 +162,7 @@ readyPackageKey comp (ReadyPackage pkg _ _ deps) =
-- Ready or Configured.
readyPackageToConfiguredPackage :: ReadyPackage -> ConfiguredPackage
readyPackageToConfiguredPackage (ReadyPackage srcpkg flags stanzas deps) =
ConfiguredPackage srcpkg flags stanzas (map aux deps)
ConfiguredPackage srcpkg flags stanzas (fmap (map aux) deps)
where
aux :: InstalledPackageInfo -> ConfiguredId
aux info = ConfiguredId {
......
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