Skip to content

Commit

Permalink
Multiple libraries (allow depending on sublibs)
Browse files Browse the repository at this point in the history
Create a new syntax for depending on any library of any package.
The syntax is

    build-depends: pkgname:{pkgname, sublibname} -any

where the second `pkgname` specifies a dependency on the main unnamed
library.

Closes haskell#4206.
  • Loading branch information
fgaz committed Oct 16, 2018
1 parent d751bfe commit a774cc3
Show file tree
Hide file tree
Showing 32 changed files with 261 additions and 136 deletions.
2 changes: 1 addition & 1 deletion Cabal/Distribution/Backpack/ComponentsGraph.hs
Original file line number Diff line number Diff line change
Expand Up @@ -68,7 +68,7 @@ mkComponentsGraph enabled pkg_descr =
++ [ if pkgname == packageName pkg_descr
then CLibName LMainLibName
else CLibName (LSubLibName toolname)
| Dependency pkgname _ <- targetBuildDepends bi
| Dependency pkgname _ _ <- targetBuildDepends bi
, let toolname = packageNameToUnqualComponentName pkgname
, toolname `elem` internalPkgDeps ]
where
Expand Down
31 changes: 28 additions & 3 deletions Cabal/Distribution/Backpack/ConfiguredComponent.hs
Original file line number Diff line number Diff line change
Expand Up @@ -30,6 +30,7 @@ import Distribution.Types.PackageId
import Distribution.Types.PackageName
import Distribution.Types.Mixin
import Distribution.Types.ComponentName
import Distribution.Types.LibraryName
import Distribution.Types.UnqualComponentName
import Distribution.Types.ComponentInclude
import Distribution.Package
Expand Down Expand Up @@ -165,16 +166,40 @@ toConfiguredComponent
toConfiguredComponent pkg_descr this_cid lib_dep_map exe_dep_map component = do
lib_deps <-
if newPackageDepsBehaviour pkg_descr
then forM (targetBuildDepends bi) $ \(Dependency name _) -> do
then fmap concat $ forM (targetBuildDepends bi) $ \(Dependency name _ sublibs) -> do
let (pn, cn) = fixFakePkgName pkg_descr name
value <- case Map.lookup cn =<< Map.lookup pn lib_dep_map of
pkg <- case Map.lookup pn lib_dep_map of
Nothing ->
dieProgress $
text "Dependency on unbuildable" <+>
text "package" <+> disp pn
Just p -> return p
mainLibraryComponent <-
if sublibs /= Set.singleton LMainLibName
then pure Nothing
-- No sublibraries were specified, so we may be in the
-- legacy case where the package name is used as library
-- name
else Just <$>
case Map.lookup cn pkg of
Nothing ->
dieProgress $
text "Dependency on unbuildable (i.e. 'buildable: False')" <+>
text (showComponentName cn) <+>
text "from" <+> disp pn
Just v -> return v
return value
subLibrariesComponents <- forM (Set.toList sublibs) $ \lib ->
let comp = CLibName lib in
case Map.lookup (CLibName $ LSubLibName $ packageNameToUnqualComponentName name) pkg
<|> Map.lookup comp pkg
of
Nothing ->
dieProgress $
text "Dependency on unbuildable" <+>
text (showLibraryName lib) <+>
text "from" <+> disp pn
Just v -> return v
return (maybeToList mainLibraryComponent ++ subLibrariesComponents)
else return old_style_lib_deps
mkConfiguredComponent
pkg_descr this_cid
Expand Down
34 changes: 17 additions & 17 deletions Cabal/Distribution/PackageDescription/Check.hs
Original file line number Diff line number Diff line change
Expand Up @@ -585,7 +585,7 @@ checkFields pkg =
, name `elem` map display knownLanguages ]

testedWithImpossibleRanges =
[ Dependency (mkPackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr Set.empty
| (compiler, vr) <- testedWith pkg
, isNoVersion vr ]

Expand All @@ -598,7 +598,7 @@ checkFields pkg =
internalLibDeps =
[ dep
| bi <- allBuildInfo pkg
, dep@(Dependency name _) <- targetBuildDepends bi
, dep@(Dependency name _ _) <- targetBuildDepends bi
, name `elem` internalLibraries
]

Expand All @@ -611,14 +611,14 @@ checkFields pkg =

depInternalLibraryWithExtraVersion =
[ dep
| dep@(Dependency _ versionRange) <- internalLibDeps
| dep@(Dependency _ versionRange _) <- internalLibDeps
, not $ isAnyVersion versionRange
, packageVersion pkg `withinRange` versionRange
]

depInternalLibraryWithImpossibleVersion =
[ dep
| dep@(Dependency _ versionRange) <- internalLibDeps
| dep@(Dependency _ versionRange _) <- internalLibDeps
, not $ packageVersion pkg `withinRange` versionRange
]

Expand Down Expand Up @@ -1243,8 +1243,8 @@ checkCabalVersion pkg =
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ display (Dependency name (eliminateWildcardSyntax versionRange))
| Dependency name versionRange <- depsUsingWildcardSyntax ]
[ display (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- depsUsingWildcardSyntax ]

-- check use of "build-depends: foo ^>= 1.2.3" syntax
, checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $
Expand All @@ -1255,8 +1255,8 @@ checkCabalVersion pkg =
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: 2.0'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ display (Dependency name (eliminateMajorBoundSyntax versionRange))
| Dependency name versionRange <- depsUsingMajorBoundSyntax ]
[ display (Dependency name (eliminateMajorBoundSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- depsUsingMajorBoundSyntax ]

, checkVersion [2,1] (any (not . null)
(concatMap buildInfoField
Expand Down Expand Up @@ -1292,8 +1292,8 @@ checkCabalVersion pkg =
++ ". To use this new syntax the package need to specify at least "
++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility "
++ "is important then use: " ++ commaSep
[ display (Dependency name (eliminateWildcardSyntax versionRange))
| Dependency name versionRange <- testedWithUsingWildcardSyntax ]
[ display (Dependency name (eliminateWildcardSyntax versionRange) Set.empty)
| Dependency name versionRange _ <- testedWithUsingWildcardSyntax ]

-- check use of "source-repository" section
, checkVersion [1,6] (not (null (sourceRepos pkg))) $
Expand Down Expand Up @@ -1367,11 +1367,11 @@ checkCabalVersion pkg =
buildInfoField field = map field (allBuildInfo pkg)

versionRangeExpressions =
[ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
[ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesNewVersionRangeSyntax vr ]

testedWithVersionRangeExpressions =
[ Dependency (mkPackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr Set.empty
| (compiler, vr) <- testedWith pkg
, usesNewVersionRangeSyntax vr ]

Expand All @@ -1395,16 +1395,16 @@ checkCabalVersion pkg =
alg (VersionRangeParensF _) = 3
alg _ = 1 :: Int

depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesWildcardSyntax vr ]

depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg
depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr _) <- allBuildDepends pkg
, usesMajorBoundSyntax vr ]

usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg)

testedWithUsingWildcardSyntax =
[ Dependency (mkPackageName (display compiler)) vr
[ Dependency (mkPackageName (display compiler)) vr Set.empty
| (compiler, vr) <- testedWith pkg
, usesWildcardSyntax vr ]

Expand Down Expand Up @@ -1493,7 +1493,7 @@ checkCabalVersion pkg =
allModuleNamesAutogen = concatMap autogenModules (allBuildInfo pkg)

displayRawDependency :: Dependency -> String
displayRawDependency (Dependency pkg vr) =
displayRawDependency (Dependency pkg vr _sublibs) =
display pkg ++ " " ++ display vr


Expand Down Expand Up @@ -1545,7 +1545,7 @@ checkPackageVersions pkg =
foldr intersectVersionRanges anyVersion baseDeps
where
baseDeps =
[ vr | Dependency pname vr <- allBuildDepends pkg'
[ vr | Dependency pname vr _ <- allBuildDepends pkg'
, pname == mkPackageName "base" ]

-- Just in case finalizePD fails for any reason,
Expand Down
18 changes: 14 additions & 4 deletions Cabal/Distribution/PackageDescription/Configuration.hs
Original file line number Diff line number Diff line change
Expand Up @@ -65,6 +65,8 @@ import Distribution.Types.DependencyMap

import qualified Data.Map.Strict as Map.Strict
import qualified Data.Map.Lazy as Map
import Data.Set ( Set )
import qualified Data.Set as Set
import Data.Tree ( Tree(Node) )

------------------------------------------------------------------------------
Expand Down Expand Up @@ -229,7 +231,7 @@ resolveWithFlags dom enabled os arch impl constrs trees checkDeps =
mp (Left xs) (Left ys) =
let union = Map.foldrWithKey (Map.Strict.insertWith combine)
(unDepMapUnion xs) (unDepMapUnion ys)
combine x y = simplifyVersionRange $ unionVersionRanges x y
combine x y = (\(vr, cs) -> (simplifyVersionRange vr,cs)) $ unionVersionRanges' x y
in union `seq` Left (DepMapUnion union)

-- `mzero'
Expand Down Expand Up @@ -307,14 +309,22 @@ extractConditions f gpkg =


-- | A map of dependencies that combines version ranges using 'unionVersionRanges'.
newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange }
newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName (VersionRange, Set LibraryName) }

-- An union of versions should correspond to an intersection of the components.
-- The intersection may not be necessary.
unionVersionRanges' :: (VersionRange, Set LibraryName)
-> (VersionRange, Set LibraryName)
-> (VersionRange, Set LibraryName)
unionVersionRanges' (vra, csa) (vrb, csb) =
(unionVersionRanges vra vrb, Set.intersection csa csb)

toDepMapUnion :: [Dependency] -> DepMapUnion
toDepMapUnion ds =
DepMapUnion $ Map.fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ]
DepMapUnion $ Map.fromListWith unionVersionRanges' [ (p,(vr,cs)) | Dependency p vr cs <- ds ]

fromDepMapUnion :: DepMapUnion -> [Dependency]
fromDepMapUnion m = [ Dependency p vr | (p,vr) <- Map.toList (unDepMapUnion m) ]
fromDepMapUnion m = [ Dependency p vr cs | (p,(vr,cs)) <- Map.toList (unDepMapUnion m) ]

freeVars :: CondTree ConfVar c a -> [FlagName]
freeVars t = [ f | Flag f <- freeVars' t ]
Expand Down
47 changes: 31 additions & 16 deletions Cabal/Distribution/Simple/Configure.hs
Original file line number Diff line number Diff line change
Expand Up @@ -143,6 +143,8 @@ import Text.PrettyPrint
import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO )

import qualified Data.Set as Set


type UseExternalInternalDeps = Bool

Expand Down Expand Up @@ -874,7 +876,7 @@ dependencySatisfiable
dependencySatisfiable
use_external_internal_deps
exact_config pn installedPackageSet internalPackageSet requiredDepsMap
d@(Dependency depName vr)
(Dependency depName vr sublibs)

| exact_config
-- When we're given '--exact-configuration', we assume that all
Expand All @@ -889,7 +891,19 @@ dependencySatisfiable
-- Except for internal deps, when we're NOT per-component mode;
-- those are just True.
then True
else (depName, CLibName LMainLibName) `Map.member` requiredDepsMap
else
-- Backward compatibility for the old sublibrary syntax
(sublibs == Set.singleton LMainLibName
&& Map.member
(pn, CLibName $ LSubLibName $ packageNameToUnqualComponentName depName)
requiredDepsMap)

|| all
(\lib ->
(depName, CLibName lib)
`Map.member`
requiredDepsMap)
sublibs

| isInternalDep
= if use_external_internal_deps
Expand All @@ -908,11 +922,11 @@ dependencySatisfiable
isInternalDep = Map.member depName internalPackageSet

depSatisfiable =
not . null $ PackageIndex.lookupDependency installedPackageSet d
not . null $ PackageIndex.lookupDependency installedPackageSet depName vr

internalDepSatisfiable =
not . null $ PackageIndex.lookupInternalDependency
installedPackageSet (Dependency pn vr) cn
installedPackageSet pn vr cn
where
cn | pn == depName
= Nothing
Expand Down Expand Up @@ -1025,8 +1039,8 @@ configureDependencies verbosity use_external_internal_deps
internalPackageSet installedPackageSet requiredDepsMap pkg_descr enableSpec = do
let failedDeps :: [FailedDependency]
allPkgDeps :: [ResolvedDependency]
(failedDeps, allPkgDeps) = partitionEithers
[ (\s -> (dep, s)) <$> status
(failedDeps, allPkgDeps) = partitionEithers $ concat
[ fmap (\s -> (dep, s)) <$> status
| dep <- enabledBuildDepends pkg_descr enableSpec
, let status = selectDependency (package pkg_descr)
internalPackageSet installedPackageSet
Expand Down Expand Up @@ -1197,10 +1211,10 @@ selectDependency :: PackageId -- ^ Package id of current package
-> UseExternalInternalDeps -- ^ Are we configuring a
-- single component?
-> Dependency
-> Either FailedDependency DependencyResolution
-> [Either FailedDependency DependencyResolution]
selectDependency pkgid internalIndex installedIndex requiredDepsMap
use_external_internal_deps
dep@(Dependency dep_pkgname vr) =
(Dependency dep_pkgname vr libs) =
-- If the dependency specification matches anything in the internal package
-- index, then we prefer that match to anything in the second.
-- For example:
Expand All @@ -1216,18 +1230,19 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap
-- even if there is a newer installed library "MyLibrary-0.2".
case Map.lookup dep_pkgname internalIndex of
Just cname -> if use_external_internal_deps
then do_external (Just cname)
then do_external (Just cname) <$> Set.toList libs
else do_internal
_ -> do_external Nothing
_ -> do_external Nothing <$> Set.toList libs
where

-- It's an internal library, and we're not per-component build
do_internal = Right $ InternalDependency
$ PackageIdentifier dep_pkgname $ packageVersion pkgid
do_internal = [Right $ InternalDependency
$ PackageIdentifier dep_pkgname $ packageVersion pkgid]

-- We have to look it up externally
do_external is_internal = do
ipi <- case Map.lookup (dep_pkgname, CLibName LMainLibName) requiredDepsMap of
do_external :: Maybe (Maybe UnqualComponentName) -> LibraryName -> Either FailedDependency DependencyResolution
do_external is_internal lib = do
ipi <- case Map.lookup (dep_pkgname, CLibName lib) requiredDepsMap of
-- If we know the exact pkg to use, then use it.
Just pkginstance -> Right pkginstance
-- Otherwise we just pick an arbitrary instance of the latest version.
Expand All @@ -1239,14 +1254,14 @@ selectDependency pkgid internalIndex installedIndex requiredDepsMap

-- It's an external package, normal situation
do_external_external =
case PackageIndex.lookupDependency installedIndex dep of
case PackageIndex.lookupDependency installedIndex dep_pkgname vr of
[] -> Left (DependencyNotExists dep_pkgname)
pkgs -> Right $ head $ snd $ last pkgs

-- It's an internal library, being looked up externally
do_external_internal mb_uqn =
case PackageIndex.lookupInternalDependency installedIndex
(Dependency (packageName pkgid) vr) mb_uqn of
(packageName pkgid) vr mb_uqn of
[] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid))
pkgs -> Right $ head $ snd $ last pkgs

Expand Down
10 changes: 5 additions & 5 deletions Cabal/Distribution/Simple/PackageIndex.hs
Original file line number Diff line number Diff line change
Expand Up @@ -469,11 +469,11 @@ lookupPackageName index name =
--
-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.
--
lookupDependency :: InstalledPackageIndex -> Dependency
lookupDependency :: InstalledPackageIndex -> PackageName -> VersionRange
-> [(Version, [IPI.InstalledPackageInfo])]
lookupDependency index dep =
lookupDependency index pn vr =
-- Yes, a little bit of a misnomer here!
lookupInternalDependency index dep Nothing
lookupInternalDependency index pn vr Nothing

-- | Does a lookup by source package name and a range of versions.
--
Expand All @@ -482,10 +482,10 @@ lookupDependency index dep =
--
-- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty.
--
lookupInternalDependency :: InstalledPackageIndex -> Dependency
lookupInternalDependency :: InstalledPackageIndex -> PackageName -> VersionRange
-> Maybe UnqualComponentName
-> [(Version, [IPI.InstalledPackageInfo])]
lookupInternalDependency index (Dependency name versionRange) libn =
lookupInternalDependency index name versionRange libn =
case Map.lookup (name, libn) (packageIdIndex index) of
Nothing -> []
Just pvers -> [ (ver, pkgs')
Expand Down
Loading

0 comments on commit a774cc3

Please sign in to comment.