feature: Private Dependencies

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
 
 ------------------------------------------------------------------------------
 
@@ -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 =
@@ -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,19 +464,19 @@ finalizePD
   :: FlagAssignment
   -- ^ Explicitly specified flag assignments
   -> ComponentRequestedSpec
-  -> (Dependency -> Bool)
+  -> (IsPrivate -> 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.
@@ -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 Public) (publicDependencies ds))
+                (mapMaybe (\(PrivateDependency priv pds) -> case filter (not . satisfyDep (Private 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,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)

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