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.

Author: edsko

cabal-install/Distribution/Client/BuildReports/Storage.hs

@@ -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 )
 

cabal-install/Distribution/Client/Configure.hs

@@ -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,

cabal-install/Distribution/Client/Dependency/Modular/ConfiguredConversion.hs

@@ -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

cabal-install/Distribution/Client/Dependency/TopDown.hs

@@ -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

cabal-install/Distribution/Client/Dependency/TopDown/Types.hs

@@ -10,13 +10,15 @@
 --
 -- Types for the top-down dependency resolver.
 -----------------------------------------------------------------------------
+{-# LANGUAGE CPP #-}
 module Distribution.Client.Dependency.TopDown.Types where
 
 import Distribution.Client.Types
          ( SourcePackage(..), ReadyPackage(..), InstalledPackage(..)
          , 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

cabal-install/Distribution/Client/Install.hs

@@ -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,

cabal-install/Distribution/Client/InstallPlan.hs

@@ -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,31 +615,40 @@ 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') $
         version `withinRange` versionRange
 
     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

cabal-install/Distribution/Client/InstallSymlink.hs

@@ -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

cabal-install/Distribution/Client/PackageIndex.hs

@@ -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.
 --

cabal-install/Distribution/Client/PlanIndex.hs

@@ -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)
                     )