Post-process internal library names in parser

This is preparation to solve #6083.
As such, this shouldn't affect anything yet.

Cabal/Cabal.cabal

@@ -174,6 +174,15 @@ extra-source-files:
   tests/ParserTests/regressions/issue-5846.cabal
   tests/ParserTests/regressions/issue-5846.expr
   tests/ParserTests/regressions/issue-5846.format
+  tests/ParserTests/regressions/issue-6083-a.cabal
+  tests/ParserTests/regressions/issue-6083-a.expr
+  tests/ParserTests/regressions/issue-6083-a.format
+  tests/ParserTests/regressions/issue-6083-b.cabal
+  tests/ParserTests/regressions/issue-6083-b.expr
+  tests/ParserTests/regressions/issue-6083-b.format
+  tests/ParserTests/regressions/issue-6083-c.cabal
+  tests/ParserTests/regressions/issue-6083-c.expr
+  tests/ParserTests/regressions/issue-6083-c.format
   tests/ParserTests/regressions/issue-6083-pkg-pkg.cabal
   tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
   tests/ParserTests/regressions/issue-6083-pkg-pkg.format

Cabal/Distribution/Compat/NonEmptySet.hs

@@ -4,6 +4,8 @@ module Distribution.Compat.NonEmptySet (
     NonEmptySet,
     -- * Construction
     singleton,
+    -- * Deletion
+    delete,
     -- * Conversions
     toNonEmpty,
     fromNonEmpty,
@@ -14,7 +16,7 @@ module Distribution.Compat.NonEmptySet (
     map,
 ) where
 
-import Prelude (Bool (..), Eq, Ord (..), Read, Show (..), String, error, return, showParen, showString, ($), (++), (.))
+import Prelude (Bool (..), Eq, Ord (..), Read, otherwise, Maybe (..), Show (..), String, error, return, showParen, showString, ($), (++), (.))
 
 import Control.DeepSeq    (NFData (..))
 import Data.Data          (Data)
@@ -85,6 +87,18 @@ instance F.Foldable NonEmptySet where
 singleton :: a -> NonEmptySet a
 singleton = NES . Set.singleton
 
+-------------------------------------------------------------------------------
+-- Deletion
+-------------------------------------------------------------------------------
+
+delete :: Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
+delete x (NES xs)
+    | Set.null res = Nothing
+    | otherwise    = Just (NES xs)
+  where
+    res = Set.delete x xs
+
+
 -------------------------------------------------------------------------------
 -- Conversions
 -------------------------------------------------------------------------------

Cabal/Distribution/PackageDescription/Configuration.hs

@@ -31,6 +31,7 @@ module Distribution.PackageDescription.Configuration (
     mapTreeConstrs,
     transformAllBuildInfos,
     transformAllBuildDepends,
+    transformAllBuildDependsN,
   ) where
 
 import Distribution.Compat.Prelude
@@ -585,3 +586,14 @@ transformAllBuildDepends 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

Cabal/Distribution/PackageDescription/Parsec.hs

@@ -47,7 +47,7 @@ import Distribution.Fields.LexerMonad                (LexWarning, toPWarnings)
 import Distribution.Fields.Parser
 import Distribution.Fields.ParseResult
 import Distribution.PackageDescription
-import Distribution.PackageDescription.Configuration (freeVars)
+import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildDependsN)
 import Distribution.PackageDescription.FieldGrammar
 import Distribution.PackageDescription.Quirks        (patchQuirks)
 import Distribution.Parsec                           (parsec, simpleParsecBS)
@@ -65,6 +65,7 @@ import qualified Data.ByteString.Char8                             as BS8
 import qualified Data.Map.Strict                                   as Map
 import qualified Data.Set                                          as Set
 import qualified Distribution.Compat.Newtype                       as Newtype
+import qualified Distribution.Compat.NonEmptySet                   as NES
 import qualified Distribution.Types.BuildInfo.Lens                 as L
 import qualified Distribution.Types.Executable.Lens                as L
 import qualified Distribution.Types.ForeignLib.Lens                as L
@@ -202,8 +203,9 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do
             & L.packageDescription .~ pd
     gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty)
 
-    checkForUndefinedFlags gpd1
-    gpd1 `deepseq` return gpd1
+    let gpd2 = postProcessInternalDeps specVer gpd1
+    checkForUndefinedFlags gpd2
+    gpd2 `deepseq` return gpd2
   where
     safeLast :: [a] -> Maybe a
     safeLast = listToMaybe . reverse
@@ -687,6 +689,72 @@ checkForUndefinedFlags gpd = do
     f :: CondTree ConfVar c a -> Const (Set.Set FlagName) (CondTree ConfVar c a)
     f ct = Const (Set.fromList (freeVars ct))
 
+-------------------------------------------------------------------------------
+-- Post processing of internal dependencies
+-------------------------------------------------------------------------------
+
+-- Note [Dependencies on sublibraries]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+--
+-- This is solution to https://github.com/haskell/cabal/issues/6083
+--
+-- Before 'cabal-version: 3.0' we didn't have a syntax specially
+-- for referring to internal libraries. Internal library names
+-- shadowed the the outside ones.
+--
+-- Since 'cabal-version: 3.0' we have ability to write
+--
+--     build-depends: some-package:its-sub-lib >=1.2.3
+--
+-- This allows us to refer also to local packages by `this-package:sublib`.
+-- So since 'cabal-version: 3.4' to refer to *any*
+-- sublibrary we must use the two part syntax. Here's small table:
+--
+--                   | pre-3.4             |      3.4 and after            |
+-- ------------------|---------------------|-------------------------------|
+-- pkg-name          | may refer to sublib | always refers to external pkg |
+-- pkg-name:sublib   | refers to sublib    | refers to sublib              |
+-- pkg-name:pkg-name | may refer to sublib | always refers to external pkg |
+--
+-- In pre-3.4 case, if a package 'this-pkg' has a sublibrary 'pkg-name',
+-- all dependency definitions will refer to that sublirary.
+--
+-- In 3.4 and after case, 'pkg-name' will always refer to external package,
+-- and to use internal library you have to say 'this-pkg:pkg-name'.
+--
+-- In summary, In 3.4 and after, the internal names don't shadow,
+-- as there is an explicit syntax to refer to them,
+-- i.e. what you write is what you get;
+-- For pre-3.4 we post-process the file.
+--
+
+postProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
+postProcessInternalDeps specVer gpd
+    | specVer >= CabalSpecV3_4 = gpd
+    | otherwise                = transformAllBuildDependsN (concatMap f) gpd
+  where
+    f :: Dependency -> [Dependency]
+    f (Dependency pn vr ln)
+        | uqn `Set.member` internalLibs
+        , LMainLibName `NES.member` ln
+        = case NES.delete LMainLibName ln of
+            Nothing  -> [dep]
+            Just ln' -> [dep, Dependency pn vr ln']
+      where
+        uqn = packageNameToUnqualComponentName pn
+        dep = Dependency thisPn vr (NES.singleton (LSubLibName uqn))
+
+    f d = [d]
+
+    thisPn :: PackageName
+    thisPn = pkgName (package (packageDescription gpd))
+
+    internalLibs :: Set UnqualComponentName
+    internalLibs = Set.fromList
+        [ n
+        | (n, _) <- condSubLibraries gpd
+        ]
+
 -------------------------------------------------------------------------------
 -- Old syntax
 -------------------------------------------------------------------------------
@@ -819,6 +887,10 @@ parseHookedBuildInfo' lexWarnings fs = do
         | otherwise            = Nothing
     isExecutableField _ = Nothing
 
+-------------------------------------------------------------------------------
+-- Scan of spec version
+-------------------------------------------------------------------------------
+
 -- | Quickly scan new-style spec-version
 --
 -- A new-style spec-version declaration begins the .cabal file and

Cabal/Distribution/PackageDescription/PrettyPrint.hs

@@ -37,7 +37,8 @@ import Distribution.PackageDescription
 import Distribution.Pretty
 import Distribution.Simple.Utils
 
-import Distribution.FieldGrammar                    (PrettyFieldGrammar', prettyFieldGrammar)
+import Distribution.FieldGrammar                     (PrettyFieldGrammar', prettyFieldGrammar)
+import Distribution.PackageDescription.Configuration (transformAllBuildDependsN)
 import Distribution.PackageDescription.FieldGrammar
        (benchmarkFieldGrammar, buildInfoFieldGrammar, executableFieldGrammar, flagFieldGrammar, foreignLibFieldGrammar, libraryFieldGrammar,
        packageDescriptionFieldGrammar, setupBInfoFieldGrammar, sourceRepoFieldGrammar, testSuiteFieldGrammar)
@@ -46,7 +47,8 @@ import qualified Distribution.PackageDescription.FieldGrammar as FG
 
 import Text.PrettyPrint (Doc, char, hsep, parens, text)
 
-import qualified Data.ByteString.Lazy.Char8 as BS.Char8
+import qualified Data.ByteString.Lazy.Char8      as BS.Char8
+import qualified Distribution.Compat.NonEmptySet as NES
 
 -- | Writes a .cabal file from a generic package description
 writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO ()
@@ -60,7 +62,7 @@ showGenericPackageDescription gpd = showFields (const []) $ ppGenericPackageDesc
 
 -- | Convert a generic package description to 'PrettyField's.
 ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
-ppGenericPackageDescription v gpd = concat
+ppGenericPackageDescription v gpd0 = concat
     [ ppPackageDescription v (packageDescription gpd)
     , ppSetupBInfo v (setupBuildInfo (packageDescription gpd))
     , ppGenPackageFlags v (genPackageFlags gpd)
@@ -71,6 +73,9 @@ ppGenericPackageDescription v gpd = concat
     , ppCondTestSuites v (condTestSuites gpd)
     , ppCondBenchmarks v (condBenchmarks gpd)
     ]
+  where
+    gpd = preProcessInternalDeps (specVersion (packageDescription gpd0)) gpd0
+
 
 ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()]
 ppPackageDescription v pd =
@@ -214,6 +219,38 @@ pdToGpd pd = GenericPackageDescription
         -> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
     mkCondTree' f x = (f x, CondNode x [] [])
 
+-------------------------------------------------------------------------------
+-- Internal libs
+-------------------------------------------------------------------------------
+
+-- See Note [Dependencies on sublibraries] in Distribution.PackageDescription.Parsec
+--
+preProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
+preProcessInternalDeps specVer gpd
+    | specVer >= CabalSpecV3_4 = gpd
+    | otherwise                = transformAllBuildDependsN (concatMap f) gpd
+  where
+    f :: Dependency -> [Dependency]
+    f (Dependency pn vr ln)
+        | pn == thisPn
+        = if LMainLibName `NES.member` ln
+          then Dependency thisPn vr mainLibSet : sublibs
+          else sublibs
+      where
+        sublibs =
+            [ Dependency (unqualComponentNameToPackageName uqn) vr mainLibSet
+            | LSubLibName uqn <- NES.toList ln
+            ]
+
+    f d = [d]
+
+    thisPn :: PackageName
+    thisPn = pkgName (package (packageDescription gpd))
+
+-------------------------------------------------------------------------------
+-- HookedBuildInfo
+-------------------------------------------------------------------------------
+
 -- | @since 2.0.0.2
 writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
 writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack

Cabal/tests/ParserTests.hs

@@ -173,6 +173,9 @@ regressionTests = testGroup "regressions"
     , regressionTest "th-lift-instances.cabal"
     , regressionTest "issue-5055.cabal"
     , regressionTest "issue-6083-pkg-pkg.cabal"
+    , regressionTest "issue-6083-a.cabal"
+    , regressionTest "issue-6083-b.cabal"
+    , regressionTest "issue-6083-c.cabal"
     , regressionTest "noVersion.cabal"
     , regressionTest "spdx-1.cabal"
     , regressionTest "spdx-2.cabal"

Cabal/tests/ParserTests/regressions/issue-6083-a.cabal

@@ -0,0 +1,11 @@
+cabal-version: 3.4
+name: issue
+version: 6083
+
+library
+  default-language: Haskell2010
+  -- This should be parsed as the main lib
+  build-depends: base, issue:sublib
+
+library sublib
+  default-language: Haskell2010