Skip to content

Commit f13eb52

Browse files
phadejphadej
committed
Post-process internal library names in parser
This is preparation to solve #6083. As such, this shouldn't affect anything yet.
1 parent 14010da commit f13eb52

15 files changed

+767
-7
lines changed

‎Cabal/Cabal.cabal

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -174,6 +174,15 @@ extra-source-files:
174174
tests/ParserTests/regressions/issue-5846.cabal
175175
tests/ParserTests/regressions/issue-5846.expr
176176
tests/ParserTests/regressions/issue-5846.format
177+
tests/ParserTests/regressions/issue-6083-a.cabal
178+
tests/ParserTests/regressions/issue-6083-a.expr
179+
tests/ParserTests/regressions/issue-6083-a.format
180+
tests/ParserTests/regressions/issue-6083-b.cabal
181+
tests/ParserTests/regressions/issue-6083-b.expr
182+
tests/ParserTests/regressions/issue-6083-b.format
183+
tests/ParserTests/regressions/issue-6083-c.cabal
184+
tests/ParserTests/regressions/issue-6083-c.expr
185+
tests/ParserTests/regressions/issue-6083-c.format
177186
tests/ParserTests/regressions/issue-6083-pkg-pkg.cabal
178187
tests/ParserTests/regressions/issue-6083-pkg-pkg.expr
179188
tests/ParserTests/regressions/issue-6083-pkg-pkg.format

‎Cabal/Distribution/Compat/NonEmptySet.hs

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,8 @@ module Distribution.Compat.NonEmptySet (
44
NonEmptySet,
55
-- * Construction
66
singleton,
7+
-- * Deletion
8+
delete,
79
-- * Conversions
810
toNonEmpty,
911
fromNonEmpty,
@@ -14,7 +16,7 @@ module Distribution.Compat.NonEmptySet (
1416
map,
1517
) where
1618

17-
import Prelude (Bool (..), Eq, Ord (..), Read, Show (..), String, error, return, showParen, showString, ($), (++), (.))
19+
import Prelude (Bool (..), Eq, Ord (..), Read, otherwise, Maybe (..), Show (..), String, error, return, showParen, showString, ($), (++), (.))
1820

1921
import Control.DeepSeq (NFData (..))
2022
import Data.Data (Data)
@@ -85,6 +87,18 @@ instance F.Foldable NonEmptySet where
8587
singleton :: a -> NonEmptySet a
8688
singleton = NES . Set.singleton
8789

90+
-------------------------------------------------------------------------------
91+
-- Deletion
92+
-------------------------------------------------------------------------------
93+
94+
delete :: Ord a => a -> NonEmptySet a -> Maybe (NonEmptySet a)
95+
delete x (NES xs)
96+
| Set.null res = Nothing
97+
| otherwise = Just (NES xs)
98+
where
99+
res = Set.delete x xs
100+
101+
88102
-------------------------------------------------------------------------------
89103
-- Conversions
90104
-------------------------------------------------------------------------------

‎Cabal/Distribution/PackageDescription/Configuration.hs

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -31,6 +31,7 @@ module Distribution.PackageDescription.Configuration (
3131
mapTreeConstrs,
3232
transformAllBuildInfos,
3333
transformAllBuildDepends,
34+
transformAllBuildDependsN,
3435
) where
3536

3637
import Distribution.Compat.Prelude
@@ -585,3 +586,14 @@ transformAllBuildDepends f =
585586
. over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends . traverse) f
586587
-- cannot be point-free as normal because of higher rank
587588
. over (\f' -> L.allCondTrees $ traverseCondTreeC f') (map f)
589+
590+
-- | Walk a 'GenericPackageDescription' and apply @f@ to all nested
591+
-- @build-depends@ fields.
592+
transformAllBuildDependsN :: ([Dependency] -> [Dependency])
593+
-> GenericPackageDescription
594+
-> GenericPackageDescription
595+
transformAllBuildDependsN f =
596+
over (L.traverseBuildInfos . L.targetBuildDepends) f
597+
. over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends) f
598+
-- cannot be point-free as normal because of higher rank
599+
. over (\f' -> L.allCondTrees $ traverseCondTreeC f') f

‎Cabal/Distribution/PackageDescription/Parsec.hs

Lines changed: 75 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -47,7 +47,7 @@ import Distribution.Fields.LexerMonad (LexWarning, toPWarnings)
4747
import Distribution.Fields.Parser
4848
import Distribution.Fields.ParseResult
4949
import Distribution.PackageDescription
50-
import Distribution.PackageDescription.Configuration (freeVars)
50+
import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildDependsN)
5151
import Distribution.PackageDescription.FieldGrammar
5252
import Distribution.PackageDescription.Quirks (patchQuirks)
5353
import Distribution.Parsec (parsec, simpleParsecBS)
@@ -65,6 +65,7 @@ import qualified Data.ByteString.Char8 as BS8
6565
import qualified Data.Map.Strict as Map
6666
import qualified Data.Set as Set
6767
import qualified Distribution.Compat.Newtype as Newtype
68+
import qualified Distribution.Compat.NonEmptySet as NES
6869
import qualified Distribution.Types.BuildInfo.Lens as L
6970
import qualified Distribution.Types.Executable.Lens as L
7071
import qualified Distribution.Types.ForeignLib.Lens as L
@@ -202,8 +203,9 @@ parseGenericPackageDescription' scannedVer lexWarnings utf8WarnPos fs = do
202203
& L.packageDescription .~ pd
203204
gpd1 <- view stateGpd <$> execStateT (goSections specVer sectionFields) (SectionS gpd Map.empty)
204205

205-
checkForUndefinedFlags gpd1
206-
gpd1 `deepseq` return gpd1
206+
let gpd2 = postProcessInternalDeps specVer gpd1
207+
checkForUndefinedFlags gpd2
208+
gpd2 `deepseq` return gpd2
207209
where
208210
safeLast :: [a] -> Maybe a
209211
safeLast = listToMaybe . reverse
@@ -687,6 +689,72 @@ checkForUndefinedFlags gpd = do
687689
f :: CondTree ConfVar c a -> Const (Set.Set FlagName) (CondTree ConfVar c a)
688690
f ct = Const (Set.fromList (freeVars ct))
689691

692+
-------------------------------------------------------------------------------
693+
-- Post processing of internal dependencies
694+
-------------------------------------------------------------------------------
695+
696+
-- Note [Dependencies on sublibraries]
697+
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
698+
--
699+
-- This is solution to https://github.com/haskell/cabal/issues/6083
700+
--
701+
-- Before 'cabal-version: 3.0' we didn't have a syntax specially
702+
-- for referring to internal libraries. Internal library names
703+
-- shadowed the the outside ones.
704+
--
705+
-- Since 'cabal-version: 3.0' we have ability to write
706+
--
707+
-- build-depends: some-package:its-sub-lib >=1.2.3
708+
--
709+
-- This allows us to refer also to local packages by `this-package:sublib`.
710+
-- So since 'cabal-version: 3.4' to refer to *any*
711+
-- sublibrary we must use the two part syntax. Here's small table:
712+
--
713+
-- | pre-3.4 | 3.4 and after |
714+
-- ------------------|---------------------|-------------------------------|
715+
-- pkg-name | may refer to sublib | always refers to external pkg |
716+
-- pkg-name:sublib | refers to sublib | refers to sublib |
717+
-- pkg-name:pkg-name | may refer to sublib | always refers to external pkg |
718+
--
719+
-- In pre-3.4 case, if a package 'this-pkg' has a sublibrary 'pkg-name',
720+
-- all dependency definitions will refer to that sublirary.
721+
--
722+
-- In 3.4 and after case, 'pkg-name' will always refer to external package,
723+
-- and to use internal library you have to say 'this-pkg:pkg-name'.
724+
--
725+
-- In summary, In 3.4 and after, the internal names don't shadow,
726+
-- as there is an explicit syntax to refer to them,
727+
-- i.e. what you write is what you get;
728+
-- For pre-3.4 we post-process the file.
729+
--
730+
731+
postProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
732+
postProcessInternalDeps specVer gpd
733+
| specVer >= CabalSpecV3_4 = gpd
734+
| otherwise = transformAllBuildDependsN (concatMap f) gpd
735+
where
736+
f :: Dependency -> [Dependency]
737+
f (Dependency pn vr ln)
738+
| uqn `Set.member` internalLibs
739+
, LMainLibName `NES.member` ln
740+
= case NES.delete LMainLibName ln of
741+
Nothing -> [dep]
742+
Just ln' -> [dep, Dependency pn vr ln']
743+
where
744+
uqn = packageNameToUnqualComponentName pn
745+
dep = Dependency thisPn vr (NES.singleton (LSubLibName uqn))
746+
747+
f d = [d]
748+
749+
thisPn :: PackageName
750+
thisPn = pkgName (package (packageDescription gpd))
751+
752+
internalLibs :: Set UnqualComponentName
753+
internalLibs = Set.fromList
754+
[ n
755+
| (n, _) <- condSubLibraries gpd
756+
]
757+
690758
-------------------------------------------------------------------------------
691759
-- Old syntax
692760
-------------------------------------------------------------------------------
@@ -819,6 +887,10 @@ parseHookedBuildInfo' lexWarnings fs = do
819887
| otherwise = Nothing
820888
isExecutableField _ = Nothing
821889

890+
-------------------------------------------------------------------------------
891+
-- Scan of spec version
892+
-------------------------------------------------------------------------------
893+
822894
-- | Quickly scan new-style spec-version
823895
--
824896
-- A new-style spec-version declaration begins the .cabal file and

‎Cabal/Distribution/PackageDescription/PrettyPrint.hs

Lines changed: 40 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -37,7 +37,8 @@ import Distribution.PackageDescription
3737
import Distribution.Pretty
3838
import Distribution.Simple.Utils
3939

40-
import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar)
40+
import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar)
41+
import Distribution.PackageDescription.Configuration (transformAllBuildDependsN)
4142
import Distribution.PackageDescription.FieldGrammar
4243
(benchmarkFieldGrammar, buildInfoFieldGrammar, executableFieldGrammar, flagFieldGrammar, foreignLibFieldGrammar, libraryFieldGrammar,
4344
packageDescriptionFieldGrammar, setupBInfoFieldGrammar, sourceRepoFieldGrammar, testSuiteFieldGrammar)
@@ -46,7 +47,8 @@ import qualified Distribution.PackageDescription.FieldGrammar as FG
4647

4748
import Text.PrettyPrint (Doc, char, hsep, parens, text)
4849

49-
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
50+
import qualified Data.ByteString.Lazy.Char8 as BS.Char8
51+
import qualified Distribution.Compat.NonEmptySet as NES
5052

5153
-- | Writes a .cabal file from a generic package description
5254
writeGenericPackageDescription :: FilePath -> GenericPackageDescription -> IO ()
@@ -60,7 +62,7 @@ showGenericPackageDescription gpd = showFields (const []) $ ppGenericPackageDesc
6062

6163
-- | Convert a generic package description to 'PrettyField's.
6264
ppGenericPackageDescription :: CabalSpecVersion -> GenericPackageDescription -> [PrettyField ()]
63-
ppGenericPackageDescription v gpd = concat
65+
ppGenericPackageDescription v gpd0 = concat
6466
[ ppPackageDescription v (packageDescription gpd)
6567
, ppSetupBInfo v (setupBuildInfo (packageDescription gpd))
6668
, ppGenPackageFlags v (genPackageFlags gpd)
@@ -71,6 +73,9 @@ ppGenericPackageDescription v gpd = concat
7173
, ppCondTestSuites v (condTestSuites gpd)
7274
, ppCondBenchmarks v (condBenchmarks gpd)
7375
]
76+
where
77+
gpd = preProcessInternalDeps (specVersion (packageDescription gpd0)) gpd0
78+
7479

7580
ppPackageDescription :: CabalSpecVersion -> PackageDescription -> [PrettyField ()]
7681
ppPackageDescription v pd =
@@ -214,6 +219,38 @@ pdToGpd pd = GenericPackageDescription
214219
-> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a)
215220
mkCondTree' f x = (f x, CondNode x [] [])
216221

222+
-------------------------------------------------------------------------------
223+
-- Internal libs
224+
-------------------------------------------------------------------------------
225+
226+
-- See Note [Dependencies on sublibraries] in Distribution.PackageDescription.Parsec
227+
--
228+
preProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
229+
preProcessInternalDeps specVer gpd
230+
| specVer >= CabalSpecV3_4 = gpd
231+
| otherwise = transformAllBuildDependsN (concatMap f) gpd
232+
where
233+
f :: Dependency -> [Dependency]
234+
f (Dependency pn vr ln)
235+
| pn == thisPn
236+
= if LMainLibName `NES.member` ln
237+
then Dependency thisPn vr mainLibSet : sublibs
238+
else sublibs
239+
where
240+
sublibs =
241+
[ Dependency (unqualComponentNameToPackageName uqn) vr mainLibSet
242+
| LSubLibName uqn <- NES.toList ln
243+
]
244+
245+
f d = [d]
246+
247+
thisPn :: PackageName
248+
thisPn = pkgName (package (packageDescription gpd))
249+
250+
-------------------------------------------------------------------------------
251+
-- HookedBuildInfo
252+
-------------------------------------------------------------------------------
253+
217254
-- | @since 2.0.0.2
218255
writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO ()
219256
writeHookedBuildInfo fpath = writeFileAtomic fpath . BS.Char8.pack

‎Cabal/tests/ParserTests.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -173,6 +173,9 @@ regressionTests = testGroup "regressions"
173173
, regressionTest "th-lift-instances.cabal"
174174
, regressionTest "issue-5055.cabal"
175175
, regressionTest "issue-6083-pkg-pkg.cabal"
176+
, regressionTest "issue-6083-a.cabal"
177+
, regressionTest "issue-6083-b.cabal"
178+
, regressionTest "issue-6083-c.cabal"
176179
, regressionTest "noVersion.cabal"
177180
, regressionTest "spdx-1.cabal"
178181
, regressionTest "spdx-2.cabal"

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

Lines changed: 11 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
cabal-version: 3.4
2+
name: issue
3+
version: 6083
4+
5+
library
6+
default-language: Haskell2010
7+
-- This should be parsed as the main lib
8+
build-depends: base, issue:sublib
9+
10+
library sublib
11+
default-language: Haskell2010

0 commit comments

Comments
 (0)