From 662d947a5b62ac3c1d1ac7a3f5e37a63cf26fa8f Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 30 Dec 2016 18:15:46 -0500 Subject: [PATCH] Implement mixin-based internal libraries. Fixes #4155. Needs a doc update. Signed-off-by: Edward Z. Yang --- .../Distribution/Backpack/ComponentsGraph.hs | 20 +- Cabal/Distribution/Backpack/Configure.hs | 2 +- .../Backpack/ConfiguredComponent.hs | 171 ++++++++---------- Cabal/Distribution/Parsec/Class.hs | 5 +- Cabal/Distribution/Types/Mixin.hs | 13 +- .../InternalLibraries/Executable/foo.cabal | 3 +- .../Library/foolib/foolib.cabal | 3 +- .../PackageTests/InternalLibraries/p/p.cabal | 6 +- 8 files changed, 114 insertions(+), 109 deletions(-) diff --git a/Cabal/Distribution/Backpack/ComponentsGraph.hs b/Cabal/Distribution/Backpack/ComponentsGraph.hs index 3044c03272b..9a4f22bd6ec 100644 --- a/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -18,6 +18,7 @@ import Distribution.Types.UnqualComponentName import Distribution.Simple.Utils import Distribution.Compat.Graph (Node(..)) import qualified Distribution.Compat.Graph as Graph +import Distribution.Types.Mixin import Distribution.Text ( Text(disp) ) @@ -58,18 +59,19 @@ toComponentsGraph enabled pkg_descr = [ CExeName toolname | (ExeDependency _ toolname _) <- getAllInternalToolDependencies pkg_descr bi ] + ++ mixin_deps + ++ if null mixin_deps -- the implicit dependency! + then [ CLibName + | Dependency pn _ <- targetBuildDepends bi + , pn == packageName pkg_descr ] + else [] - ++ [ if pkgname == packageName pkg_descr - then CLibName - else CSubLibName toolname - | Dependency pkgname _ <- targetBuildDepends bi - , let toolname = packageNameToUnqualComponentName pkgname - , toolname `elem` internalPkgDeps ] 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 ab0781b845a..73aa3c780ba 100644 --- a/Cabal/Distribution/Backpack/Configure.hs +++ b/Cabal/Distribution/Backpack/Configure.hs @@ -82,7 +82,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 8e6e245c001..46bf5f01b30 100644 --- a/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -78,101 +78,105 @@ 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, cc_includes = explicit_includes ++ implicit_includes } where + pn = packageName pkg_descr bi = componentBuildInfo component - deps = map snd lib_deps - deps_map = Map.fromList lib_deps -- Resolve each @backpack-include@ 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: Check what breaks if you remove this edit - ci_pkgid = pid { pkgName = name }, + ci_pkgid = pid, ci_renaming = rns } - | 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 (\(cid, pid) -> ComponentInclude { - ci_id = cid, - ci_pkgid = pid, - ci_renaming = defaultIncludeRenaming - }) - $ filter (flip Set.notMember used_explicitly . fst) 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 (packageName . ci_pkgid) explicit_includes) lib_deps | newPackageDepsBehaviour pkg_descr - = [ (name, find_it name) - | Dependency name _ <- targetBuildDepends bi ] + = [ case Map.lookup (name, CLibName) deps_map of + Nothing -> + error ("toConfiguredComponent: " ++ display (packageName pkg_descr) ++ + " " ++ display name) + Just r -> r + | Dependency name _ <- targetBuildDepends bi + , Set.notMember name 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 + | ((dep_pn,dep_cn), r) <- Map.toList deps_map + , dep_pn /= pn + , dep_cn == CLibName + , Set.notMember dep_pn used_explicitly ] + implicit_includes + = map (\(cid, pid) -> + ComponentInclude { + ci_id = cid, + ci_pkgid = pid, + ci_renaming = defaultIncludeRenaming + }) lib_deps + exe_deps = [ cid | (ExeDependency _ 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 (pn, 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. @@ -182,45 +186,30 @@ toConfiguredComponent' -> PackageDescription -> 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 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 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 @@ -232,18 +221,18 @@ toConfiguredComponents -> Flag String -- configIPID -> Flag ComponentId -- configCID -> PackageDescription - -> Map PackageName (ComponentId, PackageId) + -> ConfiguredComponentMap -> [Component] -> [ConfiguredComponent] toConfiguredComponents use_external_internal_deps flags 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 ipid_flag cid_flag - external_lib_map m component + m component newPackageDepsBehaviourMinVersion :: Version diff --git a/Cabal/Distribution/Parsec/Class.hs b/Cabal/Distribution/Parsec/Class.hs index c665c82226d..07675e8c6ed 100644 --- a/Cabal/Distribution/Parsec/Class.hs +++ b/Cabal/Distribution/Parsec/Class.hs @@ -375,9 +375,12 @@ 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) ------------------------------------------------------------------------------- -- Utilities 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-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal b/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal index c7a1a03a6f9..e65a83d7304 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/Executable/foo.cabal @@ -14,5 +14,6 @@ library foo-internal executable foo main-is: Main.hs - build-depends: base, foo-internal + build-depends: base + mixins: foo:foo-internal hs-source-dirs: exe diff --git a/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal b/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal index 0a5d05397c4..a2179139a20 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/Library/foolib/foolib.cabal @@ -13,5 +13,6 @@ library foolib-internal library exposed-modules: Foo - build-depends: base, foolib-internal + build-depends: base + mixins: 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 849c5be693b..4d01a1c8c6a 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal +++ b/cabal-testsuite/PackageTests/InternalLibraries/p/p.cabal @@ -13,11 +13,13 @@ library q default-language: Haskell2010 library - build-depends: base, q + build-depends: base + mixins: p:q exposed-modules: P hs-source-dirs: p default-language: Haskell2010 executable foo - build-depends: base, q + build-depends: base, p + mixins: p:q main-is: Foo.hs