Skip to content

Commit 395fd30

Browse files
phadejphadej
committed
Resolve #6281: Add foo:bar syntax to mixins
1 parent 9b380e2 commit 395fd30

File tree

28 files changed

+11194
-62
lines changed

28 files changed

+11194
-62
lines changed

‎Cabal/Cabal-QuickCheck/src/Test/QuickCheck/Instances/Cabal.hs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -176,8 +176,8 @@ instance Arbitrary Bound where
176176
-------------------------------------------------------------------------------
177177

178178
instance Arbitrary Mixin where
179-
arbitrary = genericArbitrary
180-
shrink = genericShrink
179+
arbitrary = normaliseMixin <$> genericArbitrary
180+
shrink = fmap normaliseMixin . genericShrink
181181

182182
instance Arbitrary IncludeRenaming where
183183
arbitrary = genericArbitrary

‎Cabal/Cabal-described/src/Distribution/Described.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -431,7 +431,9 @@ instance Described LibVersionInfo where
431431
reDigits = reChars ['0'..'9']
432432

433433
instance Described Mixin where
434-
describe _ = RENamed "package-name" (describe (Proxy :: Proxy PackageName)) <>
434+
describe _ =
435+
RENamed "package-name" (describe (Proxy :: Proxy PackageName)) <>
436+
REOpt (reChar ':' <> RENamed "library-name" (describe (Proxy :: Proxy UnqualComponentName))) <>
435437
REOpt (RESpaces1 <> describe (Proxy :: Proxy IncludeRenaming))
436438

437439
instance Described ModuleName where

‎Cabal/Cabal.cabal

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,9 @@ extra-source-files:
156156
tests/ParserTests/regressions/ghc-option-j.check
157157
tests/ParserTests/regressions/haddock-api-2.18.1-check.cabal
158158
tests/ParserTests/regressions/haddock-api-2.18.1-check.check
159+
tests/ParserTests/regressions/hasktorch.cabal
160+
tests/ParserTests/regressions/hasktorch.expr
161+
tests/ParserTests/regressions/hasktorch.format
159162
tests/ParserTests/regressions/hidden-main-lib.cabal
160163
tests/ParserTests/regressions/hidden-main-lib.expr
161164
tests/ParserTests/regressions/hidden-main-lib.format

‎Cabal/Distribution/Backpack/ConfiguredComponent.hs

Lines changed: 15 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,6 @@ import Distribution.Types.PackageName
3232
import Distribution.Types.Mixin
3333
import Distribution.Types.ComponentName
3434
import Distribution.Types.LibraryName
35-
import Distribution.Types.UnqualComponentName
3635
import Distribution.Types.ComponentInclude
3736
import Distribution.Package
3837
import Distribution.PackageDescription
@@ -48,7 +47,8 @@ import qualified Data.Set as Set
4847
import qualified Distribution.Compat.NonEmptySet as NonEmptySet
4948
import qualified Data.Map as Map
5049
import Distribution.Pretty
51-
import Text.PrettyPrint
50+
import Text.PrettyPrint (Doc, hang, text, vcat, hsep, quotes, ($$))
51+
import qualified Text.PrettyPrint as PP
5252

5353
-- | A configured component, we know exactly what its 'ComponentId' is,
5454
-- and the 'ComponentId's of the things it depends on.
@@ -112,13 +112,12 @@ mkConfiguredComponent
112112
mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do
113113
-- Resolve each @mixins@ into the actual dependency
114114
-- from @lib_deps@.
115-
explicit_includes <- forM (mixins bi) $ \(Mixin name rns) -> do
116-
let keys = fixFakePkgName pkg_descr name
117-
aid <- case Map.lookup keys deps_map of
115+
explicit_includes <- forM (mixins bi) $ \(Mixin pn ln rns) -> do
116+
aid <- case Map.lookup (pn, CLibName ln) deps_map of
118117
Nothing ->
119118
dieProgress $
120-
text "Mix-in refers to non-existent package" <+>
121-
quotes (pretty name) $$
119+
text "Mix-in refers to non-existent library" <+>
120+
quotes (pretty pn <<>> prettyLN ln) $$
122121
text "(did you forget to add the package to build-depends?)"
123122
Just r -> return r
124123
return ComponentInclude {
@@ -150,9 +149,17 @@ mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do
150149
cc_includes = explicit_includes ++ implicit_includes
151150
}
152151
where
152+
bi :: BuildInfo
153153
bi = componentBuildInfo component
154+
155+
prettyLN :: LibraryName -> Doc
156+
prettyLN LMainLibName = PP.empty
157+
prettyLN (LSubLibName n) = PP.colon <<>> pretty n
158+
159+
deps_map :: Map (PackageName, ComponentName) (AnnotatedId ComponentId)
154160
deps_map = Map.fromList [ ((packageName dep, ann_cname dep), dep)
155161
| dep <- lib_deps ]
162+
156163
is_public = componentName component == CLibName LMainLibName
157164

158165
type ConfiguredComponentMap =
@@ -179,10 +186,7 @@ toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
179186
-- Return all library components
180187
forM (NonEmptySet.toList sublibs) $ \lib ->
181188
let comp = CLibName lib in
182-
case Map.lookup (CLibName $ LSubLibName $
183-
packageNameToUnqualComponentName name) pkg
184-
<|> Map.lookup comp pkg
185-
of
189+
case Map.lookup comp pkg of
186190
Nothing ->
187191
dieProgress $
188192
text "Dependency on unbuildable" <+>
@@ -302,19 +306,3 @@ newPackageDepsBehaviourMinVersion = CabalSpecV1_8
302306
newPackageDepsBehaviour :: PackageDescription -> Bool
303307
newPackageDepsBehaviour pkg =
304308
specVersion pkg >= newPackageDepsBehaviourMinVersion
305-
306-
-- | 'build-depends:' stanzas are currently ambiguous as the external packages
307-
-- and internal libraries are specified the same. For now, we assume internal
308-
-- libraries shadow, and this function disambiguates accordingly, but soon the
309-
-- underlying ambiguity will be addressed.
310-
-- Multiple public libraries (cabal 3.0) added an unambiguous way of specifying
311-
-- sublibraries, but we still have to support the old syntax for bc reasons.
312-
fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName)
313-
fixFakePkgName pkg_descr pn =
314-
if subLibName `elem` internalLibraries
315-
then (packageName pkg_descr, CLibName (LSubLibName subLibName))
316-
else (pn, CLibName LMainLibName )
317-
where
318-
subLibName = packageNameToUnqualComponentName pn
319-
internalLibraries = mapMaybe (libraryNameString . libName)
320-
(allLibraries pkg_descr)

‎Cabal/Distribution/PackageDescription/Parsec.hs

Lines changed: 27 additions & 5 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, transformAllBuildDependsN)
50+
import Distribution.PackageDescription.Configuration (freeVars, transformAllBuildInfos)
5151
import Distribution.PackageDescription.FieldGrammar
5252
import Distribution.PackageDescription.Quirks (patchQuirks)
5353
import Distribution.Parsec (parsec, simpleParsecBS)
@@ -56,6 +56,7 @@ import Distribution.Parsec.Position (Position (..), zeroPos)
5656
import Distribution.Parsec.Warning (PWarnType (..))
5757
import Distribution.Pretty (prettyShow)
5858
import Distribution.Simple.Utils (fromUTF8BS, toUTF8BS)
59+
import Distribution.Types.Mixin (Mixin (..), mkMixin)
5960
import Distribution.Utils.Generic (breakMaybe, unfoldrM, validateUTF8)
6061
import Distribution.Verbosity (Verbosity)
6162
import Distribution.Version (Version, mkVersion, versionNumbers)
@@ -71,6 +72,7 @@ import qualified Distribution.Types.Executable.Lens as L
7172
import qualified Distribution.Types.ForeignLib.Lens as L
7273
import qualified Distribution.Types.GenericPackageDescription.Lens as L
7374
import qualified Distribution.Types.PackageDescription.Lens as L
75+
import qualified Distribution.Types.SetupBuildInfo.Lens as L
7476
import qualified Text.Parsec as P
7577

7678
-- ---------------------------------------------------------------
@@ -727,14 +729,25 @@ checkForUndefinedFlags gpd = do
727729
-- i.e. what you write is what you get;
728730
-- For pre-3.4 we post-process the file.
729731
--
732+
-- Similarly, we process mixins.
733+
-- See https://github.com/haskell/cabal/issues/6281
734+
--
730735

731736
postProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
732737
postProcessInternalDeps specVer gpd
733738
| specVer >= CabalSpecV3_4 = gpd
734-
| otherwise = transformAllBuildDependsN (concatMap f) gpd
739+
| otherwise = transformAllBuildInfos transformBI transformSBI gpd
735740
where
736-
f :: Dependency -> [Dependency]
737-
f (Dependency pn vr ln)
741+
transformBI :: BuildInfo -> BuildInfo
742+
transformBI
743+
= over L.targetBuildDepends (concatMap transformD)
744+
. over L.mixins (map transformM)
745+
746+
transformSBI :: SetupBuildInfo -> SetupBuildInfo
747+
transformSBI = over L.setupDepends (concatMap transformD)
748+
749+
transformD :: Dependency -> [Dependency]
750+
transformD (Dependency pn vr ln)
738751
| uqn `Set.member` internalLibs
739752
, LMainLibName `NES.member` ln
740753
= case NES.delete LMainLibName ln of
@@ -744,7 +757,16 @@ postProcessInternalDeps specVer gpd
744757
uqn = packageNameToUnqualComponentName pn
745758
dep = Dependency thisPn vr (NES.singleton (LSubLibName uqn))
746759

747-
f d = [d]
760+
transformD d = [d]
761+
762+
transformM :: Mixin -> Mixin
763+
transformM (Mixin pn LMainLibName incl)
764+
| uqn `Set.member` internalLibs
765+
= mkMixin thisPn (LSubLibName uqn) incl
766+
where
767+
uqn = packageNameToUnqualComponentName pn
768+
769+
transformM m = m
748770

749771
thisPn :: PackageName
750772
thisPn = pkgName (package (packageDescription gpd))

‎Cabal/Distribution/PackageDescription/PrettyPrint.hs

Lines changed: 24 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -33,17 +33,20 @@ import Prelude ()
3333

3434
import Distribution.CabalSpecVersion
3535
import Distribution.Fields.Pretty
36+
import Distribution.Compat.Lens
3637
import Distribution.PackageDescription
3738
import Distribution.Pretty
38-
import Distribution.Simple.Utils
39-
39+
import Distribution.Simple.Utils (writeFileAtomic, writeUTF8File)
40+
import Distribution.Types.Mixin (Mixin (..), mkMixin)
4041
import Distribution.FieldGrammar (PrettyFieldGrammar', prettyFieldGrammar)
41-
import Distribution.PackageDescription.Configuration (transformAllBuildDependsN)
42+
import Distribution.PackageDescription.Configuration (transformAllBuildInfos)
4243
import Distribution.PackageDescription.FieldGrammar
4344
(benchmarkFieldGrammar, buildInfoFieldGrammar, executableFieldGrammar, flagFieldGrammar, foreignLibFieldGrammar, libraryFieldGrammar,
4445
packageDescriptionFieldGrammar, setupBInfoFieldGrammar, sourceRepoFieldGrammar, testSuiteFieldGrammar)
4546

4647
import qualified Distribution.PackageDescription.FieldGrammar as FG
48+
import qualified Distribution.Types.BuildInfo.Lens as L
49+
import qualified Distribution.Types.SetupBuildInfo.Lens as L
4750

4851
import Text.PrettyPrint (Doc, char, hsep, parens, text)
4952

@@ -228,10 +231,18 @@ pdToGpd pd = GenericPackageDescription
228231
preProcessInternalDeps :: CabalSpecVersion -> GenericPackageDescription -> GenericPackageDescription
229232
preProcessInternalDeps specVer gpd
230233
| specVer >= CabalSpecV3_4 = gpd
231-
| otherwise = transformAllBuildDependsN (concatMap f) gpd
234+
| otherwise = transformAllBuildInfos transformBI transformSBI gpd
232235
where
233-
f :: Dependency -> [Dependency]
234-
f (Dependency pn vr ln)
236+
transformBI :: BuildInfo -> BuildInfo
237+
transformBI
238+
= over L.targetBuildDepends (concatMap transformD)
239+
. over L.mixins (map transformM)
240+
241+
transformSBI :: SetupBuildInfo -> SetupBuildInfo
242+
transformSBI = over L.setupDepends (concatMap transformD)
243+
244+
transformD :: Dependency -> [Dependency]
245+
transformD (Dependency pn vr ln)
235246
| pn == thisPn
236247
= if LMainLibName `NES.member` ln
237248
then Dependency thisPn vr mainLibSet : sublibs
@@ -242,7 +253,13 @@ preProcessInternalDeps specVer gpd
242253
| LSubLibName uqn <- NES.toList ln
243254
]
244255

245-
f d = [d]
256+
transformD d = [d]
257+
258+
transformM :: Mixin -> Mixin
259+
transformM (Mixin pn (LSubLibName uqn) inc)
260+
| pn == thisPn
261+
= mkMixin (unqualComponentNameToPackageName uqn) LMainLibName inc
262+
transformM m = m
246263

247264
thisPn :: PackageName
248265
thisPn = pkgName (package (packageDescription gpd))

‎Cabal/Distribution/Types/GenericPackageDescription.hs

Lines changed: 29 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
{-# LANGUAGE DeriveGeneric #-}
33
{-# LANGUAGE FlexibleContexts #-}
44
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
5+
{-# LANGUAGE ScopedTypeVariables #-}
56

67
module Distribution.Types.GenericPackageDescription (
78
GenericPackageDescription(..),
@@ -74,14 +75,31 @@ emptyGenericPackageDescription = GenericPackageDescription emptyPackageDescripti
7475
-- Traversal Instances
7576

7677
instance L.HasBuildInfos GenericPackageDescription where
77-
traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
78-
GenericPackageDescription
79-
<$> L.traverseBuildInfos f p
80-
<*> pure v
81-
<*> pure a1
82-
<*> (traverse . traverse . L.buildInfo) f x1
83-
<*> (traverse . L._2 . traverse . L.buildInfo) f x2
84-
<*> (traverse . L._2 . traverse . L.buildInfo) f x3
85-
<*> (traverse . L._2 . traverse . L.buildInfo) f x4
86-
<*> (traverse . L._2 . traverse . L.buildInfo) f x5
87-
<*> (traverse . L._2 . traverse . L.buildInfo) f x6
78+
traverseBuildInfos f (GenericPackageDescription p v a1 x1 x2 x3 x4 x5 x6) =
79+
GenericPackageDescription
80+
<$> L.traverseBuildInfos f p
81+
<*> pure v
82+
<*> pure a1
83+
<*> (traverse . traverseCondTreeBuildInfo) f x1
84+
<*> (traverse . L._2 . traverseCondTreeBuildInfo) f x2
85+
<*> (traverse . L._2 . traverseCondTreeBuildInfo) f x3
86+
<*> (traverse . L._2 . traverseCondTreeBuildInfo) f x4
87+
<*> (traverse . L._2 . traverseCondTreeBuildInfo) f x5
88+
<*> (traverse . L._2 . traverseCondTreeBuildInfo) f x6
89+
where
90+
91+
-- We use this traversal to keep [Dependency] field in CondTree up to date.
92+
traverseCondTreeBuildInfo
93+
:: forall f comp v. (Applicative f, L.HasBuildInfo comp)
94+
=> LensLike' f (CondTree v [Dependency] comp) L.BuildInfo
95+
traverseCondTreeBuildInfo g = node where
96+
mkCondNode :: comp -> [CondBranch v [Dependency] comp] -> CondTree v [Dependency] comp
97+
mkCondNode comp branches = CondNode comp (view L.targetBuildDepends comp) branches
98+
99+
node (CondNode comp _ branches) = mkCondNode
100+
<$> L.buildInfo g comp
101+
<*> traverse branch branches
102+
103+
branch (CondBranch v x y) = CondBranch v
104+
<$> node x
105+
<*> traverse node y

‎Cabal/Distribution/Types/Mixin.hs

Lines changed: 59 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3,19 +3,32 @@
33

44
module Distribution.Types.Mixin (
55
Mixin(..),
6+
mkMixin,
7+
normaliseMixin,
68
) where
79

810
import Distribution.Compat.Prelude
911
import Prelude ()
1012

13+
import Distribution.CabalSpecVersion
1114
import Distribution.Parsec
1215
import Distribution.Pretty
1316
import Distribution.Types.IncludeRenaming
17+
import Distribution.Types.LibraryName
1418
import Distribution.Types.PackageName
19+
import Distribution.Types.UnqualComponentName
1520

1621
import qualified Distribution.Compat.CharParsing as P
22+
import qualified Text.PrettyPrint as PP
1723

24+
-- |
25+
--
26+
-- /Invariant:/ if 'mixinLibraryName' is 'LSubLibName', it's not
27+
-- the same as 'mixinPackageName'. In other words,
28+
-- the same invariant as 'Dependency' has.
29+
--
1830
data Mixin = Mixin { mixinPackageName :: PackageName
31+
, mixinLibraryName :: LibraryName
1932
, mixinIncludeRenaming :: IncludeRenaming }
2033
deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
2134

@@ -25,11 +38,54 @@ instance Structured Mixin
2538
instance NFData Mixin where rnf = genericRnf
2639

2740
instance Pretty Mixin where
28-
pretty (Mixin pkg_name incl) = pretty pkg_name <+> pretty incl
41+
pretty (Mixin pn LMainLibName incl) = pretty pn <+> pretty incl
42+
pretty (Mixin pn (LSubLibName ln) incl) = pretty pn <<>> PP.colon <<>> pretty ln <+> pretty incl
2943

44+
-- |
45+
--
46+
-- >>> simpleParsec "mylib" :: Maybe Mixin
47+
-- Just (Mixin {mixinPackageName = PackageName "mylib", mixinLibraryName = LMainLibName, mixinIncludeRenaming = IncludeRenaming {includeProvidesRn = DefaultRenaming, includeRequiresRn = DefaultRenaming}})
48+
--
49+
-- >>> simpleParsec "thatlib:sublib" :: Maybe Mixin
50+
-- Just (Mixin {mixinPackageName = PackageName "thatlib", mixinLibraryName = LSubLibName (UnqualComponentName "sublib"), mixinIncludeRenaming = IncludeRenaming {includeProvidesRn = DefaultRenaming, includeRequiresRn = DefaultRenaming}})
51+
--
52+
-- >>> simpleParsec "thatlib:thatlib" :: Maybe Mixin
53+
-- Just (Mixin {mixinPackageName = PackageName "thatlib", mixinLibraryName = LMainLibName, mixinIncludeRenaming = IncludeRenaming {includeProvidesRn = DefaultRenaming, includeRequiresRn = DefaultRenaming}})
54+
--
55+
-- Sublibrary syntax is accepted since @cabal-version: 3.4@.
56+
--
57+
-- >>> map (`simpleParsec'` "mylib:sub") [CabalSpecV3_0, CabalSpecV3_4] :: [Maybe Mixin]
58+
-- [Nothing,Just (Mixin {mixinPackageName = PackageName "mylib", mixinLibraryName = LSubLibName (UnqualComponentName "sub"), mixinIncludeRenaming = IncludeRenaming {includeProvidesRn = DefaultRenaming, includeRequiresRn = DefaultRenaming}})]
59+
--
3060
instance Parsec Mixin where
3161
parsec = do
32-
mod_name <- parsec
62+
pn <- parsec
63+
ln <- P.option LMainLibName $ do
64+
_ <- P.char ':'
65+
versionGuardMultilibs
66+
parsecWarning PWTExperimental "colon specifier is experimental feature (issue #5660)"
67+
LSubLibName <$> parsec
3368
P.spaces
3469
incl <- parsec
35-
return (Mixin mod_name incl)
70+
return (mkMixin pn ln incl)
71+
where
72+
73+
versionGuardMultilibs :: CabalParsing m => m ()
74+
versionGuardMultilibs = do
75+
csv <- askCabalSpecVersion
76+
when (csv < CabalSpecV3_4) $ fail $ unwords
77+
[ "Sublibrary mixin syntax used."
78+
, "To use this syntax the package needs to specify at least 'cabal-version: 3.4'."
79+
]
80+
81+
-- | Smart constructor of 'Mixin', enforces invariant.
82+
mkMixin :: PackageName -> LibraryName -> IncludeRenaming -> Mixin
83+
mkMixin pn (LSubLibName uqn) incl
84+
| packageNameToUnqualComponentName pn == uqn
85+
= Mixin pn LMainLibName incl
86+
mkMixin pn ln incl
87+
= Mixin pn ln incl
88+
89+
-- | Restore invariant
90+
normaliseMixin :: Mixin -> Mixin
91+
normaliseMixin (Mixin pn ln incl) = mkMixin pn ln incl

0 commit comments

Comments
 (0)