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/Backpack/ComponentsGraph.hs

@@ -18,6 +18,7 @@ import Distribution.Simple.LocalBuildInfo
 import Distribution.Types.ComponentRequestedSpec
 import Distribution.Compat.Graph (Graph, Node(..))
 import qualified Distribution.Compat.Graph as Graph
+import qualified Distribution.Compat.NonEmptySet as NES
 import Distribution.Utils.Generic
 
 import Distribution.Pretty (pretty)
@@ -62,33 +63,18 @@ mkComponentsGraph enabled pkg_descr =
   where
     -- The dependencies for the given component
     componentDeps component =
-      (CExeName <$> getAllInternalToolDependencies pkg_descr bi)
-
-      ++ do
-          Dependency pkgname _ lns <- targetBuildDepends bi
-          let uqn = packageNameToUnqualComponentName pkgname
-          guard (uqn `elem` internalPkgDeps)
-          ln <- toList lns
-
-          -- given package "pkg" with "sublib" library:
-          case ln of
-              LMainLibName
-                  -- build-depends: pkg
-                  | pkgname == packageName pkg_descr -> return (CLibName LMainLibName)
-                  -- build-depends: sublib
-                  | otherwise                        -> return (CLibName (LSubLibName uqn))
-              LSubLibName uqn'
-                  -- build-depends: pkg:sublib
-                  | pkgname == packageName pkg_descr
-                  , uqn' `elem` internalPkgDeps      -> return (CLibName (LSubLibName uqn'))
-                  -- build-depends: sublib:something else
-                  | otherwise                        -> []
+        toolDependencies ++ libDependencies
       where
         bi = componentBuildInfo component
-        internalPkgDeps = map (conv . libName) (allLibraries pkg_descr)
 
-        conv LMainLibName    = packageNameToUnqualComponentName $ packageName pkg_descr
-        conv (LSubLibName s) = s
+        toolDependencies = CExeName <$> getAllInternalToolDependencies pkg_descr bi
+
+        libDependencies = do
+            Dependency pkgname _ lns <- targetBuildDepends bi
+            guard (pkgname == packageName pkg_descr)
+
+            ln <- NES.toList lns
+            return (CLibName ln)
 
 -- | Given the package description and a 'PackageDescription' (used
 -- to determine if a package name is internal or not), sort the

Cabal/Distribution/Backpack/ConfiguredComponent.hs

@@ -170,14 +170,11 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
         if newPackageDepsBehaviour pkg_descr
             then fmap concat $ forM (targetBuildDepends bi) $
                  \(Dependency name _ sublibs) -> do
-                    -- The package name still needs fixing in case of legacy
-                    -- sublibrary dependency syntax
-                    let (pn, _) = fixFakePkgName pkg_descr name
-                    pkg <- case Map.lookup pn lib_dep_map of
+                    pkg <- case Map.lookup name lib_dep_map of
                         Nothing ->
                             dieProgress $
                                 text "Dependency on unbuildable" <+>
-                                text "package" <+> pretty pn
+                                text "package" <+> pretty name
                         Just p -> return p
                     -- Return all library components
                     forM (NonEmptySet.toList sublibs) $ \lib ->
@@ -190,7 +187,7 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
                                 dieProgress $
                                     text "Dependency on unbuildable" <+>
                                     text (showLibraryName lib) <+>
-                                    text "from" <+> pretty pn
+                                    text "from" <+> pretty name
                             Just v -> return v
             else return old_style_lib_deps
     mkConfiguredComponent

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