Solver: Support dependencies on sub-libraries (issue haskell#6039).

This commit tracks dependencies on sub-libraries by extending the functionality
for tracking executables that was added in
e86f838.  It also starts adding support for
library visibility, though it currently only works for source packages.  There
is a TODO for handling installed packages.

Fixes haskell#6038.

cabal-install/Distribution/Solver/Modular/Dependency.hs

@@ -52,6 +52,7 @@ import qualified Distribution.Solver.Modular.ConflictSet as CS
 
 import Distribution.Solver.Types.ComponentDeps (Component(..))
 import Distribution.Solver.Types.PackagePath
+import Distribution.Types.LibraryName
 import Distribution.Types.PkgconfigVersionRange
 import Distribution.Types.UnqualComponentName
 
@@ -128,7 +129,9 @@ data PkgComponent qpn = PkgComponent qpn ExposedComponent
 
 -- | A component that can be depended upon by another package, i.e., a library
 -- or an executable.
-data ExposedComponent = ExposedLib | ExposedExe UnqualComponentName
+data ExposedComponent =
+    ExposedLib LibraryName
+  | ExposedExe UnqualComponentName
   deriving (Eq, Ord, Show)
 
 -- | The reason that a dependency is active. It identifies the package and any
@@ -182,7 +185,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
     -- Suppose package B has a setup dependency on package A.
     -- This will be recorded as something like
     --
-    -- > LDep (DependencyReason "B") (Dep (PkgComponent "A" ExposedLib) (Constrained AnyVersion))
+    -- > LDep (DependencyReason "B") (Dep (PkgComponent "A" (ExposedLib LMainLibName)) (Constrained AnyVersion))
     --
     -- Observe that when we qualify this dependency, we need to turn that
     -- @"A"@ into @"B-setup.A"@, but we should not apply that same qualifier
@@ -196,7 +199,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go
     goD (Pkg pkn vr)  _    = Pkg pkn vr
     goD (Dep dep@(PkgComponent qpn (ExposedExe _)) ci) _ =
         Dep (Q (PackagePath ns (QualExe pn qpn)) <$> dep) ci
-    goD (Dep dep@(PkgComponent qpn ExposedLib) ci) comp
+    goD (Dep dep@(PkgComponent qpn (ExposedLib _)) ci) comp
       | qBase qpn   = Dep (Q (PackagePath ns (QualBase  pn)) <$> dep) ci
       | qSetup comp = Dep (Q (PackagePath ns (QualSetup pn)) <$> dep) ci
       | otherwise   = Dep (Q (PackagePath ns inheritedQ    ) <$> dep) ci

cabal-install/Distribution/Solver/Modular/Index.hs

@@ -1,6 +1,7 @@
 module Distribution.Solver.Modular.Index
     ( Index
     , PInfo(..)
+    , ComponentInfo(..)
     , IsBuildable(..)
     , defaultQualifyOptions
     , mkIndex
@@ -14,6 +15,7 @@ import Distribution.Solver.Modular.Dependency
 import Distribution.Solver.Modular.Flag
 import Distribution.Solver.Modular.Package
 import Distribution.Solver.Modular.Tree
+import Distribution.Types.LibraryVisibility
 
 -- | An index contains information about package instances. This is a nested
 -- dictionary. Package names are mapped to instances, which in turn is mapped
@@ -28,10 +30,20 @@ type Index = Map PN (Map I PInfo)
 -- globally, for reasons external to the solver. We currently use this
 -- for shadowing which essentially is a GHC limitation, and for
 -- installed packages that are broken.
-data PInfo = PInfo (FlaggedDeps PN) (Map ExposedComponent IsBuildable) FlagInfo (Maybe FailReason)
+data PInfo = PInfo (FlaggedDeps PN)
+                   (Map ExposedComponent ComponentInfo)
+                   FlagInfo
+                   (Maybe FailReason)
+
+-- | Info associated with each library and executable in a package instance.
+data ComponentInfo = ComponentInfo {
+    compVisibility  :: LibraryVisibility
+  , compIsBuildable :: IsBuildable
+  }
 
 -- | Whether a component is made unbuildable by a "buildable: False" field.
 newtype IsBuildable = IsBuildable Bool
+  deriving Eq
 
 mkIndex :: [(PN, I, PInfo)] -> Index
 mkIndex xs = M.map M.fromList (groupMap (L.map (\ (pn, i, pi) -> (pn, (i, pi))) xs))

cabal-install/Distribution/Solver/Modular/IndexConversion.hs

@@ -26,6 +26,7 @@ import Distribution.PackageDescription.Configuration as PDC
 import qualified Distribution.Simple.PackageIndex as SI
 import Distribution.System
 import Distribution.Types.ForeignLib
+import Distribution.Types.LibraryVisibility
 
 import           Distribution.Solver.Types.ComponentDeps
                    ( Component(..), componentNameToComponent )
@@ -93,11 +94,18 @@ convIP :: SI.InstalledPackageIndex -> InstalledPackageInfo -> (PN, I, PInfo)
 convIP idx ipi =
   case mapM (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of
         Nothing  -> (pn, i, PInfo [] M.empty M.empty (Just Broken))
-        Just fds -> ( pn
-                    , i
-                    , PInfo fds (M.singleton ExposedLib (IsBuildable True)) M.empty Nothing)
+        Just fds -> ( pn, i, PInfo fds components M.empty Nothing)
  where
+  -- TODO: Handle sub-libraries and visibility.
+  components =
+      M.singleton (ExposedLib LMainLibName)
+                  ComponentInfo {
+                      compVisibility = LibraryVisibilityPublic
+                    , compIsBuildable = IsBuildable True
+                    }
+
   (pn, i) = convId ipi
+
   -- 'sourceLibName' is unreliable, but for now we only really use this for
   -- primary libs anyways
   comp = componentNameToComponent $ CLibName $ sourceLibName ipi
@@ -141,7 +149,8 @@ convIPId dr comp idx ipid =
   case SI.lookupUnitId idx ipid of
     Nothing  -> Nothing
     Just ipi -> let (pn, i) = convId ipi
-                in  Just (D.Simple (LDep dr (Dep (PkgComponent pn ExposedLib) (Fixed i))) comp)
+                    name = ExposedLib LMainLibName  -- TODO: Handle sub-libraries.
+                in  Just (D.Simple (LDep dr (Dep (PkgComponent pn name) (Fixed i))) comp)
                 -- NB: something we pick up from the
                 -- InstalledPackageIndex is NEVER an executable
 
@@ -236,12 +245,29 @@ convGPD os arch cinfo constraints strfl solveExes pn
     fr | reqSpecVer > maxSpecVer = Just (UnsupportedSpecVer reqSpecVer)
        | otherwise               = Nothing
 
-    components :: Map ExposedComponent IsBuildable
-    components = M.fromList $ libComps ++ exeComps
+    components :: Map ExposedComponent ComponentInfo
+    components = M.fromList $ libComps ++ subLibComps ++ exeComps
       where
-        libComps = [ (ExposedLib, IsBuildable $ isBuildable libBuildInfo lib)
+        libComps = [ ( ExposedLib LMainLibName
+                     , ComponentInfo {
+                           compVisibility = PD.libVisibility (condTreeData lib)
+                         , compIsBuildable = isBuildable libBuildInfo lib
+                         }
+                     )
                    | lib <- maybeToList mlib ]
-        exeComps = [ (ExposedExe name, IsBuildable $ isBuildable buildInfo exe)
+        subLibComps = [ ( ExposedLib (LSubLibName name)
+                        , ComponentInfo {
+                             compVisibility = PD.libVisibility (condTreeData lib)
+                           , compIsBuildable = isBuildable libBuildInfo lib
+                           }
+                        )
+                      | (name, lib) <- sub_libs ]
+        exeComps = [ ( ExposedExe name
+                     , ComponentInfo {
+                           compVisibility = LibraryVisibilityPublic
+                         , compIsBuildable = isBuildable buildInfo exe
+                         }
+                     )
                    | (name, exe) <- exes ]
         isBuildable = isBuildableComponent os arch cinfo constraints
 
@@ -259,11 +285,11 @@ isBuildableComponent :: OS
                      -> [LabeledPackageConstraint]
                      -> (a -> BuildInfo)
                      -> CondTree ConfVar [Dependency] a
-                     -> Bool
+                     -> IsBuildable
 isBuildableComponent os arch cinfo constraints getInfo tree =
     case simplifyCondition $ extractCondition (buildable . getInfo) tree of
-      Lit False -> False
-      _         -> True
+      Lit False -> IsBuildable False
+      _         -> IsBuildable True
   where
     flagAssignment :: [(FlagName, Bool)]
     flagAssignment =
@@ -355,8 +381,10 @@ convCondTree flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes@(Solv
              -- duplicates could grow exponentially from the leaves to the root
              -- of the tree.
              mergeSimpleDeps $
-                 L.map (\d -> D.Simple (convLibDep dr d) comp)
-                       (mapMaybe (filterIPNs ipns) ds)                                -- unconditional package dependencies
+                 [ D.Simple singleDep comp
+                 | dep <- mapMaybe (filterIPNs ipns) ds
+                 , singleDep <- convLibDeps dr dep ]  -- unconditional package dependencies
+
               ++ L.map (\e -> D.Simple (LDep dr (Ext  e)) comp) (PD.allExtensions bi) -- unconditional extension dependencies
               ++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (PD.allLanguages  bi) -- unconditional language dependencies
               ++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies
@@ -560,9 +588,12 @@ unionDRs :: DependencyReason pn -> DependencyReason pn -> DependencyReason pn
 unionDRs (DependencyReason pn' fs1 ss1) (DependencyReason _ fs2 ss2) =
     DependencyReason pn' (M.union fs1 fs2) (S.union ss1 ss2)
 
--- | Convert a Cabal dependency on a library to a solver-specific dependency.
-convLibDep :: DependencyReason PN -> Dependency -> LDep PN
-convLibDep dr (Dependency pn vr _) = LDep dr $ Dep (PkgComponent pn ExposedLib) (Constrained vr)
+-- | Convert a Cabal dependency on a set of library components (from a single
+-- package) to solver-specific dependencies.
+convLibDeps :: DependencyReason PN -> Dependency -> [LDep PN]
+convLibDeps dr (Dependency pn vr libs) =
+    [ LDep dr $ Dep (PkgComponent pn (ExposedLib lib)) (Constrained vr)
+    | lib <- S.toList libs ]
 
 -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency.
 convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN
@@ -571,5 +602,6 @@ convExeDep dr (ExeDependency pn exe vr) = LDep dr $ Dep (PkgComponent pn (Expose
 -- | Convert setup dependencies
 convSetupBuildInfo :: PN -> SetupBuildInfo -> FlaggedDeps PN
 convSetupBuildInfo pn nfo =
-    L.map (\d -> D.Simple (convLibDep (DependencyReason pn M.empty S.empty) d) ComponentSetup)
-          (PD.setupDepends nfo)
+    [ D.Simple singleDep ComponentSetup
+    | dep <- PD.setupDepends nfo
+    , singleDep <- convLibDeps (DependencyReason pn M.empty S.empty) dep ]

cabal-install/Distribution/Solver/Modular/Message.hs

@@ -19,6 +19,7 @@ import Distribution.Solver.Modular.Version
 import Distribution.Solver.Types.ConstraintSource
 import Distribution.Solver.Types.PackagePath
 import Distribution.Solver.Types.Progress
+import Distribution.Types.LibraryName
 import Distribution.Types.UnqualComponentName
 
 data Message =
@@ -108,8 +109,10 @@ showFR _ (MissingPkgconfigPackage pn vr)  = " (conflict: pkg-config package " ++
 showFR _ (NewPackageDoesNotMatchExistingConstraint d) = " (conflict: " ++ showConflictingDep d ++ ")"
 showFR _ (ConflictingConstraints d1 d2)   = " (conflict: " ++ L.intercalate ", " (L.map showConflictingDep [d1, d2]) ++ ")"
 showFR _ (NewPackageIsMissingRequiredComponent comp dr) = " (does not contain " ++ showExposedComponent comp ++ ", which is required by " ++ showDependencyReason dr ++ ")"
+showFR _ (NewPackageHasPrivateRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is private, but it is required by " ++ showDependencyReason dr ++ ")"
 showFR _ (NewPackageHasUnbuildableRequiredComponent comp dr) = " (" ++ showExposedComponent comp ++ " is not buildable in the current environment, but it is required by " ++ showDependencyReason dr ++ ")"
 showFR _ (PackageRequiresMissingComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component does not exist)"
+showFR _ (PackageRequiresPrivateComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is private)"
 showFR _ (PackageRequiresUnbuildableComponent qpn comp) = " (requires " ++ showExposedComponent comp ++ " from " ++ showQPN qpn ++ ", but the component is not buildable in the current environment)"
 showFR _ CannotInstall                    = " (only already installed instances can be used)"
 showFR _ CannotReinstall                  = " (avoiding to reinstall a package with same version but new dependencies)"
@@ -135,8 +138,9 @@ showFR _ (MalformedStanzaChoice qsn)      = " (INTERNAL ERROR: MALFORMED STANZA
 showFR _ EmptyGoalChoice                  = " (INTERNAL ERROR: EMPTY GOAL CHOICE)"
 
 showExposedComponent :: ExposedComponent -> String
-showExposedComponent ExposedLib = "library"
-showExposedComponent (ExposedExe name) = "executable '" ++ unUnqualComponentName name ++ "'"
+showExposedComponent (ExposedLib LMainLibName)       = "library"
+showExposedComponent (ExposedLib (LSubLibName name)) = "library '" ++ unUnqualComponentName name ++ "'"
+showExposedComponent (ExposedExe name)               = "executable '" ++ unUnqualComponentName name ++ "'"
 
 constraintSource :: ConstraintSource -> String
 constraintSource src = "constraint from " ++ showConstraintSource src
@@ -145,8 +149,9 @@ showConflictingDep :: ConflictingDep -> String
 showConflictingDep (ConflictingDep dr (PkgComponent qpn comp) ci) =
   let DependencyReason qpn' _ _ = dr
       componentStr = case comp of
-                       ExposedExe exe -> " (exe " ++ unUnqualComponentName exe ++ ")"
-                       ExposedLib     -> ""
+                       ExposedExe exe               -> " (exe " ++ unUnqualComponentName exe ++ ")"
+                       ExposedLib LMainLibName      -> ""
+                       ExposedLib (LSubLibName lib) -> " (lib " ++ unUnqualComponentName lib ++ ")"
   in case ci of
        Fixed i        -> (if qpn /= qpn' then showDependencyReason dr ++ " => " else "") ++
                          showQPN qpn ++ componentStr ++ "==" ++ showI i

cabal-install/Distribution/Solver/Modular/Tree.hs

@@ -102,8 +102,10 @@ data FailReason = UnsupportedExtension Extension
                 | NewPackageDoesNotMatchExistingConstraint ConflictingDep
                 | ConflictingConstraints ConflictingDep ConflictingDep
                 | NewPackageIsMissingRequiredComponent ExposedComponent (DependencyReason QPN)
+                | NewPackageHasPrivateRequiredComponent ExposedComponent (DependencyReason QPN)
                 | NewPackageHasUnbuildableRequiredComponent ExposedComponent (DependencyReason QPN)
                 | PackageRequiresMissingComponent QPN ExposedComponent
+                | PackageRequiresPrivateComponent QPN ExposedComponent
                 | PackageRequiresUnbuildableComponent QPN ExposedComponent
                 | CannotInstall
                 | CannotReinstall