feature: Private Dependencies

This commit introduces so-called "private dependencies".

High-level Overview
~~~~~~~~~~~~~~~~~~~
Since its inception, Cabal has enforced the restriction that a library
must only link against one version of each package it depends on. This
ensures that all of the dependencies in the build plan work together. In
your application you use different libraries together, so it’s of
paramount importance that they all agree on what `Text` means or what a
`ByteString` is.

However, sometimes it’s desirable to allow multiple versions of the same
library into a build plan. In this case, it’s desirable to allow a
library author to specify a private dependency with the promise that its
existence will not leak from the interface of the library which uses it.

The two main use cases of private dependencies are:

  - Writing benchmarks and testsuites for your library which test new
    versions of your library against old versions.

  - Writing libraries which can communicate with processes built against
    a range of different library versions (such as cabal-install calling
    ./Setup).

A user specifies a private dependency in their cabal file using
`private-build-depends`. The specification starts with the name of the
private dependency scope and then contains a list of normal dependency
specifications which dictates what is included in that private scope:

    private-build-depends: TEXT1 with (text == 1.2.*), TEXT2 with (text == 2.*)

Each private scope is then solved independently of all other scopes. In
this example the TEXT1 scope can choose a version of text in the 1.2.x
range and the TEXT2 scope can choose a version of text in the 2.* range.

Private scopes do not apply transitively, so the dependencies of text
will be solved in the normal top-level scope. If your program contains a
value of type Bool, that comes from the base package, which text depends
on, because the scopes are not applied transitively the same Bool value
can be passed to functions from the TEXT1 scope and TEXT2 scope.

Dependencies introduced privately can be imported into modules in the
project by prefixing the name of the private scope to an exposed module
name.

    import qualified TEXT1.Data.Text as T1
    import qualified TEXT2.Data.Text as T2

Closure of Private Scopes
~~~~~~~~~~~~~~~~~~~~~~~~~

Private dependency scopes can contain multiple packages. Packages in the
same scope are solved together. For example, if two packages are tightly
coupled and you need to use compatible versions with each other, then
you can list them in the same private scope. Such packages will then be
solved together, but independently of other packages.

Private scopes must be closed. A scope is closed if, whenever we have a
dependency chain P1 -> Q -> P2, in which P1 and P2 are both in a given
private scope S, then Q also belongs to the private scope S. The solver
checks this property, but doesn’t implicitly add packages into a private
scope.

Implementation
~~~~~~~~~~~~~~
To implement private dependencies we changed

* Cabal-syntax to introduce the new `private-build-depends: ALIAS (packages, in, private, scope)` syntax.
  See the new type `Dependencies` and changes in `Distribution.Types.Dependency`.

* cabal-install-solver now considers both public and private
  dependencies of a given package (see e.g. `solverPkgLibDeps`), has
  a new constructor `PrivateScope` in `ConstraintScope` for goals in a
  private scope, and there's a new `Qualifier` for packages introduced
  in private scopes (see also [Namespace vs Qualifier refactor] below),
  to solve them separately from packages introduced by `build-depends`.

* cabal-install-solver needs to check that the private-scope closure
  property holds (the closure of the packages in a private scope is in
  the private scope) (see `Distribution.Solver.Modular.PrivateScopeClosure`).

  We check that the closure holds by looking at the reverse dependency
  map while traversing down the tree, at every node:

  For every package in a private scope, traverse up the reverse
  dependency map until a package in the same private scope is found.
  If one exists, and if along the way up any package was not in the same
  private scope as the packages in the two ends, we fail.

* cabal-install understands plans with private dependencies and has a
  new `UserQualifier` to support constrainting packages in private
  scopes using the `--constraint` flag.
  Example: `--constraint=private.pkg-a.TEXT01:text == 1.2.*`

* Cabal the library uses the ghc module-renaming mechanism (also used by
  Backpack) to rename modules from the packages in a private scope to
  prefix them with the private scope alias. It also ensures `cabal
  check` fails if there exist the package has private dependencies, as
  it is currently an experimental feature which we don't necessarily
  want to allow in hackage yet -- e.g. how will haddock render private
  dependencies?

Namespace vs Qualifier refactor
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We also refactored the `Namespace` vs `Qualifier` types in the solver,
clarifying their interaction such that:

* A package goal with an indepedent namespace is fully solved
  indepently from other namespaces, i.e. all the dependency goals
  introduced by a goal in a given namespace are also solved in that
  namespace.

* In contrast, a package goal with a qualifier is shallow-solved
  separately from other goals in the same namespace. The dependency
  goals introduced by it will be solved unqualified (`QualTopLevel`) in
  that namespace.

For example, goal `pkg-a == 0.1` in `DefaultNamespace+QualTopLevel`, and
goal `pkg-a == 0.2` in the same namespace but with `QualAlias A2 ...`
can be solved together and yield a different version of pkg-a for each
of the goals, however, the dependencies of both will be solved together
-- if they both dependend on `base`, we'd have to find a single
solution. If `pkg-a == 0.2` was in an `Independent` namespace, we could
still solve the two goals with two versions of `pkg-a`, but we could
also pick different versions for all the subdependencies of `pkg-a ==
0.2`.

Besides Namespace vs Qualifier being a welcome refactor that facilitates
implementing private dependencies, it also fixes haskell#9466 and helps with haskell#9467.

---

Co-authored-by: Rodrigo Mesquita <[email protected]>

Author: mpickering

Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

@@ -208,6 +208,23 @@ instance Arbitrary Dependency where
         | (pn', vr', lb') <- shrink (pn, vr, lb)
         ]
 
+-------------------------------------------------------------------------------
+-- Private Dependency
+-------------------------------------------------------------------------------
+
+instance Arbitrary PrivateAlias where
+  arbitrary = PrivateAlias <$> arbitrary
+  shrink (PrivateAlias al) = PrivateAlias <$> shrink al
+instance Arbitrary PrivateDependency where
+    arbitrary = PrivateDependency
+        <$> arbitrary
+        <*> arbitrary
+
+    shrink (PrivateDependency al dps) =
+        [ PrivateDependency al' dps'
+        | (al', dps') <- shrink (al, dps)
+        ]
+
 -------------------------------------------------------------------------------
 -- PackageVersionConstraint
 -------------------------------------------------------------------------------

Cabal-described/src/Distribution/Described.hs

@@ -76,7 +76,7 @@ import Distribution.Types.AbiDependency            (AbiDependency)
 import Distribution.Types.AbiHash                  (AbiHash)
 import Distribution.Types.BenchmarkType            (BenchmarkType)
 import Distribution.Types.BuildType                (BuildType)
-import Distribution.Types.Dependency               (Dependency)
+import Distribution.Types.Dependency               (Dependency, PrivateAlias(..), PrivateDependency)
 import Distribution.Types.ExecutableScope          (ExecutableScope)
 import Distribution.Types.ExeDependency            (ExeDependency)
 import Distribution.Types.ExposedModule            (ExposedModule)
@@ -391,6 +391,19 @@ instance Described Dependency where
       where
         vr = RENamed "version-range" (describe (Proxy :: Proxy VersionRange))
 
+instance Described PrivateDependency where
+    describe _ = REAppend
+        [ RENamed "alias" (describe (Proxy :: Proxy PrivateAlias))
+        , RESpaces1
+        , "with"
+        , RESpaces1
+        , reChar '('
+        , RESpaces
+        , REMunch reSpacedComma (describe (Proxy :: Proxy Dependency))
+        , RESpaces
+        , reChar ')'
+        ]
+
 instance Described ExecutableScope where
     describe _ = REUnion ["public","private"]
 
@@ -446,6 +459,9 @@ instance Described ModuleName where
     describe _ = REMunch1 (reChar '.') component where
         component = RECharSet csUpper <> REMunch reEps (REUnion [RECharSet csAlphaNum, RECharSet (fromString "_'")])
 
+instance Described PrivateAlias where
+  describe _ = describe (Proxy :: Proxy ModuleName)
+
 instance Described ModuleReexport where
     describe _ = RETodo
 

Cabal-syntax/Cabal-syntax.cabal

@@ -135,6 +135,7 @@ library
     Distribution.Types.Condition
     Distribution.Types.ConfVar
     Distribution.Types.Dependency
+    Distribution.Types.Dependency.Lens
     Distribution.Types.DependencyMap
     Distribution.Types.ExeDependency
     Distribution.Types.Executable

Cabal-syntax/src/Distribution/ModuleName.hs

@@ -18,6 +18,7 @@ module Distribution.ModuleName
   ( ModuleName
   , fromString
   , fromComponents
+  , combineModuleName
   , components
   , toFilePath
   , main
@@ -99,12 +100,6 @@ validModuleComponent (c : cs) = isUpper c && all validModuleChar cs
 instance IsString ModuleName where
   fromString = ModuleName . toShortText
 
--- | Construct a 'ModuleName' from valid module components, i.e. parts
--- separated by dots.
-fromComponents :: [String] -> ModuleName
-fromComponents comps = fromString (intercalate "." comps)
-{-# DEPRECATED fromComponents "Exists for cabal-install only" #-}
-
 -- | The module name @Main@.
 main :: ModuleName
 main = ModuleName (fromString "Main")
@@ -119,6 +114,19 @@ components mn = split (unModuleName mn)
       (chunk, []) -> chunk : []
       (chunk, _ : rest) -> chunk : split rest
 
+-- | Construct a 'ModuleName' from valid module components, i.e. parts
+-- separated by dots.
+--
+-- Inverse of 'components', i.e. @fromComponents (components x) = x@
+fromComponents :: [String] -> ModuleName
+fromComponents comps = fromString (intercalate "." comps)
+{-# DEPRECATED fromComponents "Exists for cabal-install only" #-}
+
+-- | Append one valid module name onto another valid module name
+-- This is used when adding the module suffix to private dependencies
+combineModuleName :: ModuleName -> ModuleName -> ModuleName
+combineModuleName mn1 mn2 = fromComponents (components mn1 ++ components mn2)
+
 -- | Convert a module name to a file path, but without any file extension.
 -- For example:
 --

Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs

@@ -31,7 +31,6 @@ module Distribution.PackageDescription.Configuration
   , mapTreeConstrs
   , transformAllBuildInfos
   , transformAllBuildDepends
-  , transformAllBuildDependsN
   , simplifyWithSysParams
   ) where
 
@@ -63,6 +62,7 @@ import Distribution.Version
 
 import qualified Data.Map.Lazy as Map
 import Data.Tree (Tree (Node))
+import qualified Distribution.Types.Dependency.Lens as L
 
 ------------------------------------------------------------------------------
 
@@ -189,10 +189,10 @@ resolveWithFlags
   -- ^ Compiler information
   -> [PackageVersionConstraint]
   -- ^ Additional constraints
-  -> [CondTree ConfVar [Dependency] PDTagged]
-  -> ([Dependency] -> DepTestRslt [Dependency])
+  -> [CondTree ConfVar Dependencies PDTagged]
+  -> (Dependencies -> DepTestRslt Dependencies)
   -- ^ Dependency test function.
-  -> Either [Dependency] (TargetSet PDTagged, FlagAssignment)
+  -> Either Dependencies (TargetSet PDTagged, FlagAssignment)
   -- ^ Either the missing dependencies (error case), or a pair of
   -- (set of build targets with dependencies, chosen flag assignments)
 resolveWithFlags dom enabled os arch impl constrs trees checkDeps =
@@ -324,7 +324,7 @@ extractConditions f gpkg =
     ]
 
 -- | A map of package constraints that combines version ranges using 'unionVersionRanges'.
-newtype DepMapUnion = DepMapUnion {unDepMapUnion :: Map PackageName (VersionRange, NonEmptySet LibraryName)}
+newtype DepMapUnion = DepMapUnion {unDepMapUnion :: Map (PackageName, IsPrivate) (VersionRange, NonEmptySet LibraryName)}
 
 instance Semigroup DepMapUnion where
   DepMapUnion x <> DepMapUnion y =
@@ -337,12 +337,22 @@ unionVersionRanges'
   -> (VersionRange, NonEmptySet LibraryName)
 unionVersionRanges' (vr, cs) (vr', cs') = (unionVersionRanges vr vr', cs <> cs')
 
-toDepMapUnion :: [Dependency] -> DepMapUnion
+toDepMapUnion :: Dependencies -> DepMapUnion
 toDepMapUnion ds =
-  DepMapUnion $ Map.fromListWith unionVersionRanges' [(p, (vr, cs)) | Dependency p vr cs <- ds]
+  DepMapUnion $
+    Map.fromListWith
+      unionVersionRanges'
+      ( [((p, Public), (vr, cs)) | Dependency p vr cs <- publicDependencies ds]
+          ++ [((p, Private (private_alias d)), (vr, cs)) | d <- privateDependencies ds, Dependency p vr cs <- private_depends d]
+      )
 
-fromDepMapUnion :: DepMapUnion -> [Dependency]
-fromDepMapUnion m = [Dependency p vr cs | (p, (vr, cs)) <- Map.toList (unDepMapUnion m)]
+fromDepMapUnion :: DepMapUnion -> Dependencies
+fromDepMapUnion m =
+  Dependencies
+    [Dependency p vr cs | ((p, Public), (vr, cs)) <- Map.toList (unDepMapUnion m)]
+    [PrivateDependency alias deps | (alias, deps) <- Map.toList priv_deps]
+  where
+    priv_deps = Map.fromListWith (++) [(sn, [Dependency p vr cs]) | ((p, Private sn), (vr, cs)) <- Map.toList (unDepMapUnion m)]
 
 freeVars :: CondTree ConfVar c a -> [FlagName]
 freeVars t = [f | PackageFlag f <- freeVars' t]
@@ -400,8 +410,9 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets
         | otherwise -> (mb_lib, (n, redoBD c) : comps)
       (PDNull, x) -> x -- actually this should not happen, but let's be liberal
       where
+        deps = fromDepMap depMap
         redoBD :: L.HasBuildInfo a => a -> a
-        redoBD = set L.targetBuildDepends $ fromDepMap depMap
+        redoBD = set L.targetPrivateBuildDepends (privateDependencies deps) . set L.targetBuildDepends (publicDependencies deps)
 
 ------------------------------------------------------------------------------
 -- Convert GenericPackageDescription to PackageDescription
@@ -453,7 +464,7 @@ finalizePD
   :: FlagAssignment
   -- ^ Explicitly specified flag assignments
   -> ComponentRequestedSpec
-  -> (Dependency -> Bool)
+  -> (Maybe PrivateAlias -> Dependency -> Bool)
   -- ^ Is a given dependency satisfiable from the set of
   -- available packages?  If this is unknown then use
   -- True.
@@ -465,7 +476,7 @@ finalizePD
   -- ^ Additional constraints
   -> GenericPackageDescription
   -> Either
-      [Dependency]
+      Dependencies
       (PackageDescription, FlagAssignment)
   -- ^ Either missing dependencies or the resolved package
   -- description along with the flag assignments chosen.
@@ -526,8 +537,11 @@ finalizePD
           | otherwise -> [b, not b]
       -- flagDefaults = map (\(n,x:_) -> (n,x)) flagChoices
       check ds =
-        let missingDeps = filter (not . satisfyDep) ds
-         in if null missingDeps
+        let missingDeps =
+              Dependencies
+                (filter (not . satisfyDep Nothing) (publicDependencies ds))
+                (mapMaybe (\(PrivateDependency priv pds) -> case filter (not . satisfyDep (Just priv)) pds of [] -> Nothing; pds' -> Just (PrivateDependency priv pds')) (privateDependencies ds))
+         in if null (publicDependencies missingDeps) && null (privateDependencies missingDeps)
               then DepOk
               else MissingDeps missingDeps
 
@@ -652,19 +666,9 @@ transformAllBuildDepends
   -> GenericPackageDescription
   -> GenericPackageDescription
 transformAllBuildDepends f =
-  over (L.traverseBuildInfos . L.targetBuildDepends . traverse) f
+  over (L.traverseBuildInfos . L.targetPrivateBuildDepends . traverse . L.private_depends . traverse) f
+    . over (L.traverseBuildInfos . L.targetBuildDepends . traverse) f
     . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends . traverse) f
     -- cannot be point-free as normal because of higher rank
-    . over (\f' -> L.allCondTrees $ traverseCondTreeC f') (map f)
+    . over (\f' -> L.allCondTrees $ traverseCondTreeC f') (mapDependencies f)
 
--- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
--- @build-depends@ fields.
-transformAllBuildDependsN
-  :: ([Dependency] -> [Dependency])
-  -> GenericPackageDescription
-  -> GenericPackageDescription
-transformAllBuildDependsN f =
-  over (L.traverseBuildInfos . L.targetBuildDepends) f
-    . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends) f
-    -- cannot be point-free as normal because of higher rank
-    . over (\f' -> L.allCondTrees $ traverseCondTreeC f') f

Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs

@@ -171,6 +171,7 @@ libraryFieldGrammar
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
      , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List CommaVCat (Identity ModuleReexport) ModuleReexport)
      , c (List FSep (MQuoted Extension) Extension)
@@ -220,6 +221,7 @@ foreignLibFieldGrammar
      , c (List CommaFSep (Identity ExeDependency) ExeDependency)
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Dependency) Dependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List FSep (Identity ForeignLibOption) ForeignLibOption)
@@ -260,6 +262,7 @@ executableFieldGrammar
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
      , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List FSep (MQuoted Extension) Extension)
      , c (List FSep (MQuoted Language) Language)
@@ -336,6 +339,7 @@ testSuiteFieldGrammar
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
      , c (List CommaFSep Token String)
      , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List FSep (MQuoted Extension) Extension)
      , c (List FSep (MQuoted Language) Language)
@@ -480,6 +484,7 @@ benchmarkFieldGrammar
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
      , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List FSep (MQuoted Extension) Extension)
      , c (List FSep (MQuoted Language) Language)
@@ -582,6 +587,7 @@ buildInfoFieldGrammar
      , c (List CommaFSep (Identity LegacyExeDependency) LegacyExeDependency)
      , c (List CommaFSep (Identity PkgconfigDependency) PkgconfigDependency)
      , c (List CommaVCat (Identity Dependency) Dependency)
+     , c (List CommaVCat (Identity PrivateDependency) PrivateDependency)
      , c (List CommaVCat (Identity Mixin) Mixin)
      , c (List FSep (MQuoted Extension) Extension)
      , c (List FSep (MQuoted Language) Language)
@@ -676,6 +682,7 @@ buildInfoFieldGrammar =
     <*> pure mempty -- static-options ???
     <*> prefixedFields "x-" L.customFieldsBI
     <*> monoidalFieldAla "build-depends" formatDependencyList L.targetBuildDepends
+    <*> monoidalFieldAla "private-build-depends" formatPrivateDependencyList L.targetPrivateBuildDepends
     <*> monoidalFieldAla "mixins" formatMixinList L.mixins
       ^^^ availableSince CabalSpecV2_0 []
 {-# SPECIALIZE buildInfoFieldGrammar :: ParsecFieldGrammar' BuildInfo #-}
@@ -800,6 +807,9 @@ setupBInfoFieldGrammar def =
 formatDependencyList :: [Dependency] -> List CommaVCat (Identity Dependency) Dependency
 formatDependencyList = alaList CommaVCat
 
+formatPrivateDependencyList :: [PrivateDependency] -> List CommaVCat (Identity PrivateDependency) PrivateDependency
+formatPrivateDependencyList = alaList CommaVCat
+
 formatMixinList :: [Mixin] -> List CommaVCat (Identity Mixin) Mixin
 formatMixinList = alaList CommaVCat