From 7cc0aede1c75af081357f3b83cc94c1462a1bf0f Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 30 Dec 2016 18:15:46 -0500 Subject: [PATCH] Distinguish between internal and external libraries in `build-depends` Fixes #4155. We create a new `LibDependency` just used for parsing `build-depends` entries for now, but I hope it has a bright future in the brave new per-component world. --- Cabal/Cabal.cabal | 1 + .../Distribution/Backpack/ComponentsGraph.hs | 22 +- Cabal/Distribution/Backpack/Configure.hs | 2 +- .../Backpack/ConfiguredComponent.hs | 176 ++++++++-------- .../Backpack/PreExistingComponent.hs | 13 +- .../Distribution/PackageDescription/Parse.hs | 10 +- .../PackageDescription/Parsec/FieldDescr.hs | 6 +- Cabal/Distribution/Parsec/Class.hs | 16 +- Cabal/Distribution/Simple/Configure.hs | 192 +++++++++--------- Cabal/Distribution/Simple/Setup.hs | 14 +- Cabal/Distribution/Types/BuildInfo.hs | 61 +++++- Cabal/Distribution/Types/DependencyMap.hs | 4 + Cabal/Distribution/Types/ExeDependency.hs | 11 +- Cabal/Distribution/Types/LibDependency.hs | 62 ++++++ Cabal/Distribution/Types/Mixin.hs | 13 +- Cabal/doc/developing-packages.rst | 18 +- .../PackageTests/Backpack/Fail1/Fail1.cabal | 3 +- .../Backpack/Includes2/Includes2.cabal | 8 +- .../Backpack/Includes3/Includes3.cabal | 6 +- .../Backpack/Includes4/Includes4.cabal | 4 +- .../Backpack/Includes5/Includes5.cabal | 9 +- .../PackageTests/Backpack/Indef2/Indef2.cabal | 2 +- .../InternalLibraries/Executable/foo.cabal | 2 +- .../Library/foolib/foolib.cabal | 2 +- .../PackageTests/InternalLibraries/p/p.cabal | 4 +- 25 files changed, 395 insertions(+), 266 deletions(-) create mode 100644 Cabal/Distribution/Types/LibDependency.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index a6b9fcba390..3020005c985 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -243,6 +243,7 @@ library Distribution.Types.ComponentRequestedSpec Distribution.Types.TargetInfo Distribution.Types.UnqualComponentName + Distribution.Types.LibDependency Distribution.Utils.Generic Distribution.Utils.NubList Distribution.Utils.ShortText diff --git a/Cabal/Distribution/Backpack/ComponentsGraph.hs b/Cabal/Distribution/Backpack/ComponentsGraph.hs index 1ecf080dd71..ec9d0395b1c 100644 --- a/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -15,9 +15,9 @@ import Distribution.Simple.BuildToolDepends import Distribution.Simple.LocalBuildInfo import Distribution.Types.ComponentRequestedSpec import Distribution.Types.Dependency -import Distribution.Types.UnqualComponentName import Distribution.Compat.Graph (Node(..)) import qualified Distribution.Compat.Graph as Graph +import Distribution.Types.Mixin import Distribution.Text ( Text(disp) ) @@ -57,18 +57,18 @@ toComponentsGraph enabled pkg_descr = -- The dependencies for the given component componentDeps component = (CExeName <$> getAllInternalToolDependencies pkg_descr bi) - - ++ [ if pkgname == packageName pkg_descr - then CLibName - else CSubLibName toolname - | Dependency pkgname _ <- targetBuildDepends bi - , let toolname = packageNameToUnqualComponentName pkgname - , toolname `elem` internalPkgDeps ] + ++ mixin_deps + ++ if null mixin_deps -- the implicit dependency! + then [ CLibName + | Dependency pn _ <- targetBuildDepends bi + , pn == packageName pkg_descr ] + else [] where bi = componentBuildInfo component - internalPkgDeps = map (conv . libName) (allLibraries pkg_descr) - conv Nothing = packageNameToUnqualComponentName $ packageName pkg_descr - conv (Just s) = s + mixin_deps = + [ maybe CLibName CSubLibName (mixinLibraryName mix) + | mix <- mixins bi + , mixinPackageName mix == packageName pkg_descr ] -- | Error message when there is a cycle; takes the SCC of components. componentCycleMsg :: [ComponentName] -> Doc diff --git a/Cabal/Distribution/Backpack/Configure.hs b/Cabal/Distribution/Backpack/Configure.hs index bc7f5dc2588..0b00f5a84d8 100644 --- a/Cabal/Distribution/Backpack/Configure.hs +++ b/Cabal/Distribution/Backpack/Configure.hs @@ -81,7 +81,7 @@ configureComponentLocalBuildInfos (dispComponentsGraph graph0) let conf_pkg_map = Map.fromList - [(pc_pkgname pkg, (pc_cid pkg, pc_pkgid pkg)) + [((pc_pkgname pkg, CLibName), (pc_cid pkg, pc_pkgid pkg)) | pkg <- prePkgDeps] graph1 = toConfiguredComponents use_external_internal_deps flagAssignment diff --git a/Cabal/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/Distribution/Backpack/ConfiguredComponent.hs index 861d76e3cab..860000ddd0f 100644 --- a/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -19,10 +19,8 @@ import Distribution.Compat.Prelude hiding ((<>)) import Distribution.Backpack.Id -import Distribution.Types.Dependency import Distribution.Types.IncludeRenaming import Distribution.Types.Mixin -import Distribution.Types.UnqualComponentName import Distribution.Types.ComponentInclude import Distribution.Package import Distribution.PackageDescription as PD hiding (Flag) @@ -78,20 +76,30 @@ dispConfiguredComponent cc = | incl <- cc_includes cc ]) --- | Construct a 'ConfiguredComponent', given that the 'ComponentId' --- and library/executable dependencies are known. The primary --- work this does is handling implicit @backpack-include@ fields. -mkConfiguredComponent - :: PackageId +-- | This is a mapping that keeps track of package-internal libraries +-- and executables. Although a component of the key is a general +-- 'ComponentName', actually only 'CLib', 'CSubLib' and 'CExe' will ever +-- be here. +type ConfiguredComponentMap = + Map (PackageName, ComponentName) (ComponentId, PackageId) + +-- Executable map must be different because an executable can +-- have the same name as a library. Ew. + +-- | Given some ambient environment of package names that +-- are "in scope", looks at the 'BuildInfo' to decide +-- what the packages actually resolve to, and then builds +-- a 'ConfiguredComponent'. +toConfiguredComponent + :: PackageDescription -> ComponentId - -> [(PackageName, (ComponentId, PackageId))] - -> [ComponentId] + -> ConfiguredComponentMap -> Component -> ConfiguredComponent -mkConfiguredComponent this_pid this_cid lib_deps exe_deps component = +toConfiguredComponent pkg_descr this_cid deps_map component = ConfiguredComponent { cc_cid = this_cid, - cc_pkgid = this_pid, + cc_pkgid = package pkg_descr, cc_component = component, cc_public = is_public, cc_internal_build_tools = exe_deps, @@ -99,83 +107,74 @@ mkConfiguredComponent this_pid this_cid lib_deps exe_deps component = } where bi = componentBuildInfo component - deps_map = Map.fromList lib_deps -- Resolve each @mixins@ into the actual dependency -- from @lib_deps@. explicit_includes - = [ let (cid, pid) = - case Map.lookup name deps_map of - Nothing -> - error $ "Mix-in refers to non-existent package " ++ display name ++ - " (did you forget to add the package to build-depends?)" - Just r -> r + = [ let cname = maybe CLibName CSubLibName mb_lib_name + (cid, pid) = case Map.lookup (name, cname) deps_map of + -- TODO: give a better error message here if the *package* + -- exists, but doesn't have this component. + Nothing -> + error $ "Mix-in refers to non-existent component " ++ display cname ++ + " in " ++ display name ++ + " (did you forget to add the package to build-depends?)" + Just r -> r in ComponentInclude { ci_id = cid, - -- TODO: We set pkgName = name here to make error messages - -- look better. But it would be better to properly - -- record component name here. - ci_pkgid = pid { pkgName = name }, + ci_pkgid = pid, ci_renaming = rns, ci_implicit = False } - | Mixin name rns <- mixins bi ] + | Mixin name mb_lib_name rns <- mixins bi ] -- Any @build-depends@ which is not explicitly mentioned in -- @backpack-include@ is converted into an "implicit" include. - used_explicitly = Set.fromList (map ci_id explicit_includes) - implicit_includes - = map (\(pn, (cid, pid)) -> ComponentInclude { - ci_id = cid, - -- See above ci_pkgid - ci_pkgid = pid { pkgName = pn }, - ci_renaming = defaultIncludeRenaming, - ci_implicit = True - }) - $ filter (flip Set.notMember used_explicitly . fst . snd) lib_deps - - is_public = componentName component == CLibName - -type ConfiguredComponentMap = - (Map PackageName (ComponentId, PackageId), -- libraries - Map UnqualComponentName ComponentId) -- executables - --- Executable map must be different because an executable can --- have the same name as a library. Ew. - --- | Given some ambient environment of package names that --- are "in scope", looks at the 'BuildInfo' to decide --- what the packages actually resolve to, and then builds --- a 'ConfiguredComponent'. -toConfiguredComponent - :: PackageDescription - -> ComponentId - -> Map PackageName (ComponentId, PackageId) -- external - -> ConfiguredComponentMap - -> Component - -> ConfiguredComponent -toConfiguredComponent pkg_descr this_cid - external_lib_map (lib_map, exe_map) component = - mkConfiguredComponent - (package pkg_descr) this_cid - lib_deps exe_deps component - where - bi = componentBuildInfo component - find_it :: PackageName -> (ComponentId, PackageId) - find_it name = - fromMaybe (error ("toConfiguredComponent: " ++ display (packageName pkg_descr) ++ - " " ++ display name)) $ - Map.lookup name lib_map <|> - Map.lookup name external_lib_map + -- NB: This INCLUDES if you depend pkg:sublib (because other way + -- there's no way to depend on a sublib without depending on the + -- main library as well). + used_explicitly = Set.fromList (map (\m -> (mixinPackageName m, mixinLibraryName m)) + (mixins bi)) lib_deps | newPackageDepsBehaviour pkg_descr - = [ (name, find_it name) - | Dependency name _ <- targetBuildDepends bi ] + = [ case Map.lookup (pn, maybe CLibName CSubLibName mb_cn) deps_map of + Nothing -> + error ("toConfiguredComponent: " ++ display (packageName pkg_descr) ++ + " " ++ display pn) + Just r -> r + | Mixin pn mb_cn _ <- implicitMixins bi + , Set.notMember (pn,mb_cn) used_explicitly ] | otherwise - = Map.toList external_lib_map + -- deps_map contains a mix of internal and external deps. + -- We want all the public libraries (dep_cn == CLibName) + -- of all external deps (dep /= pn). Note that this + -- excludes the public library of the current package: + -- this is not supported by old-style deps behavior + -- because it would imply a cyclic dependency for the + -- library itself. + = [ r + | ((pn,cn), r) <- Map.toList deps_map + , pn /= packageName pkg_descr + , cn == CLibName + , Set.notMember (pn, Nothing) used_explicitly ] + implicit_includes + = map (\(cid, pid) -> + ComponentInclude { + ci_id = cid, + ci_pkgid = pid, + ci_renaming = defaultIncludeRenaming, + ci_implicit = True + }) lib_deps + exe_deps = [ cid | toolName <- getAllInternalToolDependencies pkg_descr bi - , Just cid <- [ Map.lookup toolName exe_map ] ] + , let cn = CExeName toolName + -- NB: we silently swallow non-existent build-tools, + -- because historically they did not have to correspond + -- to Haskell executables. + , Just (cid, _) <- [ Map.lookup (packageName pkg_descr, cn) deps_map ] ] + + is_public = componentName component == CLibName -- | Also computes the 'ComponentId', and sets cc_public if necessary. -- This is Cabal-only; cabal-install won't use this. @@ -186,45 +185,30 @@ toConfiguredComponent' -> Bool -- deterministic -> Flag String -- configIPID (todo: remove me) -> Flag ComponentId -- configCID - -> Map PackageName (ComponentId, PackageId) -- external -> ConfiguredComponentMap -> Component -> ConfiguredComponent toConfiguredComponent' use_external_internal_deps flags pkg_descr deterministic ipid_flag cid_flag - external_lib_map (lib_map, exe_map) component = + deps_map component = let cc = toConfiguredComponent pkg_descr this_cid - external_lib_map (lib_map, exe_map) component + deps_map component in if use_external_internal_deps then cc { cc_public = True } else cc where this_cid = computeComponentId deterministic ipid_flag cid_flag (package pkg_descr) (componentName component) (Just (deps, flags)) - deps = [ cid | (cid, _) <- Map.elems external_lib_map ] + deps = [ cid | ((dep_pn, _), (cid, _)) <- Map.toList deps_map + , dep_pn /= packageName pkg_descr ] extendConfiguredComponentMap :: ConfiguredComponent -> ConfiguredComponentMap -> ConfiguredComponentMap -extendConfiguredComponentMap cc (lib_map, exe_map) = - (lib_map', exe_map') - where - lib_map' - = case cc_name cc of - CLibName -> - Map.insert (pkgName (cc_pkgid cc)) - (cc_cid cc, cc_pkgid cc) lib_map - CSubLibName str -> - Map.insert (unqualComponentNameToPackageName str) - (cc_cid cc, cc_pkgid cc) lib_map - _ -> lib_map - exe_map' - = case cc_name cc of - CExeName str -> - Map.insert str (cc_cid cc) exe_map - _ -> exe_map +extendConfiguredComponentMap cc deps_map = + Map.insert (pkgName (cc_pkgid cc), cc_name cc) (cc_cid cc, cc_pkgid cc) deps_map -- Compute the 'ComponentId's for a graph of 'Component's. The -- list of internal components must be topologically sorted @@ -237,19 +221,19 @@ toConfiguredComponents -> Flag String -- configIPID -> Flag ComponentId -- configCID -> PackageDescription - -> Map PackageName (ComponentId, PackageId) + -> ConfiguredComponentMap -> [Component] -> [ConfiguredComponent] toConfiguredComponents use_external_internal_deps flags deterministic ipid_flag cid_flag pkg_descr - external_lib_map comps - = snd (mapAccumL go (Map.empty, Map.empty) comps) + deps_map comps + = snd (mapAccumL go deps_map comps) where go m component = (extendConfiguredComponentMap cc m, cc) where cc = toConfiguredComponent' use_external_internal_deps flags pkg_descr deterministic ipid_flag cid_flag - external_lib_map m component + m component newPackageDepsBehaviourMinVersion :: Version diff --git a/Cabal/Distribution/Backpack/PreExistingComponent.hs b/Cabal/Distribution/Backpack/PreExistingComponent.hs index 099481ba2ab..6940e612e38 100644 --- a/Cabal/Distribution/Backpack/PreExistingComponent.hs +++ b/Cabal/Distribution/Backpack/PreExistingComponent.hs @@ -8,6 +8,7 @@ import Prelude () import Distribution.Backpack.ModuleShape import Distribution.Backpack +import Distribution.Types.ComponentName import qualified Data.Map as Map import Distribution.Package @@ -18,12 +19,8 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo) -- we don't need to know how to build. data PreExistingComponent = PreExistingComponent { - -- | The 'PackageName' that, when we see it in 'PackageDescription', - -- we should map this to. This may DISAGREE with 'pc_pkgid' for - -- internal dependencies: e.g., an internal component @lib@ - -- may be munged to @z-pkg-z-lib@, but we still want to use - -- it when we see @lib@ in @build-depends@ pc_pkgname :: PackageName, + pc_compname :: ComponentName, pc_pkgid :: PackageId, pc_uid :: UnitId, pc_cid :: ComponentId, @@ -34,10 +31,11 @@ data PreExistingComponent -- | Convert an 'InstalledPackageInfo' into a 'PreExistingComponent', -- which was brought into scope under the 'PackageName' (important for -- a package qualified reference.) -ipiToPreExistingComponent :: (PackageName, InstalledPackageInfo) -> PreExistingComponent -ipiToPreExistingComponent (pn, ipi) = +ipiToPreExistingComponent :: (PackageName, ComponentName, InstalledPackageInfo) -> PreExistingComponent +ipiToPreExistingComponent (pn, cn, ipi) = PreExistingComponent { pc_pkgname = pn, + pc_compname = cn, pc_pkgid = Installed.sourcePackageId ipi, pc_uid = Installed.installedUnitId ipi, pc_cid = Installed.installedComponentId ipi, @@ -46,4 +44,3 @@ ipiToPreExistingComponent (pn, ipi) = (Map.fromList (Installed.instantiatedWith ipi)), pc_shape = shapeInstalledPackage ipi } - diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 1f237676f2f..5780b6fa344 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -53,10 +53,12 @@ module Distribution.PackageDescription.Parse ( import Prelude () import Distribution.Compat.Prelude +import Distribution.Types.BuildInfo import Distribution.Types.Dependency import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType import Distribution.Types.UnqualComponentName +import Distribution.Types.LibDependency import Distribution.Types.CondTree import Distribution.ParseUtils hiding (parseFields) import Distribution.PackageDescription @@ -427,7 +429,9 @@ binfoFieldDescrs = toolDepends (\xs binfo -> binfo{toolDepends=xs}) , commaListFieldWithSep vcat "build-depends" disp parse - targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs}) + buildDependencies + (\xs binfo -> binfo{targetBuildDepends=map libDependencyToDependency xs, + implicitMixins=map libDependencyToMixin xs}) , commaListFieldWithSep vcat "mixins" disp parse mixins (\xs binfo -> binfo{mixins=xs}) @@ -644,7 +648,7 @@ constraintFieldNames = ["build-depends"] -- they add and define an accessor that specifies what the dependencies -- are. This way we would completely reuse the parsing knowledge from the -- field descriptor. -parseConstraint :: Field -> ParseResult [Dependency] +parseConstraint :: Field -> ParseResult [LibDependency] parseConstraint (F l n v) | n `elem` constraintFieldNames = runP l n (parseCommaList parse) v parseConstraint f = userBug $ "Constraint was expected (got: " ++ show f ++ ")" @@ -1116,7 +1120,7 @@ parseGenericPackageDescription file = do -- to check the CondTree, rather than grovel everywhere -- inside the conditional bits). deps <- liftM concat - . traverse (lift . parseConstraint) + . traverse (lift . fmap (map libDependencyToDependency) . parseConstraint) . filter isConstraint $ simplFlds diff --git a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs index de6a86bfcae..fc5f88726f9 100644 --- a/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs +++ b/Cabal/Distribution/PackageDescription/Parsec/FieldDescr.hs @@ -43,6 +43,8 @@ import Distribution.ModuleName (ModuleName) import Distribution.Package import Distribution.PackageDescription import Distribution.Types.ForeignLib +import Distribution.Types.BuildInfo +import Distribution.Types.LibDependency import Distribution.Parsec.Class import Distribution.Parsec.Types.Common import Distribution.Parsec.Types.FieldDescr @@ -428,7 +430,9 @@ binfoFieldDescrs = toolDepends (\xs binfo -> binfo{toolDepends=xs}) , commaListFieldWithSep vcat "build-depends" disp parsec - targetBuildDepends (\xs binfo -> binfo{targetBuildDepends=xs}) + buildDependencies + (\xs binfo -> binfo{targetBuildDepends=map libDependencyToDependency xs, + implicitMixins=map libDependencyToMixin xs}) , commaListFieldWithSep vcat "mixins" disp parsec mixins (\xs binfo -> binfo{mixins=xs}) diff --git a/Cabal/Distribution/Parsec/Class.hs b/Cabal/Distribution/Parsec/Class.hs index c665c82226d..a6ca13588ce 100644 --- a/Cabal/Distribution/Parsec/Class.hs +++ b/Cabal/Distribution/Parsec/Class.hs @@ -57,6 +57,7 @@ import Distribution.Types.ForeignLibOption (ForeignLibOption import Distribution.Types.ModuleRenaming import Distribution.Types.IncludeRenaming import Distribution.Types.Mixin +import Distribution.Types.LibDependency import Distribution.Types.UnqualComponentName (UnqualComponentName, mkUnqualComponentName) import Distribution.Version @@ -375,9 +376,22 @@ instance Parsec IncludeRenaming where instance Parsec Mixin where parsec = do mod_name <- parsec + mb_lib_name <- P.option Nothing $ do + _ <- P.char ':' + fmap Just parsec P.spaces incl <- parsec - return (Mixin mod_name incl) + return (Mixin mod_name mb_lib_name incl) + +instance Parsec LibDependency where + parsec = do + name <- parsec + mb_cname <- P.option Nothing $ do + _ <- P.char ':' + fmap Just parsec + P.spaces + ver <- parsec <|> pure anyVersion + return (LibDependency name mb_cname ver) ------------------------------------------------------------------------------- -- Utilities diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index d739311eded..4c13c10f844 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -71,7 +71,10 @@ import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.PackageDescription as PD hiding (Flag) +import Distribution.Types.BuildInfo (buildDependencies) import Distribution.Types.PackageDescription as PD +import Distribution.Types.DependencyMap +import Distribution.Types.LibDependency import Distribution.PackageDescription.PrettyPrint import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) @@ -132,8 +135,8 @@ import System.IO ( hPutStrLn, hClose ) import Distribution.Text ( Text(disp), defaultStyle, display, simpleParse ) -import Text.PrettyPrint - ( Doc, (<+>), ($+$), char, comma, hsep, nest +import Text.PrettyPrint as PP + ( Doc, (<+>), ($+$), char, comma, empty, hsep, nest , punctuate, quotes, render, renderStyle, sep, text ) import Distribution.Compat.Environment ( lookupEnv ) import Distribution.Compat.Exception ( catchExit, catchIO ) @@ -404,11 +407,6 @@ configure (pkg_descr0', pbi) cfg = do <- getInstalledPackages (lessVerbose verbosity) comp packageDbs programDb - -- The set of package names which are "shadowed" by internal - -- packages, and which component they map to - let internalPackageSet :: Map PackageName ComponentName - internalPackageSet = getInternalPackages pkg_descr0 - -- Make a data structure describing what components are enabled. let enabled :: ComponentRequestedSpec enabled = case mb_cname of @@ -444,11 +442,12 @@ configure (pkg_descr0', pbi) cfg = do -- that is not possible to configure a test-suite to use one -- version of a dependency, and the executable to use another. (allConstraints :: [Dependency], - requiredDepsMap :: Map PackageName InstalledPackageInfo) + requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo) <- either (die' verbosity) return $ combinedConstraints (configConstraints cfg) (configDependencies cfg) installedPackageSet + let allConstraintsMap = toDepMap allConstraints -- pkg_descr: The resolved package description, that does not contain any -- conditionals, because we have have an assignment for @@ -474,8 +473,7 @@ configure (pkg_descr0', pbi) cfg = do (fromFlagOrDefault False (configExactConfiguration cfg)) (packageName pkg_descr0) installedPackageSet - internalPackageSet - requiredDepsMap) + allConstraintsMap) comp compPlatform pkg_descr0 @@ -517,11 +515,10 @@ configure (pkg_descr0', pbi) cfg = do -- For one it's deterministic; for two, we need to associate -- them with renamings which would require a far more complicated -- input scheme than what we have today.) - externalPkgDeps :: [(PackageName, InstalledPackageInfo)] + externalPkgDeps :: [(PackageName, ComponentName, InstalledPackageInfo)] <- configureDependencies verbosity use_external_internal_deps - internalPackageSet installedPackageSet requiredDepsMap pkg_descr @@ -600,7 +597,6 @@ configure (pkg_descr0', pbi) cfg = do -- components (which may build-depends on each other) and form a graph. -- From there, we build a ComponentLocalBuildInfo for each of the -- components, which lets us actually build each component. - -- internalPackageSet -- use_external_internal_deps (buildComponents :: [ComponentLocalBuildInfo], packageDependsIndex :: InstalledPackageIndex) <- @@ -818,8 +814,7 @@ checkExactConfiguration verbosity pkg_descr0 cfg = do -- It must be *any libraries that might be* defined rather than the -- actual definitions, because these depend on conditionals in the .cabal -- file, and we haven't resolved them yet. finalizePD --- does the resolution of conditionals, and it takes internalPackageSet --- as part of its input. +-- does the resolution of conditionals. getInternalPackages :: GenericPackageDescription -> Map PackageName ComponentName getInternalPackages pkg_descr0 = @@ -838,13 +833,12 @@ dependencySatisfiable -> Bool -- ^ exact configuration? -> PackageName -> InstalledPackageIndex -- ^ installed set - -> Map PackageName ComponentName -- ^ internal set - -> Map PackageName InstalledPackageInfo -- ^ required dependencies + -> DependencyMap -- ^ "known" dependencies to allow under exact config -> (Dependency -> Bool) dependencySatisfiable use_external_internal_deps - exact_config pn installedPackageSet internalPackageSet requiredDepsMap - (Dependency depName0 vr) + exact_config pn installedPackageSet allConstraintsMap + d@(Dependency depName _) -- When we are doing per-component configure, the behavior is very -- uniform: if an exact configuration is requested, check for the @@ -864,7 +858,7 @@ dependencySatisfiable else depSatisfiable where - isInternalDep = Map.member depName0 internalPackageSet + isInternalDep = depName == pn -- When we're given '--exact-configuration', we assume that all -- dependencies and flags are exactly specified on the command @@ -877,25 +871,9 @@ dependencySatisfiable -- when this fails? depSatisfiable = if exact_config - -- NB: required deps map is indexed by *compat* package name. - then depName `Map.member` requiredDepsMap + then isJust (lookupDepMap allConstraintsMap depName) else not . null . PackageIndex.lookupDependency installedPackageSet $ d - -- When it's an internal library, we have to lookup the *compat* - -- package name in the database; the real one won't match anything - d = Dependency depName vr - depName - | isInternalDep && pn /= depName0 - = computeCompatPackageName pn - -- TODO: Don't go through String - -- TODO: Hard-coding this to be a sub-library is a - -- bit grotty, but currently it seems that this - -- function is only called on build-depends - -- dependencies, which must be libraries. If - -- pn /= depName0, then it must be a sub library! - (CSubLibName (mkUnqualComponentName (unPackageName depName0))) - | otherwise = depName0 - -- | Relax the dependencies of this package if needed. relaxPackageDeps :: (VersionRange -> VersionRange) -> RelaxDeps @@ -1004,31 +982,35 @@ checkCompilerProblems verbosity comp pkg_descr enabled = do configureDependencies :: Verbosity -> UseExternalInternalDeps - -> Map PackageName ComponentName -- ^ internal packages -> InstalledPackageIndex -- ^ installed packages - -> Map PackageName InstalledPackageInfo -- ^ required deps + -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ required deps -> PackageDescription - -> IO [(PackageName, InstalledPackageInfo)] + -> IO [(PackageName, ComponentName, InstalledPackageInfo)] configureDependencies verbosity use_external_internal_deps - internalPackageSet installedPackageSet requiredDepsMap pkg_descr = do - let selectDependencies :: [Dependency] -> + installedPackageSet requiredDepsMap pkg_descr = do + let selectDependencies :: [LibDependency] -> ([FailedDependency], [ResolvedDependency]) selectDependencies = partitionEithers . map (selectDependency (package pkg_descr) - internalPackageSet installedPackageSet + installedPackageSet requiredDepsMap use_external_internal_deps) (failedDeps, allPkgDeps) = - selectDependencies (buildDepends pkg_descr) + selectDependencies (buildDependencies =<< allBuildInfo pkg_descr) - internalPkgDeps = [ pkgid - | InternalDependency _ pkgid <- allPkgDeps ] + internalPkgDeps = + [ pkgid | InternalDependency _ pkgid <- allPkgDeps ] -- NB: we have to SAVE the package name, because this is the only -- way we can be able to resolve package names in the package -- description. - externalPkgDeps = [ (pn, pkg) - | ExternalDependency (Dependency pn _) pkg <- allPkgDeps ] + externalPkgDeps = + [ (pn, cn, pkgid) + | ExternalDependency (LibDependency pn mcn _) pkgid <- allPkgDeps + , let cn = case mcn of + Nothing -> CLibName + Just n -> CSubLibName n + ] when (not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr)) $ @@ -1164,12 +1146,12 @@ data ResolvedDependency -- | An external dependency from the package database, OR an -- internal dependency which we are getting from the package -- database. - = ExternalDependency Dependency InstalledPackageInfo + = ExternalDependency LibDependency InstalledPackageInfo -- | An internal dependency ('PackageId' should be a library name) -- which we are going to have to build. (The -- 'PackageId' here is a hack to get a modest amount of -- polymorphism out of the 'Package' typeclass.) - | InternalDependency Dependency PackageId + | InternalDependency LibDependency PackageId data FailedDependency = DependencyNotExists PackageName | DependencyMissingInternal PackageName PackageName @@ -1177,56 +1159,49 @@ data FailedDependency = DependencyNotExists PackageName -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageId -- ^ Package id of current package - -> Map PackageName ComponentName -> InstalledPackageIndex -- ^ Installed packages - -> Map PackageName InstalledPackageInfo + -> Map (PackageName, ComponentName) InstalledPackageInfo -- ^ Packages for which we have been given specific deps to -- use -> UseExternalInternalDeps -- ^ Are we configuring a -- single component? - -> Dependency + -> LibDependency -> Either FailedDependency ResolvedDependency -selectDependency pkgid internalIndex installedIndex requiredDepsMap +selectDependency pkgid installedIndex requiredDepsMap use_external_internal_deps - dep@(Dependency dep_pkgname vr) = - -- If the dependency specification matches anything in the internal package - -- index, then we prefer that match to anything in the second. - -- For example: - -- - -- Name: MyLibrary - -- Version: 0.1 - -- Library - -- .. - -- Executable my-exec - -- build-depends: MyLibrary - -- - -- We want "build-depends: MyLibrary" always to match the internal library - -- 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) - else do_internal - _ -> do_external Nothing + dep@(LibDependency dep_pkgname dep_mb_compname vr) = + -- If external sublibs can someday we be used, we can simplify this + -- case. For now, we do the error as a basic sanity + -- check. PackageDescription.Check should give the user a nicer + -- error earlier in the pipeline. + case (dep_mb_compname, dep_pkgname == packageName pkgid, use_external_internal_deps) of + (_, True, False) -> do_internal + (Just _, False, _) -> error + "Should have already checked that external sub-libs are not depended on" + (_, _, _) -> do_external where do_internal = Right (InternalDependency dep (PackageIdentifier dep_pkgname (packageVersion pkgid))) - do_external is_internal = case Map.lookup dep_pkgname requiredDepsMap of + do_external = case Map.lookup (dep_pkgname, compName) requiredDepsMap of -- If we know the exact pkg to use, then use it. Just pkginstance -> Right (ExternalDependency dep pkginstance) -- Otherwise we just pick an arbitrary instance of the latest version. - Nothing -> case PackageIndex.lookupDependency installedIndex dep' of - [] -> Left $ - case is_internal of - Just cname -> DependencyMissingInternal dep_pkgname - (computeCompatPackageName (packageName pkgid) cname) - Nothing -> DependencyNotExists dep_pkgname - pkgs -> Right $ ExternalDependency dep $ - case last pkgs of + Nothing -> case PackageIndex.lookupDependency installedIndex legacyDep of + [] -> Left errVal + pkgs -> Right $ ExternalDependency dep $ case last pkgs of (_ver, pkginstances) -> head pkginstances where - dep' | Just cname <- is_internal - = Dependency (computeCompatPackageName (packageName pkgid) cname) vr - | otherwise = dep + (legacyDep, compName, errVal) = case dep_mb_compname of + Nothing -> ( Dependency dep_pkgname vr + , CLibName + , DependencyNotExists dep_pkgname + ) + Just intLibName -> ( Dependency extIntPkgName vr + , cname + , DependencyMissingInternal dep_pkgname extIntPkgName + ) + where extIntPkgName = computeCompatPackageName (packageName pkgid) cname + cname = CSubLibName intLibName -- NB: here computeCompatPackageName we want to pick up the INDEFINITE ones -- which is why we pass 'Nothing' as 'UnitId' @@ -1234,7 +1209,7 @@ reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () reportSelectedDependencies verbosity deps = info verbosity $ unlines - [ "Dependency " ++ display (simplifyDependency dep) + [ "Dependency " ++ display (simplifyLibDependency dep) ++ ": using " ++ display pkgid | resolved <- deps , let (dep, pkgid) = case resolved of @@ -1345,10 +1320,10 @@ interpretPackageDbFlags userInstall specificDBs = -- deps in the end. So we still need to remember which installed packages to -- pick. combinedConstraints :: [Dependency] -> - [(PackageName, ComponentId)] -> + [(PackageName, Maybe UnqualComponentName, ComponentId)] -> InstalledPackageIndex -> Either String ([Dependency], - Map PackageName InstalledPackageInfo) + Map (PackageName, ComponentName) InstalledPackageInfo) combinedConstraints constraints dependencies installedPackages = do when (not (null badComponentIds)) $ @@ -1361,22 +1336,37 @@ combinedConstraints constraints dependencies installedPackages = do return (allConstraints, idConstraintMap) where + -- Speculation: The [Dependency] we calculate here is going to be + -- used to decide how to toggle flags in the final package. But + -- this also makes it impossible for a package manager that knows + -- better to forcibly link up components from the same package + -- with inconsistent version numbers. + -- + -- If we're given all the constraints, why do we even need the + -- version ranges at all? The reason is that we still need to + -- pick a flag assignment when finalizing the PackageDescription. + -- But what if the user picks the flags too? In that case, we + -- really should just let the user do what they want. + allConstraints :: [Dependency] allConstraints = constraints - ++ [ thisPackageVersion (packageId pkg) - | (_, _, Just pkg) <- dependenciesPkgInfo ] + ++ [ Dependency pn (thisVersion (packageVersion pkg)) + -- NB: component name is discarded because the + -- version constraint applies to the package as a + -- whole. + | (pn, _, _, Just pkg) <- dependenciesPkgInfo ] - idConstraintMap :: Map PackageName InstalledPackageInfo + idConstraintMap :: Map (PackageName, ComponentName) InstalledPackageInfo idConstraintMap = Map.fromList - [ (packageName pkg, pkg) - | (_, _, Just pkg) <- dependenciesPkgInfo ] + [ ((pn, maybe CLibName CSubLibName mb_cn), pkg) + | (pn, mb_cn, _, Just pkg) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists - dependenciesPkgInfo :: [(PackageName, ComponentId, + dependenciesPkgInfo :: [(PackageName, Maybe UnqualComponentName, ComponentId, Maybe InstalledPackageInfo)] dependenciesPkgInfo = - [ (pkgname, cid, mpkg) - | (pkgname, cid) <- dependencies + [ (pkgname, mb_cname, cid, mpkg) + | (pkgname, mb_cname, cid) <- dependencies , let mpkg = PackageIndex.lookupComponentId installedPackages cid ] @@ -1385,13 +1375,13 @@ combinedConstraints constraints dependencies installedPackages = do -- (i.e. someone has written a hash) and didn't find it then it's -- an error. badComponentIds = - [ (pkgname, cid) - | (pkgname, cid, Nothing) <- dependenciesPkgInfo ] + [ (pkgname, mb_cname, cid) + | (pkgname, mb_cname, cid, Nothing) <- dependenciesPkgInfo ] dispDependencies deps = - hsep [ text "--dependency=" - <<>> quotes (disp pkgname <<>> char '=' <<>> disp cid) - | (pkgname, cid) <- deps ] + hsep [text "--dependency=" + <<>> quotes (disp pkgname <<>> (maybe PP.empty disp mb_cname) <<>> char '=' <<>> disp cid) + | (pkgname, mb_cname, cid) <- deps ] -- ----------------------------------------------------------------------------- -- Configuring program dependencies diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 46f724d4941..79aca135dc6 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -96,6 +96,7 @@ import Distribution.Simple.InstallDirs import Distribution.Verbosity import Distribution.Utils.NubList import Distribution.Types.Dependency +import Distribution.Types.UnqualComponentName import Distribution.Compat.Semigroup (Last' (..)) @@ -416,7 +417,7 @@ data ConfigFlags = ConfigFlags { configStripLibs :: Flag Bool, -- ^Enable library stripping configConstraints :: [Dependency], -- ^Additional constraints for -- dependencies. - configDependencies :: [(PackageName, ComponentId)], + configDependencies :: [(PackageName, Maybe UnqualComponentName, ComponentId)], -- ^The packages depended on. configInstantiateWith :: [(ModuleName, Module)], -- ^ The requested Backpack instantiation. If empty, either this @@ -793,7 +794,7 @@ configureOptions showOrParseArgs = configDependencies (\v flags -> flags { configDependencies = v}) (reqArg "NAME=CID" (readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parseDependency)) - (map (\x -> display (fst x) ++ "=" ++ display (snd x)))) + (map (\(pn,mb_cn,cid) -> display pn ++ (maybe "" (\x -> ":" ++ display x) mb_cn) ++ "=" ++ display cid))) ,option "" ["instantiate-with"] "A mapping of signature names to concrete module instantiations." @@ -884,12 +885,15 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] showProfDetailLevelFlag NoFlag = [] showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] -parseDependency :: Parse.ReadP r (PackageName, ComponentId) +parseDependency :: Parse.ReadP r (PackageName, Maybe UnqualComponentName, ComponentId) parseDependency = do x <- parse + y <- Parse.option Nothing $ do + _ <- Parse.char ':' + fmap Just parse _ <- Parse.char '=' - y <- parse - return (x, y) + z <- parse + return (x, y, z) installDirsOptions :: [OptionField (InstallDirs (Flag PathTemplate))] installDirsOptions = diff --git a/Cabal/Distribution/Types/BuildInfo.hs b/Cabal/Distribution/Types/BuildInfo.hs index 59bc8f5f422..c301e95ea59 100644 --- a/Cabal/Distribution/Types/BuildInfo.hs +++ b/Cabal/Distribution/Types/BuildInfo.hs @@ -8,6 +8,7 @@ module Distribution.Types.BuildInfo ( allLanguages, allExtensions, usedExtensions, + buildDependencies, hcOptions, hcProfOptions, @@ -22,11 +23,15 @@ import Distribution.Types.Dependency import Distribution.Types.ExeDependency import Distribution.Types.LegacyExeDependency import Distribution.Types.PkgconfigDependency +import Distribution.Types.DependencyMap +import Distribution.Types.LibDependency import Distribution.ModuleName import Distribution.Compiler import Language.Haskell.Extension +import qualified Data.Map as Map + -- Consider refactoring into executable and library versions. data BuildInfo = BuildInfo { buildable :: Bool, -- ^ component is buildable here @@ -77,11 +82,59 @@ data BuildInfo = BuildInfo { customFieldsBI :: [(String,String)], -- ^Custom fields starting -- with x-, stored in a -- simple assoc-list. - targetBuildDepends :: [Dependency], -- ^ Dependencies specific to a library or executable target + + -- | These are the library-level dependencies we have on + -- other packages. This corresponds closely to @build-depends@, + -- but this field drops any component names (anywhere you + -- see @pkg:lib >= 2.0@, this actually indicates the + -- 'Dependency' @pkg >= 2.0@. This field does NOT control + -- what libraries are brought into scope, for import in + -- Haskell (for that, see 'implicitMixins' and 'mixins'). + -- This combined with 'implicitMixins' constitute the "full" + -- meaning of @build-depends@; for backwards compatibility + -- we don't keep these together. + -- + -- Historically, this got the name 'targetBuildDepends' because + -- it was the @build-depends@ specific to a "target" (i.e., + -- a component); 'buildDepends' was reserved for the + -- package-wide @build-depends@. These days, target-specific + -- dependencies are the standard mode of use, so we really + -- ought to rename this. + targetBuildDepends :: [Dependency], + + -- | Implicit mix-ins implied by the @build-depends@ field, + -- as historically putting a library in @build-depends was + -- sufficient to bring the modules into scope. + implicitMixins :: [Mixin], + + -- | Explicitly specified mix-ins specified by the @mixins@ + -- field. If there is a 'Mixin' for a + -- 'PackageName'/'UnqualComponentName' combination here, it + -- overrides the corresponding entry from 'implicitMixins'. mixins :: [Mixin] } deriving (Generic, Show, Read, Eq, Typeable, Data) +-- | Attempt to reconstruct the literal @build-depends@ entries. +-- +-- NB: If we have an 'implicitMixin' without a corresponding +-- 'Dependency', it will be dropped. This INCLUDES if the mixin +-- is an internal dep; i.e., for this very package. This situation +-- shouldn't occur in practice because it means that the 'Dependency' +-- set was expanded/contracted, which should never happen (at +-- the moment, the only modifications we have are for changing +-- the 'VersionRange'.) +buildDependencies :: BuildInfo -> [LibDependency] +buildDependencies bi = do + -- Make sure each PackageName shows up once... + Dependency pn vr <- fromDepMap (toDepMap (targetBuildDepends bi)) + case Map.lookup pn imap of + Just xs@(_:_) -> do Mixin _ mb_cn _ <- xs + return (LibDependency pn mb_cn vr) + _ -> return (LibDependency pn Nothing vr) + where + imap = Map.fromListWith (++) [ (mixinPackageName m, [m]) | m <- implicitMixins bi ] + instance Binary BuildInfo instance Monoid BuildInfo where @@ -116,7 +169,8 @@ instance Monoid BuildInfo where sharedOptions = [], customFieldsBI = [], targetBuildDepends = [], - mixins = [] + implicitMixins = [], + mixins = [] } mappend = (<>) @@ -152,7 +206,8 @@ instance Semigroup BuildInfo where sharedOptions = combine sharedOptions, customFieldsBI = combine customFieldsBI, targetBuildDepends = combineNub targetBuildDepends, - mixins = combine mixins + implicitMixins = combine implicitMixins, + mixins = combine mixins } where combine field = field a `mappend` field b diff --git a/Cabal/Distribution/Types/DependencyMap.hs b/Cabal/Distribution/Types/DependencyMap.hs index b1504328943..49882276636 100644 --- a/Cabal/Distribution/Types/DependencyMap.hs +++ b/Cabal/Distribution/Types/DependencyMap.hs @@ -2,6 +2,7 @@ module Distribution.Types.DependencyMap ( DependencyMap, toDepMap, fromDepMap, + lookupDepMap, constrainBy, ) where @@ -34,6 +35,9 @@ toDepMap ds = fromDepMap :: DependencyMap -> [Dependency] fromDepMap m = [ Dependency p vr | (p,vr) <- Map.toList (unDependencyMap m) ] +lookupDepMap :: DependencyMap -> PackageName -> Maybe VersionRange +lookupDepMap (DependencyMap m) pn = Map.lookup pn m + -- Apply extra constraints to a dependency map. -- Combines dependencies where the result will only contain keys from the left -- (first) map. If a key also exists in the right map, both constraints will diff --git a/Cabal/Distribution/Types/ExeDependency.hs b/Cabal/Distribution/Types/ExeDependency.hs index e7d28fc2ef8..10bb8d3c21e 100644 --- a/Cabal/Distribution/Types/ExeDependency.hs +++ b/Cabal/Distribution/Types/ExeDependency.hs @@ -21,11 +21,12 @@ import Text.PrettyPrint ((<+>), text) -- | Describes a dependency on an executable from a package -- -data ExeDependency = ExeDependency - PackageName - UnqualComponentName -- name of executable component of package - VersionRange - deriving (Generic, Read, Show, Eq, Typeable, Data) +data ExeDependency = ExeDependency { + exeDepPackageName :: PackageName, + exeDepExecutableName :: UnqualComponentName, + libDepVersionRange :: VersionRange + } + deriving (Generic, Read, Show, Eq, Typeable, Data) instance Binary ExeDependency instance NFData ExeDependency where rnf = genericRnf diff --git a/Cabal/Distribution/Types/LibDependency.hs b/Cabal/Distribution/Types/LibDependency.hs new file mode 100644 index 00000000000..27378b3c11f --- /dev/null +++ b/Cabal/Distribution/Types/LibDependency.hs @@ -0,0 +1,62 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Distribution.Types.LibDependency ( + LibDependency(..), + libDependencyToDependency, + libDependencyToMixin, + simplifyLibDependency, +) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Package +import Distribution.Types.UnqualComponentName +import Distribution.Types.Mixin +import Distribution.Types.Dependency +import Distribution.Types.IncludeRenaming +import Distribution.Version + +import Distribution.Compat.ReadP +import Distribution.Text +import Text.PrettyPrint as PP ((<+>), text, empty) + +-- | Like 'Dependency', but this corresponds exactly to the syntax we support in +-- a Cabal file. +data LibDependency = LibDependency { + libDepPackageName :: PackageName, + libDepLibraryName :: Maybe UnqualComponentName, + libDepVersionRange :: VersionRange + } + deriving (Generic, Read, Show, Eq, Typeable, Data) + +instance Binary LibDependency +instance NFData LibDependency where rnf = genericRnf + +instance Text LibDependency where + disp (LibDependency name mCname ver) = + (disp name <<>> dispMaybeCname) <+> disp ver + where + dispMaybeCname = case mCname of + Nothing -> PP.empty + Just cname -> text ":" <<>> disp cname + + parse = do name <- parse + mb_cname <- option Nothing $ do + _ <- char ':' + fmap Just parse + skipSpaces + ver <- parse <++ return anyVersion + return (LibDependency name mb_cname ver) + +libDependencyToDependency :: LibDependency -> Dependency +libDependencyToDependency (LibDependency pn _ vr) = Dependency pn vr + +libDependencyToMixin :: LibDependency -> Mixin +libDependencyToMixin (LibDependency pn cn _) = Mixin pn cn defaultIncludeRenaming +-- | Simplify the 'VersionRange' expression in a 'Dependency'. +-- See 'simplifyVersionRange'. +-- +simplifyLibDependency :: LibDependency -> LibDependency +simplifyLibDependency (LibDependency name mb_cname range) = + LibDependency name mb_cname (simplifyVersionRange range) diff --git a/Cabal/Distribution/Types/Mixin.hs b/Cabal/Distribution/Types/Mixin.hs index fbe141a7476..c80e7122d81 100644 --- a/Cabal/Distribution/Types/Mixin.hs +++ b/Cabal/Distribution/Types/Mixin.hs @@ -8,25 +8,32 @@ module Distribution.Types.Mixin ( import Prelude () import Distribution.Compat.Prelude -import Text.PrettyPrint ((<+>)) +import Text.PrettyPrint ((<+>), colon) import Distribution.Compat.ReadP import Distribution.Text import Distribution.Package import Distribution.Types.IncludeRenaming +import Distribution.Types.UnqualComponentName data Mixin = Mixin { mixinPackageName :: PackageName + , mixinLibraryName :: Maybe UnqualComponentName , mixinIncludeRenaming :: IncludeRenaming } deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) instance Binary Mixin instance Text Mixin where - disp (Mixin pkg_name incl) = + disp (Mixin pkg_name Nothing incl) = disp pkg_name <+> disp incl + disp (Mixin pkg_name (Just lib_name) incl) = + disp pkg_name <<>> colon <<>> disp lib_name <+> disp incl parse = do pkg_name <- parse + mb_lib_name <- option Nothing $ do + _ <- char ':' + fmap Just parse skipSpaces incl <- parse - return (Mixin pkg_name incl) + return (Mixin pkg_name mb_lib_name incl) diff --git a/Cabal/doc/developing-packages.rst b/Cabal/doc/developing-packages.rst index d20119c2aa4..2df3c3c3750 100644 --- a/Cabal/doc/developing-packages.rst +++ b/Cabal/doc/developing-packages.rst @@ -1054,26 +1054,22 @@ look something like this: cabal-version: >= 1.23 build-type: Simple - library foo-internal + library internal exposed-modules: Foo.Internal build-depends: base library exposed-modules: Foo.Public - build-depends: foo-internal, base + build-depends: base, foo:internal test-suite test-foo type: exitcode-stdio-1.0 main-is: test-foo.hs - build-depends: foo-internal, base - -Internal libraries are also useful for packages that define multiple -executables, but do not define a publically accessible library. Internal -libraries are only visible internally in the package (so they can only -be added to the :pkg-field:`build-depends` of same-package libraries, -executables, test suites, etc.) Internal libraries locally shadow any -packages which have the same name (so don't name an internal library -with the same name as an external dependency.) + build-depends: base, foo:internal + +An internal library is referenced by qualifying the library name with +the name of the package it comes from. At the moment, referencing +internal libraries of external packages is not supported. Opening an interpreter session ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/cabal-testsuite/PackageTests/Backpack/Fail1/Fail1.cabal b/cabal-testsuite/PackageTests/Backpack/Fail1/Fail1.cabal index 83204e52e90..3884693faa1 100644 --- a/cabal-testsuite/PackageTests/Backpack/Fail1/Fail1.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Fail1/Fail1.cabal @@ -12,6 +12,5 @@ library sig default-language: Haskell2010 library - build-depends: sig - mixins: sig requires (MissingReq as A) + mixins: Fail1:sig requires (MissingReq as A) default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal b/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal index 0c07c997d8d..0f8d4d107f8 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Includes2/Includes2.cabal @@ -26,10 +26,12 @@ library postgresql default-language: Haskell2010 library - build-depends: base, mysql, postgresql, mylib + build-depends: base mixins: - mylib (Mine as Mine.MySQL) requires (Database as Database.MySQL), - mylib (Mine as Mine.PostgreSQL) requires (Database as Database.PostgreSQL) + Includes2:mysql, + Includes2:postgresql, + Includes2:mylib (Mine as Mine.MySQL) requires (Database as Database.MySQL), + Includes2:mylib (Mine as Mine.PostgreSQL) requires (Database as Database.PostgreSQL) exposed-modules: App hs-source-dirs: src default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal b/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal index ff6493de0a2..5d723d51e59 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Includes3/Includes3.cabal @@ -13,13 +13,15 @@ library sigs default-language: Haskell2010 library indef - build-depends: base, sigs + build-depends: base + mixins: Includes3:sigs exposed-modules: Foo hs-source-dirs: indef default-language: Haskell2010 executable exe - build-depends: base, containers, indef + build-depends: base, containers + mixins: Includes3:indef main-is: Main.hs hs-source-dirs: exe default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Includes4/Includes4.cabal b/cabal-testsuite/PackageTests/Backpack/Includes4/Includes4.cabal index ea7b01d4fe2..39255c794ba 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes4/Includes4.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Includes4/Includes4.cabal @@ -20,6 +20,8 @@ library impl default-language: Haskell2010 executable exe - build-depends: indef, impl, base + build-depends: base + mixins: Includes4:indef, + Includes4:impl main-is: Main.hs default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Includes5/Includes5.cabal b/cabal-testsuite/PackageTests/Backpack/Includes5/Includes5.cabal index a4b2530a873..c38618803f6 100644 --- a/cabal-testsuite/PackageTests/Backpack/Includes5/Includes5.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Includes5/Includes5.cabal @@ -13,13 +13,14 @@ library impl default-language: Haskell2010 library good - build-depends: base, impl - mixins: impl hiding (Foobar) + build-depends: base + mixins: Includes5:impl hiding (Foobar) exposed-modules: A default-language: Haskell2010 library bad - build-depends: base, impl, good - mixins: impl hiding (Foobar) + build-depends: base + mixins: Includes5:impl hiding (Foobar), + Includes5:good exposed-modules: B default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/Backpack/Indef2/Indef2.cabal b/cabal-testsuite/PackageTests/Backpack/Indef2/Indef2.cabal index 880230fec36..fa5ecf3e6b0 100644 --- a/cabal-testsuite/PackageTests/Backpack/Indef2/Indef2.cabal +++ b/cabal-testsuite/PackageTests/Backpack/Indef2/Indef2.cabal @@ -12,5 +12,5 @@ library asig1 default-language: Haskell2010 library - build-depends: asig1 + mixins: Indef2:asig1 default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal b/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal index 8f0e8507e28..89a61b67e1f 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal @@ -14,6 +14,6 @@ library foo-internal executable foo main-is: Main.hs - build-depends: base, foo-internal + build-depends: base, foo:foo-internal hs-source-dirs: exe default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal b/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal index 0a5d05397c4..99f0e4939e6 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal @@ -13,5 +13,5 @@ library foolib-internal library exposed-modules: Foo - build-depends: base, foolib-internal + build-depends: base, foolib:foolib-internal default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal b/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal index 30546bfb507..bce5ae8b1e0 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal @@ -13,12 +13,12 @@ library q default-language: Haskell2010 library - build-depends: base, q + build-depends: base, p:q exposed-modules: P hs-source-dirs: p default-language: Haskell2010 executable foo - build-depends: base, q + build-depends: base, p, p:q main-is: Foo.hs default-language: Haskell2010