Skip to content

Commit

Permalink
feature: Private Dependencies
Browse files Browse the repository at this point in the history
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]>
  • Loading branch information
mpickering and alt-romes committed Apr 15, 2024
1 parent 00835c0 commit 3378e7b
Show file tree
Hide file tree
Showing 196 changed files with 4,500 additions and 2,428 deletions.
17 changes: 17 additions & 0 deletions Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
-------------------------------------------------------------------------------
Expand Down
18 changes: 17 additions & 1 deletion Cabal-described/src/Distribution/Described.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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"]

Expand Down Expand Up @@ -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

Expand Down
1 change: 1 addition & 0 deletions Cabal-syntax/Cabal-syntax.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
20 changes: 14 additions & 6 deletions Cabal-syntax/src/Distribution/ModuleName.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,7 @@ module Distribution.ModuleName
( ModuleName
, fromString
, fromComponents
, combineModuleName
, components
, toFilePath
, main
Expand Down Expand Up @@ -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")
Expand All @@ -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:
--
Expand Down
63 changes: 33 additions & 30 deletions Cabal-syntax/src/Distribution/PackageDescription/Configuration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,6 @@ module Distribution.PackageDescription.Configuration
, mapTreeConstrs
, transformAllBuildInfos
, transformAllBuildDepends
, transformAllBuildDependsN
, simplifyWithSysParams
) where

Expand Down Expand Up @@ -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

------------------------------------------------------------------------------

Expand Down Expand Up @@ -187,12 +187,12 @@ resolveWithFlags
-- ^ Arch where the installed artifacts will run (host Arch)
-> CompilerInfo
-- ^ Compiler information
-> [PackageVersionConstraint]
-> [(IsPrivate, 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 =
Expand Down Expand Up @@ -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 =
Expand All @@ -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]
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -453,19 +464,19 @@ 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.
-> Platform
-- ^ The 'Arch' and 'OS'
-> CompilerInfo
-- ^ Compiler information
-> [PackageVersionConstraint]
-> [(IsPrivate, PackageVersionConstraint)]
-- ^ Additional constraints
-> GenericPackageDescription
-> Either
[Dependency]
Dependencies
(PackageDescription, FlagAssignment)
-- ^ Either missing dependencies or the resolved package
-- description along with the flag assignments chosen.
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -652,19 +666,8 @@ 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)

-- | 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
. over (\f' -> L.allCondTrees $ traverseCondTreeC f') (mapDependencies f)
10 changes: 10 additions & 0 deletions Cabal-syntax/src/Distribution/PackageDescription/FieldGrammar.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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 #-}
Expand Down Expand Up @@ -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

Expand Down
Loading

0 comments on commit 3378e7b

Please sign in to comment.