From 063dab7b907388af901bad6125dfe5ae7965d0d0 Mon Sep 17 00:00:00 2001 From: John Ericson Date: Mon, 13 Mar 2017 16:45:14 -0400 Subject: [PATCH 1/4] Inline `mkConfiguredComponent` --- .../Backpack/ConfiguredComponent.hs | 66 +++++++------------ 1 file changed, 24 insertions(+), 42 deletions(-) diff --git a/Cabal/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/Distribution/Backpack/ConfiguredComponent.hs index da83176e1ec..7bd543f07b0 100644 --- a/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -96,22 +96,36 @@ 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 +type ConfiguredComponentMap = + Map PackageName (Map ComponentName (AnnotatedId ComponentId)) + +toConfiguredComponent :: PackageDescription -> ComponentId - -> [AnnotatedId ComponentId] -- lib deps - -> [AnnotatedId ComponentId] -- exe deps + -> ConfiguredComponentMap -> Component -> LogProgress ConfiguredComponent -mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do +toConfiguredComponent pkg_descr this_cid dep_map component = do + lib_deps <- + if newPackageDepsBehaviour pkg_descr + then forM (targetBuildDepends bi) $ \(Dependency name _) -> do + let (pn, cn) = fixFakePkgName pkg_descr name + value <- case Map.lookup cn =<< Map.lookup pn dep_map of + Nothing -> + dieProgress $ + text "Dependency on unbuildable" <+> + text (showComponentName cn) <+> + text "from" <+> disp pn + Just v -> return v + return value + else return old_style_lib_deps + -- Resolve each @mixins@ into the actual dependency -- from @lib_deps@. explicit_includes <- forM (mixins bi) $ \(Mixin name rns) -> do - let keys = fixFakePkgName pkg_descr name - aid <- case Map.lookup keys deps_map of + let (pkg, cname) = fixFakePkgName pkg_descr name + aid <- + case Map.lookup cname =<< Map.lookup pkg dep_map of Nothing -> dieProgress $ text "Mix-in refers to non-existent package" <+> @@ -142,42 +156,10 @@ mkConfiguredComponent pkg_descr this_cid lib_deps exe_deps component = do ann_cname = componentName component }, cc_component = component, - cc_public = is_public, + cc_public = componentName component == CLibName, cc_exe_deps = exe_deps, cc_includes = explicit_includes ++ implicit_includes } - where - bi = componentBuildInfo component - deps_map = Map.fromList [ ((packageName dep, ann_cname dep), dep) - | dep <- lib_deps ] - is_public = componentName component == CLibName - -type ConfiguredComponentMap = - Map PackageName (Map ComponentName (AnnotatedId ComponentId)) - -toConfiguredComponent - :: PackageDescription - -> ComponentId - -> ConfiguredComponentMap - -> Component - -> LogProgress ConfiguredComponent -toConfiguredComponent pkg_descr this_cid dep_map component = do - lib_deps <- - if newPackageDepsBehaviour pkg_descr - then forM (targetBuildDepends bi) $ \(Dependency name _) -> do - let (pn, cn) = fixFakePkgName pkg_descr name - value <- case Map.lookup cn =<< Map.lookup pn dep_map of - Nothing -> - dieProgress $ - text "Dependency on unbuildable" <+> - text (showComponentName cn) <+> - text "from" <+> disp pn - Just v -> return v - return value - else return old_style_lib_deps - mkConfiguredComponent - pkg_descr this_cid - lib_deps exe_deps component where bi = componentBuildInfo component -- dep_map contains a mix of internal and external deps. From 554468fec18c4c329b7fd37ae4f4407d8b6504d7 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 30 Dec 2016 18:15:46 -0500 Subject: [PATCH 2/4] 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. Already in 'Cabal', this type will be used instead of 'Dependency' in most cases, implemented in the following commits of this PR. Used in: - Condition Trees - Querying the PackageIndex ----- Not sure about which type should have the (not)ThisPackageVersion function Also need to update some comments. Everything builds, however. --- Cabal/Cabal.cabal | 2 + .../Distribution/Backpack/ComponentsGraph.hs | 21 +- .../Backpack/ConfiguredComponent.hs | 118 +++--- .../Distribution/PackageDescription/Check.hs | 50 ++- .../PackageDescription/Configuration.hs | 98 +++-- .../Distribution/PackageDescription/Parsec.hs | 16 +- .../PackageDescription/PrettyPrint.hs | 20 +- Cabal/Distribution/Simple/Build.hs | 10 +- Cabal/Distribution/Simple/Configure.hs | 201 ++++------ Cabal/Distribution/Simple/PackageIndex.hs | 23 +- Cabal/Distribution/Simple/Setup.hs | 18 +- Cabal/Distribution/Types/BuildInfo.hs | 27 +- Cabal/Distribution/Types/BuildInfo/Lens.hs | 4 +- Cabal/Distribution/Types/DependencyMap.hs | 26 +- Cabal/Distribution/Types/ExeDependency.hs | 11 +- .../Types/GenericPackageDescription.hs | 14 +- .../Types/GenericPackageDescription/Lens.hs | 18 +- Cabal/Distribution/Types/LibDependency.hs | 75 ++++ Cabal/Distribution/Types/LibDependencyMap.hs | 99 +++++ Cabal/Distribution/Types/Mixin.hs | 23 +- .../Distribution/Types/PackageDescription.hs | 6 +- Cabal/Distribution/Types/SetupBuildInfo.hs | 2 + Cabal/doc/developing-packages.rst | 25 +- Cabal/tests/Instances/TreeDiff.hs | 2 + Cabal/tests/ParserHackageTests.hs | 365 ++++++++++++++++++ .../Distribution/Client/Configure.hs | 8 +- .../Distribution/Client/GenBounds.hs | 15 +- cabal-install/Distribution/Client/Install.hs | 9 +- cabal-install/Distribution/Client/List.hs | 11 +- cabal-install/Distribution/Client/Outdated.hs | 4 +- .../Distribution/Client/PackageUtils.hs | 27 +- .../Distribution/Client/ProjectPlanning.hs | 10 +- .../Distribution/Client/SetupWrapper.hs | 4 +- .../Solver/Modular/IndexConversion.hs | 61 ++- .../Distribution/Solver/Modular/DSL.hs | 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 +- .../BuildDeps/DepCycle/DepCycle.cabal | 4 +- .../PackageTests/CaretOperator/setup.test.hs | 4 +- .../ConfigureComponent/SubLib/Lib.cabal | 2 +- .../SubLib/setup-explicit.test.hs | 2 +- .../InternalLibraries/Executable/foo.cabal | 2 +- .../Library/foolib/foolib.cabal | 2 +- .../PackageTests/InternalLibraries/p/p.cabal | 4 +- 48 files changed, 1012 insertions(+), 481 deletions(-) create mode 100644 Cabal/Distribution/Types/LibDependency.hs create mode 100644 Cabal/Distribution/Types/LibDependencyMap.hs create mode 100644 Cabal/tests/ParserHackageTests.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index b5975bda513..733613cb252 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -307,8 +307,10 @@ library Distribution.Types.Dependency Distribution.Types.ExeDependency Distribution.Types.LegacyExeDependency + Distribution.Types.LibDependency Distribution.Types.PkgconfigDependency Distribution.Types.DependencyMap + Distribution.Types.LibDependencyMap Distribution.Types.ComponentId Distribution.Types.MungedPackageId Distribution.Types.PackageId diff --git a/Cabal/Distribution/Backpack/ComponentsGraph.hs b/Cabal/Distribution/Backpack/ComponentsGraph.hs index 9b03638355c..69d048dc606 100644 --- a/Cabal/Distribution/Backpack/ComponentsGraph.hs +++ b/Cabal/Distribution/Backpack/ComponentsGraph.hs @@ -16,9 +16,10 @@ import Distribution.PackageDescription as PD hiding (Flag) import Distribution.Simple.BuildToolDepends import Distribution.Simple.LocalBuildInfo import Distribution.Types.ComponentRequestedSpec -import Distribution.Types.UnqualComponentName +import Distribution.Types.LibDependency import Distribution.Compat.Graph (Graph, Node(..)) import qualified Distribution.Compat.Graph as Graph +import Distribution.Types.Mixin import Distribution.Text ( Text(disp) ) @@ -64,18 +65,16 @@ mkComponentsGraph 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 + ++ [ maybe CLibName CSubLibName (libDepLibraryName ld) + | ld <- targetBuildDepends bi + , libDepPackageName ld == packageName pkg_descr ] 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 ] -- | Given the package description and a 'PackageDescription' (used -- to determine if a package name is internal or not), sort the diff --git a/Cabal/Distribution/Backpack/ConfiguredComponent.hs b/Cabal/Distribution/Backpack/ConfiguredComponent.hs index 7bd543f07b0..0074b1d8c5a 100644 --- a/Cabal/Distribution/Backpack/ConfiguredComponent.hs +++ b/Cabal/Distribution/Backpack/ConfiguredComponent.hs @@ -22,7 +22,7 @@ import Distribution.Compat.Prelude hiding ((<>)) import Distribution.Backpack.Id import Distribution.Types.AnnotatedId -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.Types.ExeDependency import Distribution.Types.IncludeRenaming import Distribution.Types.ComponentId @@ -30,7 +30,6 @@ import Distribution.Types.PackageId import Distribution.Types.PackageName import Distribution.Types.Mixin import Distribution.Types.ComponentName -import Distribution.Types.UnqualComponentName import Distribution.Types.ComponentInclude import Distribution.Package import Distribution.PackageDescription as PD hiding (Flag) @@ -43,7 +42,6 @@ import Distribution.Utils.MapAccum import Distribution.Utils.Generic import Control.Monad -import qualified Data.Set as Set import qualified Data.Map as Map import Distribution.Text import Text.PrettyPrint @@ -96,9 +94,20 @@ dispConfiguredComponent cc = | incl <- cc_includes cc ]) +-- | 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 (Map ComponentName (AnnotatedId ComponentId)) +-- 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 @@ -106,49 +115,51 @@ toConfiguredComponent -> Component -> LogProgress ConfiguredComponent toConfiguredComponent pkg_descr this_cid dep_map component = do - lib_deps <- - if newPackageDepsBehaviour pkg_descr - then forM (targetBuildDepends bi) $ \(Dependency name _) -> do - let (pn, cn) = fixFakePkgName pkg_descr name - value <- case Map.lookup cn =<< Map.lookup pn dep_map of - Nothing -> - dieProgress $ - text "Dependency on unbuildable" <+> - text (showComponentName cn) <+> - text "from" <+> disp pn - Just v -> return v - return value - else return old_style_lib_deps + let reg_lib_deps = + if newPackageDepsBehaviour pkg_descr + then + [ (pn, cn) + | LibDependency pn mb_ln _ <- targetBuildDepends bi + , let cn = libraryComponentName mb_ln ] + else + -- dep_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. + [ (pn, cn) + | (pn, comp_map) <- Map.toList dep_map + , pn /= packageName pkg_descr + , (cn, _) <- Map.toList comp_map + , cn == CLibName ] + + reg_lib_map, mixin_map :: Map (PackageName, ComponentName) (IncludeRenaming, Bool) + + reg_lib_map = Map.fromList $ + reg_lib_deps `zip` repeat (defaultIncludeRenaming, True) + + mixin_map = Map.fromList + [ ((pn, cn), (rns, False)) + | Mixin pn mb_ln rns <- mixins bi + , let cn = libraryComponentName mb_ln ] - -- Resolve each @mixins@ into the actual dependency - -- from @lib_deps@. - explicit_includes <- forM (mixins bi) $ \(Mixin name rns) -> do - let (pkg, cname) = fixFakePkgName pkg_descr name - aid <- - case Map.lookup cname =<< Map.lookup pkg dep_map of - Nothing -> - dieProgress $ - text "Mix-in refers to non-existent package" <+> - quotes (disp name) $$ - text "(did you forget to add the package to build-depends?)" - Just r -> return r + lib_deps = Map.toList $ reg_lib_map `Map.union` mixin_map + + mixin_includes <- forM lib_deps $ \((pname, cname), (rns, implicit)) -> do + aid <- case Map.lookup cname =<< Map.lookup pname dep_map of + Nothing -> dieProgress $ + text "Dependency on unbuildable" <+> + text (showComponentName cname) <+> + text "from" <+> disp pname + Just r -> return r return ComponentInclude { ci_ann_id = aid, ci_renaming = rns, - ci_implicit = False + ci_implicit = implicit } - -- Any @build-depends@ which is not explicitly mentioned in - -- @backpack-include@ is converted into an "implicit" include. - let used_explicitly = Set.fromList (map ci_id explicit_includes) - implicit_includes - = map (\aid -> ComponentInclude { - ci_ann_id = aid, - ci_renaming = defaultIncludeRenaming, - ci_implicit = True - }) - $ filter (flip Set.notMember used_explicitly . ann_id) lib_deps - return ConfiguredComponent { cc_ann_id = AnnotatedId { ann_id = this_cid, @@ -158,22 +169,10 @@ toConfiguredComponent pkg_descr this_cid dep_map component = do cc_component = component, cc_public = componentName component == CLibName, cc_exe_deps = exe_deps, - cc_includes = explicit_includes ++ implicit_includes + cc_includes = mixin_includes } where bi = componentBuildInfo component - -- dep_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. - old_style_lib_deps = [ e - | (pn, comp_map) <- Map.toList dep_map - , pn /= packageName pkg_descr - , (cn, e) <- Map.toList comp_map - , cn == CLibName ] -- We have to nub here, because 'getAllToolDependencies' may return -- duplicates (see #4986). (NB: This is not needed for lib_deps, -- since those elaborate into includes, for which there explicitly @@ -264,16 +263,3 @@ newPackageDepsBehaviourMinVersion = mkVersion [1,7,1] newPackageDepsBehaviour :: PackageDescription -> Bool newPackageDepsBehaviour pkg = specVersion pkg >= newPackageDepsBehaviourMinVersion - --- | 'build-depends:' stanzas are currently ambiguous as the external packages --- and internal libraries are specified the same. For now, we assume internal --- libraries shadow, and this function disambiguates accordingly, but soon the --- underlying ambiguity will be addressed. -fixFakePkgName :: PackageDescription -> PackageName -> (PackageName, ComponentName) -fixFakePkgName pkg_descr pn = - if subLibName `elem` internalLibraries - then (packageName pkg_descr, CSubLibName subLibName) - else (pn, CLibName) - where - subLibName = packageNameToUnqualComponentName pn - internalLibraries = mapMaybe libName (allLibraries pkg_descr) diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 90f6931adf2..d5c1cd04ab3 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -53,6 +53,7 @@ import Distribution.System import Distribution.Text import Distribution.Types.ComponentRequestedSpec import Distribution.Types.CondTree +import Distribution.Types.LibDependency import Distribution.Types.ExeDependency import Distribution.Types.UnqualComponentName import Distribution.Utils.Generic (isAscii) @@ -544,6 +545,11 @@ checkFields pkg = ++ ". This version range does not include the current package, and must " ++ "be removed as the current package's library will always be used." + , check (not (null depMissingInternalLibrary)) $ + PackageBuildImpossible $ + "The package depends on a missing internal library: " + ++ commaSep (map display depInternalExecutableWithImpossibleVersion) + , check (not (null depInternalExecutableWithExtraVersion)) $ PackageBuildWarning $ "The package has an extraneous version range for a dependency on an " @@ -586,17 +592,14 @@ checkFields pkg = | (compiler, vr) <- testedWith pkg , isNoVersion vr ] - internalLibraries = - map (maybe (packageName pkg) (unqualComponentNameToPackageName) . libName) - (allLibraries pkg) + internalLibraries = mapMaybe libName $ allLibraries pkg internalExecutables = map exeName $ executables pkg internalLibDeps = [ dep - | bi <- allBuildInfo pkg - , dep@(Dependency name _) <- targetBuildDepends bi - , name `elem` internalLibraries + | dep@(LibDependency name _ _) <- allBuildDepends pkg + , name == packageName pkg ] internalExeDeps = @@ -608,17 +611,23 @@ checkFields pkg = depInternalLibraryWithExtraVersion = [ dep - | dep@(Dependency _ versionRange) <- internalLibDeps + | dep@(LibDependency _ _ versionRange) <- internalLibDeps , not $ isAnyVersion versionRange , packageVersion pkg `withinRange` versionRange ] depInternalLibraryWithImpossibleVersion = [ dep - | dep@(Dependency _ versionRange) <- internalLibDeps + | dep@(LibDependency _ _ versionRange) <- internalLibDeps , not $ packageVersion pkg `withinRange` versionRange ] + depMissingInternalLibrary = + [ dep + | dep@(LibDependency _ (Just lName) _) <- internalLibDeps + , not $ lName `elem` internalLibraries + ] + depInternalExecutableWithExtraVersion = [ dep | dep@(ExeDependency _ _ versionRange) <- internalExeDeps @@ -1201,7 +1210,7 @@ checkCabalVersion pkg = PackageDistInexcusable $ "The package uses full version-range expressions " ++ "in a 'build-depends' field: " - ++ commaSep (map displayRawDependency versionRangeExpressions) + ++ commaSep (map displayRawLibDependency versionRangeExpressions) ++ ". To use this new syntax the package needs to specify at least " ++ "'cabal-version: >= 1.8'. Alternatively, if broader compatibility " ++ "is important, then convert to conjunctive normal form, and use " @@ -1216,7 +1225,7 @@ checkCabalVersion pkg = ++ "'cabal-version: >= 1.6'. Alternatively, if broader compatibility " ++ "is important then use: " ++ commaSep [ display (Dependency name (eliminateWildcardSyntax versionRange)) - | Dependency name versionRange <- depsUsingWildcardSyntax ] + | LibDependency name Nothing versionRange <- depsUsingWildcardSyntax ] -- check use of "build-depends: foo ^>= 1.2.3" syntax , checkVersion [2,0] (not (null depsUsingMajorBoundSyntax)) $ @@ -1227,8 +1236,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 (LibDependency name lname (eliminateMajorBoundSyntax versionRange)) + | LibDependency name lname versionRange <- depsUsingMajorBoundSyntax ] , checkVersion [2,1] (any (not . null) (concatMap buildInfoField @@ -1363,7 +1372,7 @@ checkCabalVersion pkg = _ -> False versionRangeExpressions = - [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg + [ dep | dep@(LibDependency _ _ vr) <- allBuildDepends pkg , usesNewVersionRangeSyntax vr ] testedWithVersionRangeExpressions = @@ -1391,10 +1400,11 @@ checkCabalVersion pkg = alg (VersionRangeParensF _) = 3 alg _ = 1 :: Int - depsUsingWildcardSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg - , usesWildcardSyntax vr ] + depsUsingWildcardSyntax = [ dep + | dep@(LibDependency _ _ vr) <- allBuildDepends pkg + , usesWildcardSyntax vr ] - depsUsingMajorBoundSyntax = [ dep | dep@(Dependency _ vr) <- allBuildDepends pkg + depsUsingMajorBoundSyntax = [ dep | dep@(LibDependency _ _ vr) <- allBuildDepends pkg , usesMajorBoundSyntax vr ] usesBackpackIncludes = any (not . null . mixins) (allBuildInfo pkg) @@ -1492,6 +1502,12 @@ displayRawDependency :: Dependency -> String displayRawDependency (Dependency pkg vr) = display pkg ++ " " ++ display vr +displayRawLibDependency :: LibDependency -> String +displayRawLibDependency (LibDependency pkg ml vr) = + display pkg + ++ ":lib:" ++ maybe (display pkg) display ml + ++ " " ++ display vr + -- ------------------------------------------------------------ -- * Checks on the GenericPackageDescription @@ -1541,7 +1557,7 @@ checkPackageVersions pkg = foldr intersectVersionRanges anyVersion baseDeps where baseDeps = - [ vr | Dependency pname vr <- allBuildDepends pkg' + [ vr | LibDependency pname _ vr <- allBuildDepends pkg' , pname == mkPackageName "base" ] -- Just in case finalizePD fails for any reason, diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 43f6fef7dcc..fc4874053f6 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -57,11 +57,13 @@ import Distribution.Types.ComponentRequestedSpec import Distribution.Types.ForeignLib import Distribution.Types.Component import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName import Distribution.Types.CondTree import Distribution.Types.Condition import Distribution.Types.DependencyMap +import Distribution.Types.LibDependencyMap import qualified Data.Map as Map import Data.Tree ( Tree(Node) ) @@ -175,20 +177,20 @@ resolveWithFlags :: -> Arch -- ^ Arch as returned by Distribution.System.buildArch -> CompilerInfo -- ^ Compiler information -> [Dependency] -- ^ Additional constraints - -> [CondTree ConfVar [Dependency] PDTagged] - -> ([Dependency] -> DepTestRslt [Dependency]) -- ^ Dependency test function. - -> Either [Dependency] (TargetSet PDTagged, FlagAssignment) + -> [CondTree ConfVar [LibDependency] PDTagged] + -> ([LibDependency] -> DepTestRslt [LibDependency]) -- ^ Dependency test function. + -> Either [LibDependency] (TargetSet PDTagged, FlagAssignment) -- ^ Either the missing dependencies (error case), or a pair of -- (set of build targets with dependencies, chosen flag assignments) resolveWithFlags dom enabled os arch impl constrs trees checkDeps = - either (Left . fromDepMapUnion) Right $ explore (build mempty dom) + either (Left . fromLibDepMapUnion) Right $ explore (build mempty dom) where extraConstrs = toDepMap constrs -- simplify trees by (partially) evaluating all conditions and converting -- dependencies to dependency maps. - simplifiedTrees :: [CondTree FlagName DependencyMap PDTagged] - simplifiedTrees = map ( mapTreeConstrs toDepMap -- convert to maps + simplifiedTrees :: [CondTree FlagName LibDependencyMap PDTagged] + simplifiedTrees = map ( mapTreeConstrs toLibDepMap -- convert to maps . addBuildableConditionPDTagged . mapTreeConds (fst . simplifyWithSysParams os arch impl)) trees @@ -199,17 +201,17 @@ resolveWithFlags dom enabled os arch impl constrs trees checkDeps = -- it to backtrack. Since the tree is constructed lazily, we avoid some -- computation overhead in the successful case. explore :: Tree FlagAssignment - -> Either DepMapUnion (TargetSet PDTagged, FlagAssignment) + -> Either LibDepMapUnion (TargetSet PDTagged, FlagAssignment) explore (Node flags ts) = let targetSet = TargetSet $ flip map simplifiedTrees $ -- apply additional constraints to all dependencies first (`constrainBy` extraConstrs) . simplifyCondTree (env flags) deps = overallDependencies enabled targetSet - in case checkDeps (fromDepMap deps) of + in case checkDeps $ fromLibDepMap deps of DepOk | null ts -> Right (targetSet, flags) | otherwise -> tryAll $ map explore ts - MissingDeps mds -> Left (toDepMapUnion mds) + MissingDeps mds -> Left (toLibDepMapUnion mds) -- Builds a tree of all possible flag assignments. Internal nodes -- have only partial assignments. @@ -218,22 +220,21 @@ resolveWithFlags dom enabled os arch impl constrs trees checkDeps = build assigned ((fn, vals) : unassigned) = Node assigned $ map (\v -> build (insertFlagAssignment fn v assigned) unassigned) vals - tryAll :: [Either DepMapUnion a] -> Either DepMapUnion a + tryAll :: [Either LibDepMapUnion a] -> Either LibDepMapUnion a tryAll = foldr mp mz -- special version of `mplus' for our local purposes - mp :: Either DepMapUnion a -> Either DepMapUnion a -> Either DepMapUnion a + mp :: Either LibDepMapUnion a -> Either LibDepMapUnion a -> Either LibDepMapUnion a mp m@(Right _) _ = m mp _ m@(Right _) = m mp (Left xs) (Left ys) = - let union = Map.foldrWithKey (Map.insertWith' combine) - (unDepMapUnion xs) (unDepMapUnion ys) - combine x y = simplifyVersionRange $ unionVersionRanges x y - in union `seq` Left (DepMapUnion union) + let union = Map.unionWith unionCompVerRange + (unLibDepMapUnion xs) (unLibDepMapUnion ys) + in union `seq` Left (LibDepMapUnion union) -- `mzero' - mz :: Either DepMapUnion a - mz = Left (DepMapUnion Map.empty) + mz :: Either LibDepMapUnion a + mz = Left (LibDepMapUnion Map.empty) env :: FlagAssignment -> FlagName -> Either FlagName Bool env flags flag = (maybe (Left flag) Right . lookupFlagAssignment flag) flags @@ -305,15 +306,29 @@ extractConditions f gpkg = ] --- | A map of dependencies that combines version ranges using 'unionVersionRanges'. -newtype DepMapUnion = DepMapUnion { unDepMapUnion :: Map PackageName VersionRange } +-- | A map of library dependencies that combines components version ranges. +-- Note that we have a Map instead of pair of sets. This is because firstly, the +-- 2D union isn't convex like the the 2D intersection, and secondly because +-- components are disjoint. +newtype LibDepMapUnion = LibDepMapUnion { + unLibDepMapUnion :: Map PackageName + (Map (Maybe UnqualComponentName) VersionRange) + } -toDepMapUnion :: [Dependency] -> DepMapUnion -toDepMapUnion ds = - DepMapUnion $ Map.fromListWith unionVersionRanges [ (p,vr) | Dependency p vr <- ds ] +unionCompVerRange :: Map (Maybe UnqualComponentName) VersionRange + -> Map (Maybe UnqualComponentName) VersionRange + -> Map (Maybe UnqualComponentName) VersionRange +unionCompVerRange = Map.unionWith $ \x y -> + simplifyVersionRange $ unionVersionRanges x y -fromDepMapUnion :: DepMapUnion -> [Dependency] -fromDepMapUnion m = [ Dependency p vr | (p,vr) <- Map.toList (unDepMapUnion m) ] +toLibDepMapUnion :: [LibDependency] -> LibDepMapUnion +toLibDepMapUnion ds = LibDepMapUnion $ Map.fromListWith unionCompVerRange + [ (p, Map.singleton c vr) | LibDependency p c vr <- ds ] + +fromLibDepMapUnion :: LibDepMapUnion -> [LibDependency] +fromLibDepMapUnion m = [ LibDependency p c vr + | (p, pairs) <- Map.toList (unLibDepMapUnion m) + , (c, vr) <- Map.toList pairs ] freeVars :: CondTree ConfVar c a -> [FlagName] freeVars t = [ f | Flag f <- freeVars' t ] @@ -331,11 +346,11 @@ freeVars t = [ f | Flag f <- freeVars' t ] ------------------------------------------------------------------------------ -- | A set of targets with their package dependencies -newtype TargetSet a = TargetSet [(DependencyMap, a)] +newtype TargetSet a = TargetSet [(LibDependencyMap, a)] -- | Combine the target-specific dependencies in a TargetSet to give the -- dependencies for the package as a whole. -overallDependencies :: ComponentRequestedSpec -> TargetSet PDTagged -> DependencyMap +overallDependencies :: ComponentRequestedSpec -> TargetSet PDTagged -> LibDependencyMap overallDependencies enabled (TargetSet targets) = mconcat depss where (depss, _) = unzip $ filter (removeDisabledSections . snd) targets @@ -359,7 +374,7 @@ overallDependencies enabled (TargetSet targets) = mconcat depss -- dependencies as we go. flattenTaggedTargets :: TargetSet PDTagged -> (Maybe Library, [(UnqualComponentName, Component)]) flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets where - untag (depMap, pdTagged) accum = case (pdTagged, accum) of + untag (libDepMap, pdTagged) accum = case (pdTagged, accum) of (Lib _, (Just _, _)) -> userBug "Only one library expected" (Lib l, (Nothing, comps)) -> (Just $ redoBD l, comps) (SubComp n c, (mb_lib, comps)) @@ -369,7 +384,7 @@ flattenTaggedTargets (TargetSet targets) = foldr untag (Nothing, []) targets whe (PDNull, x) -> x -- actually this should not happen, but let's be liberal where redoBD :: L.HasBuildInfo a => a -> a - redoBD = set L.targetBuildDepends $ fromDepMap depMap + redoBD = set L.targetBuildDepends $ fromLibDepMap libDepMap ------------------------------------------------------------------------------ -- Convert GenericPackageDescription to PackageDescription @@ -420,14 +435,14 @@ instance Semigroup PDTagged where finalizePD :: FlagAssignment -- ^ Explicitly specified flag assignments -> ComponentRequestedSpec - -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of - -- available packages? If this is unknown then use - -- True. + -> (LibDependency -> Bool) -- ^ Is a given dependency satisfiable from the set + -- of available packages? If this is unknown then + -- use True. -> Platform -- ^ The 'Arch' and 'OS' -> CompilerInfo -- ^ Compiler information -> [Dependency] -- ^ Additional constraints -> GenericPackageDescription - -> Either [Dependency] + -> Either [LibDependency] (PackageDescription, FlagAssignment) -- ^ Either missing dependencies or the resolved package -- description along with the flag assignments chosen. @@ -480,14 +495,14 @@ finalizePD userflags enabled satisfyDep {-# DEPRECATED finalizePackageDescription "This function now always assumes tests and benchmarks are disabled; use finalizePD with ComponentRequestedSpec to specify something more specific. This symbol will be removed in Cabal-3.0 (est. Oct 2018)." #-} finalizePackageDescription :: FlagAssignment -- ^ Explicitly specified flag assignments - -> (Dependency -> Bool) -- ^ Is a given dependency satisfiable from the set of - -- available packages? If this is unknown then use - -- True. + -> (LibDependency -> Bool) -- ^ Is a given dependency satisfiable from the set + -- of available packages? If this is unknown then + -- use True. -> Platform -- ^ The 'Arch' and 'OS' -> CompilerInfo -- ^ Compiler information -> [Dependency] -- ^ Additional constraints -> GenericPackageDescription - -> Either [Dependency] + -> Either [LibDependency] (PackageDescription, FlagAssignment) finalizePackageDescription flags = finalizePD flags defaultComponentRequestedSpec @@ -592,7 +607,14 @@ transformAllBuildDepends :: (Dependency -> Dependency) -> GenericPackageDescription -> GenericPackageDescription transformAllBuildDepends f = - over (L.traverseBuildInfos . L.targetBuildDepends . traverse) f + over (L.traverseBuildInfos . L.targetBuildDepends . traverse) f' . over (L.packageDescription . L.setupBuildInfo . traverse . L.setupDepends . traverse) f -- cannot be point-free as normal because of higher rank - . over (\f' -> L.allCondTrees $ traverseCondTreeC f') (map f) + . over (\f'' -> L.allCondTrees $ traverseCondTreeC f'') (map f') + where + -- Transform the name and bound for a library dependency. Since + -- solving (for now) works on entire packages, there is no reason + -- to break compatability and allow the the library name to be + -- transformed too. + f' (LibDependency pn mln vb) = LibDependency pn' mln vb' + where Dependency pn' vb' = f $ Dependency pn vb diff --git a/Cabal/Distribution/PackageDescription/Parsec.hs b/Cabal/Distribution/PackageDescription/Parsec.hs index f94a09c5e7e..1d4b9c974f4 100644 --- a/Cabal/Distribution/PackageDescription/Parsec.hs +++ b/Cabal/Distribution/PackageDescription/Parsec.hs @@ -59,7 +59,7 @@ import Distribution.Pretty (prettyShow) import Distribution.Simple.Utils (die', fromUTF8BS, warn) import Distribution.Text (display) import Distribution.Types.CondTree -import Distribution.Types.Dependency (Dependency) +import Distribution.Types.LibDependency (LibDependency) import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibType (knownForeignLibTypes) import Distribution.Types.GenericPackageDescription (emptyGenericPackageDescription) @@ -270,7 +270,7 @@ goSections specVer = traverse_ process => ParsecFieldGrammar' a -- ^ grammar -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] - -> ParseResult (CondTree ConfVar [Dependency] a) + -> ParseResult (CondTree ConfVar [LibDependency] a) parseCondTree' = parseCondTreeWithCommonStanzas specVer parseSection :: Name Position -> [SectionArg Position] -> [Field Position] -> SectionParser () @@ -556,7 +556,7 @@ with new AST, this all need to be rewritten. -- -- * Common stanzas are parsed exactly once, even if not-used. Thus we report errors in them. -- -type CondTreeBuildInfo = CondTree ConfVar [Dependency] BuildInfo +type CondTreeBuildInfo = CondTree ConfVar [LibDependency] BuildInfo -- | Create @a@ from 'BuildInfo'. -- @@ -581,7 +581,7 @@ parseCondTreeWithCommonStanzas -> ParsecFieldGrammar' a -- ^ grammar -> Map String CondTreeBuildInfo -- ^ common stanzas -> [Field Position] - -> ParseResult (CondTree ConfVar [Dependency] a) + -> ParseResult (CondTree ConfVar [LibDependency] a) parseCondTreeWithCommonStanzas v grammar commonStanzas = goImports [] where hasElif = specHasElif v @@ -612,16 +612,16 @@ parseCondTreeWithCommonStanzas v grammar commonStanzas = goImports [] goImports acc fields = go acc fields -- parse actual CondTree - go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [Dependency] a) + go :: [CondTreeBuildInfo] -> [Field Position] -> ParseResult (CondTree ConfVar [LibDependency] a) go bis fields = do x <- parseCondTree v hasElif grammar (view L.targetBuildDepends) fields pure $ foldr mergeCommonStanza x bis mergeCommonStanza :: forall a. FromBuildInfo a - => CondTree ConfVar [Dependency] BuildInfo - -> CondTree ConfVar [Dependency] a - -> CondTree ConfVar [Dependency] a + => CondTree ConfVar [LibDependency] BuildInfo + -> CondTree ConfVar [LibDependency] a + -> CondTree ConfVar [LibDependency] a mergeCommonStanza (CondNode bi _ bis) (CondNode x _ cs) = CondNode x' (x' ^. L.targetBuildDepends) cs' where diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index ed828197ccd..6a1dcd8532c 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -29,8 +29,8 @@ module Distribution.PackageDescription.PrettyPrint ( import Prelude () import Distribution.Compat.Prelude -import Distribution.Types.Dependency -import Distribution.Types.ForeignLib (ForeignLib (foreignLibName)) +import Distribution.Types.LibDependency +import Distribution.Types.ForeignLib import Distribution.Types.UnqualComponentName import Distribution.Types.CondTree @@ -106,7 +106,7 @@ ppFlag flag@(MkFlag name _ _ _) = emptyLine $ text "flag" <+> ppFlagName name $+$ nest indentWith (prettyFieldGrammar (flagFieldGrammar name) flag) -ppCondTree2 :: PrettyFieldGrammar' s -> CondTree ConfVar [Dependency] s -> Doc +ppCondTree2 :: PrettyFieldGrammar' s -> CondTree ConfVar [LibDependency] s -> Doc ppCondTree2 grammar = go where -- TODO: recognise elif opportunities @@ -132,41 +132,41 @@ ppCondTree2 grammar = go thenDoc = go thenTree elseDoc = go elseTree -ppCondLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> Doc +ppCondLibrary :: Maybe (CondTree ConfVar [LibDependency] Library) -> Doc ppCondLibrary Nothing = mempty ppCondLibrary (Just condTree) = emptyLine $ text "library" $+$ nest indentWith (ppCondTree2 (libraryFieldGrammar Nothing) condTree) -ppCondSubLibraries :: [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] -> Doc +ppCondSubLibraries :: [(UnqualComponentName, CondTree ConfVar [LibDependency] Library)] -> Doc ppCondSubLibraries libs = vcat [ emptyLine $ (text "library" <+> disp n) $+$ nest indentWith (ppCondTree2 (libraryFieldGrammar $ Just n) condTree) | (n, condTree) <- libs ] -ppCondForeignLibs :: [(UnqualComponentName, CondTree ConfVar [Dependency] ForeignLib)] -> Doc +ppCondForeignLibs :: [(UnqualComponentName, CondTree ConfVar [LibDependency] ForeignLib)] -> Doc ppCondForeignLibs flibs = vcat [ emptyLine $ (text "foreign-library" <+> disp n) $+$ nest indentWith (ppCondTree2 (foreignLibFieldGrammar n) condTree) | (n, condTree) <- flibs ] -ppCondExecutables :: [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] -> Doc +ppCondExecutables :: [(UnqualComponentName, CondTree ConfVar [LibDependency] Executable)] -> Doc ppCondExecutables exes = vcat [ emptyLine $ (text "executable" <+> disp n) $+$ nest indentWith (ppCondTree2 (executableFieldGrammar n) condTree) | (n, condTree) <- exes ] -ppCondTestSuites :: [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] -> Doc +ppCondTestSuites :: [(UnqualComponentName, CondTree ConfVar [LibDependency] TestSuite)] -> Doc ppCondTestSuites suites = vcat [ emptyLine $ (text "test-suite" <+> disp n) $+$ nest indentWith (ppCondTree2 testSuiteFieldGrammar (fmap FG.unvalidateTestSuite condTree)) | (n, condTree) <- suites ] -ppCondBenchmarks :: [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] -> Doc +ppCondBenchmarks :: [(UnqualComponentName, CondTree ConfVar [LibDependency] Benchmark)] -> Doc ppCondBenchmarks suites = vcat [ emptyLine $ (text "benchmark" <+> disp n) $+$ nest indentWith (ppCondTree2 benchmarkFieldGrammar (fmap FG.unvalidateBenchmark condTree)) @@ -226,7 +226,7 @@ pdToGpd pd = GenericPackageDescription mkCondTree' :: (a -> UnqualComponentName) - -> a -> (UnqualComponentName, CondTree ConfVar [Dependency] a) + -> a -> (UnqualComponentName, CondTree ConfVar [LibDependency] a) mkCondTree' f x = (f x, CondNode x [] []) -- | @since 2.0.0.2 diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 2f8403d5ae0..d87b135b7ab 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -30,7 +30,7 @@ module Distribution.Simple.Build ( import Prelude () import Distribution.Compat.Prelude -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.Types.LocalBuildInfo import Distribution.Types.TargetInfo import Distribution.Types.ComponentRequestedSpec @@ -78,6 +78,7 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.Text import Distribution.Verbosity +import Distribution.Version (thisVersion) import Distribution.Compat.Graph (IsNode(..)) @@ -464,6 +465,8 @@ testSuiteLibV09AsLibAndExe pkg_descr PackageIdentifier pkg_name pkg_ver = package pkg_descr compat_name = computeCompatPackageName pkg_name (Just (testName test)) compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi) + -- Ew + compat_pkg_name = mkPackageName $ unMungedPackageName compat_name libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi , componentInternalDeps = componentInternalDeps clbi @@ -480,7 +483,7 @@ testSuiteLibV09AsLibAndExe pkg_descr , componentExposedModules = [IPI.ExposedModule m Nothing] } pkg = pkg_descr { - package = (package pkg_descr) { pkgName = mkPackageName $ unMungedPackageName compat_name } + package = (package pkg_descr) { pkgName = compat_pkg_name } , executables = [] , testSuites = [] , subLibraries = [lib] @@ -488,7 +491,8 @@ testSuiteLibV09AsLibAndExe pkg_descr ipi = inplaceInstalledPackageInfo pwd distPref pkg (mkAbiHash "") lib lbi libClbi testDir = buildDir lbi stubName test stubName test ++ "-tmp" - testLibDep = thisPackageVersion $ package pkg + testLibDep = LibDependency compat_pkg_name Nothing + $ thisVersion $ pkgVersion $ package pkg exe = Executable { exeName = mkUnqualComponentName $ stubName test, modulePath = stubFilePath test, diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 69f8bacbfb4..77f6538c790 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -71,6 +71,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.PackageDescription as PD hiding (Flag) import Distribution.Types.PackageDescription as PD +import Distribution.Types.LibDependency import Distribution.PackageDescription.PrettyPrint import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) @@ -134,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 ) @@ -396,11 +397,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 (Maybe UnqualComponentName) - internalPackageSet = getInternalPackages pkg_descr0 - -- Make a data structure describing what components are enabled. let enabled :: ComponentRequestedSpec enabled = case mb_cname of @@ -436,7 +432,7 @@ 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, Maybe UnqualComponentName) InstalledPackageInfo) <- either (die' verbosity) return $ combinedConstraints (configConstraints cfg) (configDependencies cfg) @@ -466,7 +462,6 @@ configure (pkg_descr0, pbi) cfg = do (fromFlagOrDefault False (configExactConfiguration cfg)) (packageName pkg_descr0) installedPackageSet - internalPackageSet requiredDepsMap) comp compPlatform @@ -504,7 +499,6 @@ configure (pkg_descr0, pbi) cfg = do <- configureDependencies verbosity use_external_internal_deps - internalPackageSet installedPackageSet requiredDepsMap pkg_descr @@ -584,7 +578,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) <- @@ -843,8 +836,7 @@ checkExactConfiguration verbosity pkg_descr0 cfg = -- 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 (Maybe UnqualComponentName) getInternalPackages pkg_descr0 = @@ -863,13 +855,17 @@ dependencySatisfiable -> Bool -- ^ exact configuration? -> PackageName -> InstalledPackageIndex -- ^ installed set - -> Map PackageName (Maybe UnqualComponentName) -- ^ internal set - -> Map PackageName InstalledPackageInfo -- ^ required dependencies - -> (Dependency -> Bool) + -> Map (PackageName, Maybe UnqualComponentName) InstalledPackageInfo -- ^ required dependencies + -> (LibDependency -> Bool) dependencySatisfiable use_external_internal_deps - exact_config pn installedPackageSet internalPackageSet requiredDepsMap - d@(Dependency depName vr) + exact_config pn installedPackageSet requiredDepsMap + d@(LibDependency dep_pkgName dep_mb_libName _) + + | dep_pkgName == pn && not use_external_internal_deps + -- when we're NOT per-component mode, and the dep is internal component, the + -- dep is always satisfiable (we're going to build it ourselves) + = True | exact_config -- When we're given '--exact-configuration', we assume that all @@ -880,41 +876,10 @@ dependencySatisfiable -- 'finalizePD' will fail. -- TODO: mention '--exact-configuration' in the error message -- when this fails? - = if isInternalDep && not use_external_internal_deps - -- Except for internal deps, when we're NOT per-component mode; - -- those are just True. - then True - else depName `Map.member` requiredDepsMap - - | isInternalDep - = if use_external_internal_deps - -- When we are doing per-component configure, we now need to - -- test if the internal dependency is in the index. This has - -- DIFFERENT semantics from normal dependency satisfiability. - then internalDepSatisfiable - -- If a 'PackageName' is defined by an internal component, the dep is - -- satisfiable (we're going to build it ourselves) - else True + = (dep_pkgName, dep_mb_libName) `Map.member` requiredDepsMap | otherwise - = depSatisfiable - - where - isInternalDep = Map.member depName internalPackageSet - - depSatisfiable = - not . null $ PackageIndex.lookupDependency installedPackageSet d - - internalDepSatisfiable = - not . null $ PackageIndex.lookupInternalDependency - installedPackageSet (Dependency pn vr) cn - where - cn | pn == depName - = Nothing - | otherwise - -- Reinterpret the "package name" as an unqualified component - -- name - = Just (mkUnqualComponentName (unPackageName depName)) + = not . null $ PackageIndex.lookupDependency installedPackageSet d -- | Finalize a generic package description. The workhorse is -- 'finalizePD' but there's a bit of other nattering @@ -927,8 +892,8 @@ configureFinalizedPackage -> ConfigFlags -> ComponentRequestedSpec -> [Dependency] - -> (Dependency -> Bool) -- ^ tests if a dependency is satisfiable. - -- Might say it's satisfiable even when not. + -> (LibDependency -> Bool) -- ^ tests if a dependency is satisfiable. + -- Might say it's satisfiable even when not. -> Compiler -> Platform -> GenericPackageDescription @@ -949,7 +914,7 @@ configureFinalizedPackage verbosity cfg enabled Left missing -> die' verbosity $ "Encountered missing dependencies:\n" ++ (render . nest 4 . sep . punctuate comma - . map (disp . simplifyDependency) + . map (disp . simplifyLibDependency) $ missing) -- add extra include/lib dirs as specified in cfg @@ -1010,25 +975,24 @@ checkCompilerProblems verbosity comp pkg_descr enabled = do configureDependencies :: Verbosity -> UseExternalInternalDeps - -> Map PackageName (Maybe UnqualComponentName) -- ^ internal packages -> InstalledPackageIndex -- ^ installed packages - -> Map PackageName InstalledPackageInfo -- ^ required deps + -> Map (PackageName, Maybe UnqualComponentName) InstalledPackageInfo -- ^ required deps -> PackageDescription -> ComponentRequestedSpec -> IO [PreExistingComponent] configureDependencies verbosity use_external_internal_deps - internalPackageSet installedPackageSet requiredDepsMap pkg_descr enableSpec = do + installedPackageSet requiredDepsMap pkg_descr enableSpec = do let failedDeps :: [FailedDependency] allPkgDeps :: [ResolvedDependency] (failedDeps, allPkgDeps) = partitionEithers [ (\s -> (dep, s)) <$> status | dep <- enabledBuildDepends pkg_descr enableSpec , let status = selectDependency (package pkg_descr) - internalPackageSet installedPackageSet + installedPackageSet requiredDepsMap use_external_internal_deps dep ] - internalPkgDeps = [ pkgid - | (_, InternalDependency pkgid) <- allPkgDeps ] + internalPkgDeps = [ dep + | (dep, InternalDependency _) <- 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. @@ -1038,7 +1002,7 @@ configureDependencies verbosity use_external_internal_deps when (not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr)) $ die' verbosity $ "The field 'build-depends: " - ++ intercalate ", " (map (display . packageName) internalPkgDeps) + ++ intercalate ", " (map display internalPkgDeps) ++ "' refers to a library which is defined within the same " ++ "package. To use this feature the package must specify at " ++ "least 'cabal-version: >= 1.8'." @@ -1165,7 +1129,7 @@ reportProgram verbosity prog (Just configuredProg) hackageUrl :: String hackageUrl = "http://hackage.haskell.org/package/" -type ResolvedDependency = (Dependency, DependencyResolution) +type ResolvedDependency = (LibDependency, DependencyResolution) data DependencyResolution -- | An external dependency from the package database, OR an @@ -1179,77 +1143,56 @@ data DependencyResolution | InternalDependency PackageId data FailedDependency = DependencyNotExists PackageName - | DependencyMissingInternal PackageName PackageName + | DependencyMissingInternal PackageName UnqualComponentName | DependencyNoVersion Dependency -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageId -- ^ Package id of current package - -> Map PackageName (Maybe UnqualComponentName) -> InstalledPackageIndex -- ^ Installed packages - -> Map PackageName InstalledPackageInfo + -> Map (PackageName, Maybe UnqualComponentName) InstalledPackageInfo -- ^ Packages for which we have been given specific deps to -- use -> UseExternalInternalDeps -- ^ Are we configuring a -- single component? - -> Dependency + -> LibDependency -> Either FailedDependency DependencyResolution -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_libname _) = + -- 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_libname, 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 -- It's an internal library, and we're not per-component build 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 requiredDepsMap of + do_external = do + ipi <- case Map.lookup (dep_pkgname, dep_mb_libname) 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. - Nothing -> - case is_internal of - Nothing -> do_external_external - Just mb_uqn -> do_external_internal mb_uqn - return $ ExternalDependency $ ipiToPreExistingComponent ipi - - -- It's an external package, normal situation - do_external_external = - case PackageIndex.lookupDependency installedIndex dep 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 - [] -> Left (DependencyMissingInternal dep_pkgname (packageName pkgid)) + Nothing -> case PackageIndex.lookupDependency installedIndex dep of + [] -> Left errVal pkgs -> Right $ head $ snd $ last pkgs + -- Fix metadata that may be stripped by old ghc-pkg + return $ ExternalDependency $ ipiToPreExistingComponent $ ipi + where + errVal = case dep_mb_libname of + Nothing -> DependencyNotExists dep_pkgname + Just intLibName -> DependencyMissingInternal dep_pkgname intLibName reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () reportSelectedDependencies verbosity deps = info verbosity $ unlines - [ "Dependency " ++ display (simplifyDependency dep) + [ "Dependency " ++ display (simplifyLibDependency dep) ++ ": using " ++ display pkgid | (dep, resolution) <- deps , let pkgid = case resolution of @@ -1359,10 +1302,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, Maybe UnqualComponentName) InstalledPackageInfo) combinedConstraints constraints dependencies installedPackages = do when (not (null badComponentIds)) $ @@ -1375,24 +1318,36 @@ 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)) + | (pn, _, _, Just pkg) <- dependenciesPkgInfo ] - idConstraintMap :: Map PackageName InstalledPackageInfo + idConstraintMap :: Map (PackageName, Maybe UnqualComponentName) InstalledPackageInfo idConstraintMap = Map.fromList -- NB: do NOT use the packageName from -- dependenciesPkgInfo! - [ (pn, pkg) - | (pn, _, Just pkg) <- dependenciesPkgInfo ] + [ ((pn, 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 ] @@ -1401,13 +1356,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/PackageIndex.hs b/Cabal/Distribution/Simple/PackageIndex.hs index c7773cc7473..e7071e6ea84 100644 --- a/Cabal/Distribution/Simple/PackageIndex.hs +++ b/Cabal/Distribution/Simple/PackageIndex.hs @@ -70,7 +70,6 @@ module Distribution.Simple.PackageIndex ( lookupPackageId, lookupPackageName, lookupDependency, - lookupInternalDependency, -- ** Case-insensitive searches searchByName, @@ -109,6 +108,7 @@ import Distribution.ModuleName import qualified Distribution.InstalledPackageInfo as IPI import Distribution.Version import Distribution.Simple.Utils +import Distribution.Types.LibDependency import Distribution.Types.UnqualComponentName import Control.Exception (assert) @@ -459,22 +459,6 @@ lookupPackageName index name = Just pvers -> Map.toList pvers --- | Does a lookup by source package name and a range of versions. --- --- We get back any number of versions of the specified package name, all --- satisfying the version range constraint. --- --- This does NOT work for internal dependencies, DO NOT use this --- function on those; use 'lookupInternalDependency' instead. --- --- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty. --- -lookupDependency :: InstalledPackageIndex -> Dependency - -> [(Version, [IPI.InstalledPackageInfo])] -lookupDependency index dep = - -- Yes, a little bit of a misnomer here! - lookupInternalDependency index dep Nothing - -- | Does a lookup by source package name and a range of versions. -- -- We get back any number of versions of the specified package name, all @@ -482,10 +466,9 @@ lookupDependency index dep = -- -- INVARIANT: List of eligible 'IPI.InstalledPackageInfo' is non-empty. -- -lookupInternalDependency :: InstalledPackageIndex -> Dependency - -> Maybe UnqualComponentName +lookupDependency :: InstalledPackageIndex -> LibDependency -> [(Version, [IPI.InstalledPackageInfo])] -lookupInternalDependency index (Dependency name versionRange) libn = +lookupDependency index (LibDependency name libn versionRange) = case Map.lookup (name, libn) (packageIdIndex index) of Nothing -> [] Just pvers -> [ (ver, pkgs') diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 5fa0e993a73..3acbafe867c 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -101,6 +101,7 @@ import Distribution.Types.Dependency import Distribution.Types.ComponentId import Distribution.Types.Module import Distribution.Types.PackageName +import Distribution.Types.UnqualComponentName import Distribution.Compat.Stack import Distribution.Compat.Semigroup (Last' (..)) @@ -342,7 +343,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 @@ -734,8 +735,8 @@ configureOptions showOrParseArgs = "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" configDependencies (\v flags -> flags { configDependencies = v}) (reqArg "NAME=CID" - (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parsecDependency)) - (map (\x -> display (fst x) ++ "=" ++ display (snd x)))) + (parsecToReadE (const "dependency expected") ((\x -> [x]) `fmap` parseDependency)) + (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." @@ -817,12 +818,15 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] showProfDetailLevelFlag NoFlag = [] showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] -parsecDependency :: ParsecParser (PackageName, ComponentId) -parsecDependency = do +parseDependency :: ParsecParser (PackageName, Maybe UnqualComponentName, ComponentId) +parseDependency = do x <- parsec + y <- P.option Nothing $ do + _ <- P.char ':' + fmap Just parsec _ <- P.char '=' - y <- parsec - return (x, y) + z <- parsec + 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 7685270d77f..3c2bdacf4be 100644 --- a/Cabal/Distribution/Types/BuildInfo.hs +++ b/Cabal/Distribution/Types/BuildInfo.hs @@ -20,10 +20,10 @@ import Prelude () import Distribution.Compat.Prelude import Distribution.Types.Mixin -import Distribution.Types.Dependency import Distribution.Types.ExeDependency import Distribution.Types.LegacyExeDependency import Distribution.Types.PkgconfigDependency +import Distribution.Types.LibDependency import Distribution.ModuleName import Distribution.Compiler @@ -99,7 +99,30 @@ 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 :: [LibDependency], + + -- | 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) diff --git a/Cabal/Distribution/Types/BuildInfo/Lens.hs b/Cabal/Distribution/Types/BuildInfo/Lens.hs index 25e1cc65972..e10a5bb6eeb 100644 --- a/Cabal/Distribution/Types/BuildInfo/Lens.hs +++ b/Cabal/Distribution/Types/BuildInfo/Lens.hs @@ -11,9 +11,9 @@ import Distribution.Compat.Lens import Distribution.Compiler (CompilerFlavor) import Distribution.ModuleName (ModuleName) import Distribution.Types.BuildInfo (BuildInfo) -import Distribution.Types.Dependency (Dependency) import Distribution.Types.ExeDependency (ExeDependency) import Distribution.Types.LegacyExeDependency (LegacyExeDependency) +import Distribution.Types.LibDependency (LibDependency) import Distribution.Types.Mixin (Mixin) import Distribution.Types.PkgconfigDependency (PkgconfigDependency) import Language.Haskell.Extension (Extension, Language) @@ -180,7 +180,7 @@ class HasBuildInfo a where customFieldsBI = buildInfo . customFieldsBI {-# INLINE customFieldsBI #-} - targetBuildDepends :: Lens' a [Dependency] + targetBuildDepends :: Lens' a [LibDependency] targetBuildDepends = buildInfo . targetBuildDepends {-# INLINE targetBuildDepends #-} diff --git a/Cabal/Distribution/Types/DependencyMap.hs b/Cabal/Distribution/Types/DependencyMap.hs index f7dc3a20a9a..40932e84e92 100644 --- a/Cabal/Distribution/Types/DependencyMap.hs +++ b/Cabal/Distribution/Types/DependencyMap.hs @@ -13,10 +13,10 @@ #endif module Distribution.Types.DependencyMap ( - DependencyMap, + DependencyMap(..), toDepMap, fromDepMap, - constrainBy, + lookupDepMap, ) where import Prelude () @@ -52,23 +52,5 @@ toDepMap ds = fromDepMap :: DependencyMap -> [Dependency] fromDepMap m = [ Dependency p vr | (p,vr) <- Map.toList (unDependencyMap 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 --- be intersected. -constrainBy :: DependencyMap -- ^ Input map - -> DependencyMap -- ^ Extra constraints - -> DependencyMap -constrainBy left extra = - DependencyMap $ -#ifdef MIN_VERSION_containers_0_5_0 - Map.foldrWithKey tightenConstraint (unDependencyMap left) - (unDependencyMap extra) -#else - Map.foldWithKey tightenConstraint (unDependencyMap left) - (unDependencyMap extra) -#endif - where tightenConstraint n c l = - case Map.lookup n l of - Nothing -> l - Just vr -> Map.insert n (intersectVersionRanges vr c) l +lookupDepMap :: DependencyMap -> PackageName -> Maybe VersionRange +lookupDepMap (DependencyMap m) pn = Map.lookup pn m diff --git a/Cabal/Distribution/Types/ExeDependency.hs b/Cabal/Distribution/Types/ExeDependency.hs index 185eb256e01..0f6cf8ee900 100644 --- a/Cabal/Distribution/Types/ExeDependency.hs +++ b/Cabal/Distribution/Types/ExeDependency.hs @@ -23,11 +23,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, + exeDepVersionRange :: VersionRange + } + deriving (Generic, Read, Show, Eq, Typeable, Data) instance Binary ExeDependency instance NFData ExeDependency where rnf = genericRnf diff --git a/Cabal/Distribution/Types/GenericPackageDescription.hs b/Cabal/Distribution/Types/GenericPackageDescription.hs index 39a72417dc9..7b5bcb4c539 100644 --- a/Cabal/Distribution/Types/GenericPackageDescription.hs +++ b/Cabal/Distribution/Types/GenericPackageDescription.hs @@ -42,7 +42,7 @@ import qualified Distribution.Types.BuildInfo.Lens as L import Distribution.Types.PackageDescription -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.Types.Library import Distribution.Types.ForeignLib import Distribution.Types.Executable @@ -66,17 +66,17 @@ data GenericPackageDescription = GenericPackageDescription { packageDescription :: PackageDescription , genPackageFlags :: [Flag] - , condLibrary :: Maybe (CondTree ConfVar [Dependency] Library) + , condLibrary :: Maybe (CondTree ConfVar [LibDependency] Library) , condSubLibraries :: [( UnqualComponentName - , CondTree ConfVar [Dependency] Library )] + , CondTree ConfVar [LibDependency] Library )] , condForeignLibs :: [( UnqualComponentName - , CondTree ConfVar [Dependency] ForeignLib )] + , CondTree ConfVar [LibDependency] ForeignLib )] , condExecutables :: [( UnqualComponentName - , CondTree ConfVar [Dependency] Executable )] + , CondTree ConfVar [LibDependency] Executable )] , condTestSuites :: [( UnqualComponentName - , CondTree ConfVar [Dependency] TestSuite )] + , CondTree ConfVar [LibDependency] TestSuite )] , condBenchmarks :: [( UnqualComponentName - , CondTree ConfVar [Dependency] Benchmark )] + , CondTree ConfVar [LibDependency] Benchmark )] } deriving (Show, Eq, Typeable, Data, Generic) diff --git a/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs b/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs index 315268a056e..0a089b46771 100644 --- a/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs +++ b/Cabal/Distribution/Types/GenericPackageDescription/Lens.hs @@ -14,7 +14,6 @@ import Distribution.Compat.Lens -- We import types from their packages, so we can remove unused imports -- and have wider inter-module dependency graph import Distribution.Types.CondTree (CondTree) -import Distribution.Types.Dependency (Dependency) import Distribution.Types.Executable (Executable) import Distribution.Types.PackageDescription (PackageDescription) import Distribution.Types.Benchmark (Benchmark) @@ -23,6 +22,7 @@ import Distribution.Types.GenericPackageDescription ( GenericPackageDescription(GenericPackageDescription) , Flag(MkFlag), FlagName, ConfVar (..)) import Distribution.Types.Library (Library) +import Distribution.Types.LibDependency (LibDependency) import Distribution.Types.TestSuite (TestSuite) import Distribution.Types.UnqualComponentName (UnqualComponentName) import Distribution.System (Arch, OS) @@ -33,27 +33,27 @@ import Distribution.Version (VersionRange) -- GenericPackageDescription ------------------------------------------------------------------------------- -condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)] +condBenchmarks :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] Benchmark)] condBenchmarks f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 y1) (f x8) {-# INLINE condBenchmarks #-} -condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Executable)] +condExecutables :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] Executable)] condExecutables f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 y1 x7 x8) (f x6) {-# INLINE condExecutables #-} -condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Distribution.Types.ForeignLib.ForeignLib)] +condForeignLibs :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] Distribution.Types.ForeignLib.ForeignLib)] condForeignLibs f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 y1 x6 x7 x8) (f x5) {-# INLINE condForeignLibs #-} -condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [Dependency] Library)) +condLibrary :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [LibDependency] Library)) condLibrary f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 y1 x4 x5 x6 x7 x8) (f x3) {-# INLINE condLibrary #-} -condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] Library)] +condSubLibraries :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] Library)] condSubLibraries f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 y1 x5 x6 x7 x8) (f x4) {-# INLINE condSubLibraries #-} -condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)] +condTestSuites :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] TestSuite)] condTestSuites f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap (\y1 -> GenericPackageDescription x1 x2 x3 x4 x5 x6 y1 x8) (f x7) {-# INLINE condTestSuites #-} @@ -67,8 +67,8 @@ packageDescription f (GenericPackageDescription x1 x2 x3 x4 x5 x6 x7 x8) = fmap allCondTrees :: Applicative f - => (forall a. CondTree ConfVar [Dependency] a - -> f (CondTree ConfVar [Dependency] a)) + => (forall a. CondTree ConfVar [LibDependency] a + -> f (CondTree ConfVar [LibDependency] a)) -> GenericPackageDescription -> f GenericPackageDescription allCondTrees f (GenericPackageDescription p a1 x1 x2 x3 x4 x5 x6) = diff --git a/Cabal/Distribution/Types/LibDependency.hs b/Cabal/Distribution/Types/LibDependency.hs new file mode 100644 index 00000000000..395d67b5af8 --- /dev/null +++ b/Cabal/Distribution/Types/LibDependency.hs @@ -0,0 +1,75 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Distribution.Types.LibDependency + ( LibDependency(..) + , thisPackageVersion + , notThisPackageVersion + , libDependencyToDependency + , simplifyLibDependency + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Parsec.Class +import Distribution.Pretty +import Distribution.Text +import Distribution.Types.PackageName +import Distribution.Types.UnqualComponentName +import Distribution.Types.Dependency +import Distribution.Version ( VersionRange, anyVersion + , simplifyVersionRange ) + +import qualified Distribution.Compat.CharParsing as P +import Distribution.Compat.ReadP +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 Pretty LibDependency where + pretty (LibDependency name mCname ver) = + (pretty name <<>> prettyMaybeCname) <+> pretty ver + where + prettyMaybeCname = case mCname of + Nothing -> PP.empty + Just cname -> text ":" <<>> pretty cname + +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) + +instance Text LibDependency where + 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 + + +-- | 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/LibDependencyMap.hs b/Cabal/Distribution/Types/LibDependencyMap.hs new file mode 100644 index 00000000000..cabb7b6bafa --- /dev/null +++ b/Cabal/Distribution/Types/LibDependencyMap.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE CPP #-} + +#ifdef MIN_VERSION_containers +#if MIN_VERSION_containers(0,5,0) +#define MIN_VERSION_containers_0_5_0 +#endif +#endif + +#ifndef MIN_VERSION_containers +#if __GLASGOW_HASKELL__ >= 706 +#define MIN_VERSION_containers_0_5_0 +#endif +#endif + +module Distribution.Types.LibDependencyMap + ( LibDependencyMap + , toLibDepMap + , fromLibDepMap + , lookupLibDepMap + , discardLibNames + , constrainBy + ) where + +import Prelude () +import Distribution.Compat.Prelude + +import Distribution.Types.PackageName +import Distribution.Types.LibDependency +import Distribution.Types.DependencyMap +import Distribution.Types.UnqualComponentName +import Distribution.Version + +#ifdef MIN_VERSION_containers_0_5_0 +import qualified Data.Map.Lazy as Map +#else +import qualified Data.Map as Map +#endif +import qualified Data.Set as Set + +-- | A map of dependencies. Newtyped since the default monoid instance is not +-- appropriate. The monoid instance uses 'intersectVersionRanges'. +newtype LibDependencyMap = LibDependencyMap { + unLibDependencyMap :: Map PackageName ( Set.Set (Maybe UnqualComponentName) + , VersionRange ) + } + deriving (Show, Read) + +instance Monoid LibDependencyMap where + mempty = LibDependencyMap Map.empty + mappend = (<>) + +instance Semigroup LibDependencyMap where + (LibDependencyMap a) <> (LibDependencyMap b) = + LibDependencyMap (Map.unionWith combineValue a b) + +combineValue :: (Set.Set (Maybe UnqualComponentName), VersionRange) + -> (Set.Set (Maybe UnqualComponentName), VersionRange) + -> (Set.Set (Maybe UnqualComponentName), VersionRange) +combineValue (cs0, vr0) (cs1, vr1) = ( Set.union cs0 cs1 + , intersectVersionRanges vr0 vr1 ) + +toLibDepMap :: [LibDependency] -> LibDependencyMap +toLibDepMap ds = LibDependencyMap $ Map.fromListWith + combineValue + [ (p, (Set.singleton l, vr)) | LibDependency p l vr <- ds ] + +fromLibDepMap :: LibDependencyMap -> [LibDependency] +fromLibDepMap m = [ LibDependency p l vr + | (p, (ls, vr)) <- Map.toList (unLibDependencyMap m) + , l <- Set.toList ls ] + +lookupLibDepMap :: LibDependencyMap + -> PackageName + -> Maybe (Set.Set (Maybe UnqualComponentName), VersionRange) +lookupLibDepMap (LibDependencyMap m) pn = Map.lookup pn m + +discardLibNames :: LibDependencyMap -> DependencyMap +discardLibNames = DependencyMap . fmap (\(_, vr) -> vr) . unLibDependencyMap + +-- 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 +-- be intersected. +constrainBy :: LibDependencyMap -- ^ Input map + -> DependencyMap -- ^ Extra constraints + -> LibDependencyMap +constrainBy left extra = LibDependencyMap $ + fold tightenConstraint (unLibDependencyMap left) + (unDependencyMap extra) + where tightenConstraint n v l = + case Map.lookup n l of + Nothing -> l + Just entry -> Map.insert n (combineValue entry (Set.empty, v)) l + fold = +#ifdef MIN_VERSION_containers_0_5_0 + Map.foldrWithKey +#else + Map.foldWithKey +#endif diff --git a/Cabal/Distribution/Types/Mixin.hs b/Cabal/Distribution/Types/Mixin.hs index 705678770d2..25a858bc443 100644 --- a/Cabal/Distribution/Types/Mixin.hs +++ b/Cabal/Distribution/Types/Mixin.hs @@ -8,18 +8,21 @@ module Distribution.Types.Mixin ( import Distribution.Compat.Prelude import Prelude () -import Text.PrettyPrint ((<+>)) +import Text.PrettyPrint ((<+>), colon) +import Distribution.Compat.ReadP +import Distribution.Text import Distribution.Parsec.Class import Distribution.Pretty -import Distribution.Text import Distribution.Types.IncludeRenaming import Distribution.Types.PackageName +import Distribution.Types.UnqualComponentName import qualified Distribution.Compat.CharParsing as P import qualified Distribution.Compat.ReadP as Parse data Mixin = Mixin { mixinPackageName :: PackageName + , mixinLibraryName :: Maybe UnqualComponentName , mixinIncludeRenaming :: IncludeRenaming } deriving (Show, Read, Eq, Ord, Typeable, Data, Generic) @@ -28,18 +31,28 @@ instance Binary Mixin instance NFData Mixin where rnf = genericRnf instance Pretty Mixin where - pretty (Mixin pkg_name incl) = pretty pkg_name <+> pretty incl + pretty (Mixin pkg_name Nothing incl) = + pretty pkg_name <+> pretty incl + pretty (Mixin pkg_name (Just lib_name) incl) = + pretty pkg_name <<>> colon <<>> pretty lib_name <+> pretty incl 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 Text Mixin where parse = do pkg_name <- parse Parse.skipSpaces + mb_lib_name <- option Nothing $ do + _ <- char ':' + fmap Just parse + Parse.skipSpaces incl <- parse - return (Mixin pkg_name incl) + return (Mixin pkg_name mb_lib_name incl) diff --git a/Cabal/Distribution/Types/PackageDescription.hs b/Cabal/Distribution/Types/PackageDescription.hs index 0a6f519fce7..05aeb1df276 100644 --- a/Cabal/Distribution/Types/PackageDescription.hs +++ b/Cabal/Distribution/Types/PackageDescription.hs @@ -74,7 +74,7 @@ import Distribution.Types.ForeignLib import Distribution.Types.Component import Distribution.Types.ComponentRequestedSpec -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.Types.PackageId import Distribution.Types.ComponentName import Distribution.Types.PackageName @@ -386,12 +386,12 @@ enabledBuildInfos pkg enabled = -- ------------------------------------------------------------ -- | Get the combined build-depends entries of all components. -allBuildDepends :: PackageDescription -> [Dependency] +allBuildDepends :: PackageDescription -> [LibDependency] allBuildDepends = targetBuildDepends <=< allBuildInfo -- | Get the combined build-depends entries of all enabled components, per the -- given request spec. -enabledBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [Dependency] +enabledBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [LibDependency] enabledBuildDepends spec pd = targetBuildDepends =<< enabledBuildInfos spec pd diff --git a/Cabal/Distribution/Types/SetupBuildInfo.hs b/Cabal/Distribution/Types/SetupBuildInfo.hs index 503af3131fd..a855d244a75 100644 --- a/Cabal/Distribution/Types/SetupBuildInfo.hs +++ b/Cabal/Distribution/Types/SetupBuildInfo.hs @@ -19,6 +19,8 @@ import Distribution.Types.Dependency data SetupBuildInfo = SetupBuildInfo { setupDepends :: [Dependency] + -- ^ This will become `[LibDependency]` if when external named + -- libraries are usabable as dependencies. , defaultSetupDepends :: Bool -- ^ Is this a default 'custom-setup' section added by the cabal-install -- code (as opposed to user-provided)? This field is only used diff --git a/Cabal/doc/developing-packages.rst b/Cabal/doc/developing-packages.rst index a6813f40bf7..05be42ebf90 100644 --- a/Cabal/doc/developing-packages.rst +++ b/Cabal/doc/developing-packages.rst @@ -44,7 +44,7 @@ questions starting with the package name and version. ... It also asks questions about various other bits of package metadata. For -a package that you never intend to distribute to others, these fields +a package that you never intend to distributehttps://github.com/TaktInc/takt-core/pull/1500 to others, these fields can be left blank. One of the important questions is whether the package contains a library @@ -1102,10 +1102,10 @@ look something like this: name: foo version: 1.0 license: BSD3 - cabal-version: >= 1.23 + cabal-version: >= 2.1 build-type: Simple - library foo-internal + library internal exposed-modules: Foo.Internal -- NOTE: no explicit constraints on base needed -- as they're inherited from the 'library' stanza @@ -1113,22 +1113,25 @@ look something like this: library exposed-modules: Foo.Public - build-depends: foo-internal, base >= 4.3 && < 5 + build-depends: base >= 4.3 && < 5, foo:internal test-suite test-foo type: exitcode-stdio-1.0 main-is: test-foo.hs - -- NOTE: no constraints on 'foo-internal' as same-package + -- NOTE: no constraints on 'foo:internal' as same-package -- dependencies implicitly refer to the same package instance - build-depends: foo-internal, base + 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.) +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.) If the package has a minimum Cabal version of 2.1 then interal +library dependencies are specified as ``package-name:lib-name``. This what is +shown above. If the minimum Cabal version is 2.0, then just the lib-name is +given. That means with 2.0, 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). Opening an interpreter session ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ diff --git a/Cabal/tests/Instances/TreeDiff.hs b/Cabal/tests/Instances/TreeDiff.hs index 9044fdc855a..ddd2e410ed2 100644 --- a/Cabal/tests/Instances/TreeDiff.hs +++ b/Cabal/tests/Instances/TreeDiff.hs @@ -25,6 +25,7 @@ import Distribution.Types.AbiHash (AbiHash) import Distribution.Types.ComponentId (ComponentId) import Distribution.Types.CondTree import Distribution.Types.ExecutableScope +import Distribution.Types.LibDependency import Distribution.Types.ExeDependency import Distribution.Types.ForeignLib import Distribution.Types.ForeignLibOption @@ -55,6 +56,7 @@ instance ToExpr CompilerFlavor instance ToExpr ComponentId where toExpr = defaultExprViaShow instance ToExpr DefUnitId instance ToExpr Dependency +instance ToExpr LibDependency where toExpr = defaultExprViaShow instance ToExpr ExeDependency where toExpr = defaultExprViaShow instance ToExpr Executable instance ToExpr ExecutableScope where toExpr = defaultExprViaShow diff --git a/Cabal/tests/ParserHackageTests.hs b/Cabal/tests/ParserHackageTests.hs new file mode 100644 index 00000000000..734a5059a13 --- /dev/null +++ b/Cabal/tests/ParserHackageTests.hs @@ -0,0 +1,365 @@ +{-# LANGUAGE Rank2Types #-} +module Main where + +import Control.Applicative + (Applicative (..), (<$>), Const (..)) +import Control.Monad (when) +import Data.Foldable + (foldMap, for_, traverse_) +import Data.List (isPrefixOf, isSuffixOf) +import Data.Maybe (mapMaybe, listToMaybe) +import Data.Monoid (Monoid (..), Sum (..)) +import Data.Traversable (traverse) +import Distribution.Simple.Utils (fromUTF8LBS, ignoreBOM) +import System.Directory + (getAppUserDataDirectory) +import System.Environment (getArgs) +import System.Exit (exitFailure) +import System.FilePath (()) + +import Distribution.Types.LibDependency +import Distribution.Types.UnqualComponentName +import Distribution.PackageDescription + +import qualified Codec.Archive.Tar as Tar +import qualified Data.ByteString as B +import qualified Data.ByteString.Char8 as B8 +import qualified Data.ByteString.Lazy as BSL +import qualified Data.Map as Map +import qualified Distribution.PackageDescription.Parse as ReadP +import qualified Distribution.PackageDescription.Parsec as Parsec +import qualified Distribution.Parsec.Parser as Parsec +import qualified Distribution.Parsec.Types.Common as Parsec +import qualified Distribution.ParseUtils as ReadP +import qualified Distribution.Compat.DList as DList + +#if __GLASGOW_HASKELL__ >= 708 +import Data.Coerce +#else +import Unsafe.Coerce +#endif + +#ifdef HAS_STRUCT_DIFF +import DiffInstances () +import StructDiff +#endif + +parseIndex :: Monoid a => (FilePath -> BSL.ByteString -> IO a) -> IO a +parseIndex action = do + cabalDir <- getAppUserDataDirectory "cabal" + cfg <- B.readFile (cabalDir "config") + cfgFields <- either (fail . show) pure $ Parsec.readFields cfg + let repos = reposFromConfig cfgFields + repoCache = case lookupInConfig "remote-repo-cache" cfgFields of + [] -> cabalDir "packages" -- Default + (rrc : _) -> rrc -- User-specified + tarName repo = repoCache repo "01-index.tar" + mconcat <$> traverse (parseIndex' action . tarName) repos + + +parseIndex' :: Monoid a => (FilePath -> BSL.ByteString -> IO a) -> FilePath -> IO a +parseIndex' action path = do + putStrLn $ "Reading index from: " ++ path + contents <- BSL.readFile path + let entries = Tar.read contents + Tar.foldEntries (\e m -> mappend <$> f e <*> m) (return mempty) (fail . show) entries + + where + f entry = case Tar.entryContent entry of + Tar.NormalFile contents _ + | ".cabal" `isSuffixOf` fpath -> action fpath contents + | otherwise -> return mempty + Tar.Directory -> return mempty + _ -> putStrLn ("Unknown content in " ++ fpath) >> return mempty + where + fpath = Tar.entryPath entry + +readFieldTest :: FilePath -> BSL.ByteString -> IO () +readFieldTest fpath bsl = case Parsec.readFields $ BSL.toStrict bsl of + Right _ -> return () + Left err -> putStrLn $ fpath ++ "\n" ++ show err + +-- | Map with unionWith monoid +newtype M k v = M (Map.Map k v) + deriving (Show) +instance (Ord k, Monoid v) => Monoid (M k v) where + mempty = M Map.empty + mappend (M a) (M b) = M (Map.unionWith mappend a b) + +compareTest + :: String -- ^ prefix of first packages to start traversal + -> FilePath -> BSL.ByteString -> IO (Sum Int, Sum Int, M Parsec.PWarnType (Sum Int)) +compareTest pfx fpath bsl + | any ($ fpath) problematicFiles = mempty + | not $ pfx `isPrefixOf` fpath = mempty + | otherwise = do + let str = ignoreBOM $ fromUTF8LBS bsl + + putStrLn $ "::: " ++ fpath + (readp, readpWarnings) <- case ReadP.parseGenericPackageDescription str of + ReadP.ParseOk ws x -> return (x, ws) + ReadP.ParseFailed err -> print err >> exitFailure + traverse_ (putStrLn . ReadP.showPWarning fpath) readpWarnings + + let (warnings, errors, parsec') = Parsec.runParseResult $ Parsec.parseGenericPackageDescription (BSL.toStrict bsl) + traverse_ (putStrLn . Parsec.showPWarning fpath) warnings + traverse_ (putStrLn . Parsec.showPError fpath) errors + parsec <- maybe (print readp >> exitFailure) return parsec' + + -- Old parser is broken for many descriptions, and other free text fields + let readp0 = readp + & set (packageDescription_ . description_) "" + & set (packageDescription_ . synopsis_) "" + & set (packageDescription_ . maintainer_) "" + let parsec0 = parsec + & set (packageDescription_ . description_) "" + & set (packageDescription_ . synopsis_) "" + & set (packageDescription_ . maintainer_) "" + + -- hs-source-dirs ".", old parser broken + -- See e.g. http://hackage.haskell.org/package/hledger-ui-0.27/hledger-ui.cabal executable + let parsecHsSrcDirs = parsec0 & toListOf (buildInfos_ . hsSourceDirs_) + let readpHsSrcDirs = readp0 & toListOf (buildInfos_ . hsSourceDirs_) + let filterDotDirs = filter (/= ".") + + let parsec1 = if parsecHsSrcDirs /= readpHsSrcDirs && fmap filterDotDirs parsecHsSrcDirs == readpHsSrcDirs + then parsec0 & over (buildInfos_ . hsSourceDirs_) filterDotDirs + else parsec0 + + -- Compare two parse results + if readp0 == parsec1 + then return () + else do +#if HAS_STRUCT_DIFF + prettyResultIO $ diff readp parsec +#else + putStrLn "<<<<<<" + print readp + putStrLn "======" + print parsec + putStrLn ">>>>>>" +#endif + exitFailure + + let readpWarnCount = Sum (length readpWarnings) + let parsecWarnCount = Sum (length warnings) + + when (readpWarnCount > parsecWarnCount) $ do + putStrLn "There are more readpWarnings" + exitFailure + + let parsecWarnMap = foldMap (\(Parsec.PWarning t _ _) -> M $ Map.singleton t 1) warnings + return (readpWarnCount, parsecWarnCount, parsecWarnMap) + +parseReadpTest :: FilePath -> BSL.ByteString -> IO () +parseReadpTest fpath bsl = when (not $ any ($ fpath) problematicFiles) $ do + let str = fromUTF8LBS bsl + case ReadP.parseGenericPackageDescription str of + ReadP.ParseOk _ _ -> return () + ReadP.ParseFailed err -> print err >> exitFailure + +parseParsecTest :: FilePath -> BSL.ByteString -> IO () +parseParsecTest fpath bsl = when (not $ any ($ fpath) problematicFiles) $ do + let bs = BSL.toStrict bsl + let (_warnings, errors, parsec) = Parsec.runParseResult $ Parsec.parseGenericPackageDescription bs + case parsec of + Just _ -> return () + Nothing -> do + traverse_ (putStrLn . Parsec.showPError fpath) errors + exitFailure + +problematicFiles :: [FilePath -> Bool] +problematicFiles = + [ + -- Indent failure + eq "control-monad-exception-mtl/0.10.3/control-monad-exception-mtl.cabal" + -- Other modules <- no dash + , eq "DSTM/0.1/DSTM.cabal" + , eq "DSTM/0.1.1/DSTM.cabal" + , eq "DSTM/0.1.2/DSTM.cabal" + -- colon : after section header + , eq "ds-kanren/0.2.0.0/ds-kanren.cabal" + , eq "ds-kanren/0.2.0.1/ds-kanren.cabal" + , eq "metric/0.1.4/metric.cabal" + , eq "metric/0.2.0/metric.cabal" + , eq "phasechange/0.1/phasechange.cabal" + , eq "shelltestrunner/1.3/shelltestrunner.cabal" + , eq "smartword/0.0.0.5/smartword.cabal" + -- \DEL + , eq "vacuum-opengl/0.0/vacuum-opengl.cabal" + , eq "vacuum-opengl/0.0.1/vacuum-opengl.cabal" + -- dashes in version, not even tag + , isPrefixOf "free-theorems-webui/" + -- {- comment -} + , eq "ixset/1.0.4/ixset.cabal" + -- comments in braces + , isPrefixOf "hint/" + ] + where + eq = (==) + +main :: IO () +main = do + args <- getArgs + case args of + ["read-field"] -> parseIndex readFieldTest + ["parse-readp"] -> parseIndex parseReadpTest + ["parse-parsec"] -> parseIndex parseParsecTest + [pfx] -> defaultMain pfx + _ -> defaultMain "" + where + defaultMain pfx = do + (Sum readpCount, Sum parsecCount, M warn) <- parseIndex (compareTest pfx) + putStrLn $ "readp warnings: " ++ show readpCount + putStrLn $ "parsec count: " ++ show parsecCount + for_ (Map.toList warn) $ \(t, Sum c) -> + putStrLn $ " - " ++ show t ++ " : " ++ show c + +------------------------------------------------------------------------------- +-- Index shuffling +------------------------------------------------------------------------------- + +-- TODO: Use 'Cabal' for this? +reposFromConfig :: [Parsec.Field ann] -> [String] +reposFromConfig fields = takeWhile (/= ':') <$> mapMaybe f fields + where + f (Parsec.Field (Parsec.Name _ name) fieldLines) + | B8.unpack name == "remote-repo" = + Just $ fieldLinesToString fieldLines + f (Parsec.Section (Parsec.Name _ name) [Parsec.SecArgName _ secName] _fieldLines) + | B8.unpack name == "repository" = + Just $ B8.unpack secName + f _ = Nothing + +-- | Looks up the given key in the cabal configuration file +lookupInConfig :: String -> [Parsec.Field ann] -> [String] +lookupInConfig key = mapMaybe f + where + f (Parsec.Field (Parsec.Name _ name) fieldLines) + | B8.unpack name == key = + Just $ fieldLinesToString fieldLines + f _ = Nothing + +fieldLinesToString :: [Parsec.FieldLine ann] -> String +fieldLinesToString fieldLines = + B8.unpack $ B.concat $ bsFromFieldLine <$> fieldLines + where + bsFromFieldLine (Parsec.FieldLine _ bs) = bs + +------------------------------------------------------------------------------- +-- Distribution.Compat.Lens +------------------------------------------------------------------------------- + +type Lens' s a = forall f. Functor f => (a -> f a) -> s -> f s +type Traversal' s a = forall f. Applicative f => (a -> f a) -> s -> f s + +type Getting r s a = (a -> Const r a) -> s -> Const r s +type ASetter' s a = (a -> I a) -> s -> I s + + + +-- | View the value pointed to by a 'Getting' or 'Lens' or the +-- result of folding over all the results of a 'Control.Lens.Fold.Fold' or +-- 'Control.Lens.Traversal.Traversal' that points at a monoidal values. +view :: s -> Getting a s a -> a +view s l = getConst (l Const s) + +-- | Replace the target of a 'Lens'' or 'Traversal'' with a constant value. +set :: ASetter' s a -> a -> s -> s +set l x = over l (const x) + +-- | Modify the target of a 'Lens'' or all the targets of a 'Traversal'' +-- with a function. +over :: ASetter' s a -> (a -> a) -> s -> s +#if __GLASGOW_HASKELL__ >= 708 +over l f = coerce . l (coerce . f) +#else +over l f = unsafeCoerce . l (unsafeCoerce . f) +#endif + +-- | Build a 'Lens'' from a getter and a setter. +lens :: (s -> a) -> (s -> a -> s) -> Lens' s a +lens sa sbt afb s = sbt s <$> afb (sa s) + +-- | Build an 'Getting' from an arbitrary Haskell function. +to :: (s -> a) -> Getting r s a +to f g a = Const $ getConst $ g (f a) + +-- | Extract a list of the targets of a 'Lens'' or 'Traversal''. +toListOf :: Getting (DList.DList a) s a -> s -> [a] +toListOf l = DList.runDList . getConst . l (Const . DList.singleton) + +-- | Retrieve the first entry of a 'Traversal'' or retrieve 'Just' the result +-- from a 'Getting' or 'Lens''. +firstOf :: Getting (DList.DList a) s a -> s -> Maybe a +firstOf l = listToMaybe . toListOf l + +-- | '&' is a reverse application operator +(&) :: a -> (a -> b) -> b +(&) = flip ($) +{-# INLINE (&) #-} +infixl 1 & + +------------------------------------------------------------------------------- +-- Distribution.Compat.BasicFunctors +------------------------------------------------------------------------------- + +newtype I a = I a + +unI :: I a -> a +unI (I x) = x + +instance Functor I where + fmap f (I x) = I (f x) + +instance Applicative I where + pure = I + I f <*> I x = I (f x) + _ *> x = x + +_2 :: Lens' (a, b) b +_2 = lens snd $ \(a, _) b -> (a, b) + +------------------------------------------------------------------------------- +-- Distribution.PackageDescription.Lens +------------------------------------------------------------------------------- + +packageDescription_ :: Lens' GenericPackageDescription PackageDescription +packageDescription_ = lens packageDescription $ \s a -> s { packageDescription = a } + +condLibrary_ :: Lens' GenericPackageDescription (Maybe (CondTree ConfVar [LibDependency] Library)) +condLibrary_ = lens condLibrary $ \s a -> s { condLibrary = a} + +condExecutables_ :: Lens' GenericPackageDescription [(UnqualComponentName, CondTree ConfVar [LibDependency] Executable)] +condExecutables_ = lens condExecutables $ \s a -> s { condExecutables = a } + +condTreeData_ :: Lens' (CondTree v c a) a +condTreeData_ = lens condTreeData $ \s a -> s { condTreeData = a } + +description_, synopsis_, maintainer_ :: Lens' PackageDescription String +description_ = lens description $ \s a -> s { description = a } +synopsis_ = lens synopsis $ \s a -> s { synopsis = a } +maintainer_ = lens maintainer $ \s a -> s { maintainer = a } + +class HasBuildInfo a where + buildInfo_ :: Lens' a BuildInfo + +instance HasBuildInfo Library where + buildInfo_ = lens libBuildInfo $ \s a -> s { libBuildInfo = a } + +instance HasBuildInfo Executable where + buildInfo_ = lens buildInfo $ \s a -> s { buildInfo = a } + +-- | This forgets a lot of structure, but might be nice for some stuff +buildInfos_ :: Traversal' GenericPackageDescription BuildInfo +buildInfos_ f gpd = mkGpd + <$> (traverse . traverse . buildInfo_) f (condLibrary gpd) + <*> (traverse . _2 . traverse . buildInfo_) f (condExecutables gpd) + where + mkGpd lib exe = gpd + { condLibrary = lib + , condExecutables = exe + } + +hsSourceDirs_ :: Lens' BuildInfo [FilePath] +hsSourceDirs_ = lens hsSourceDirs $ \s a -> s { hsSourceDirs = a } diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 1d4a29a56bf..c4f488bf41c 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -401,8 +401,12 @@ configurePackage verbosity platform comp scriptOptions configFlags -- depending on the Cabal version we are talking to. configConstraints = [ thisPackageVersion srcid | ConfiguredId srcid (Just PkgDesc.CLibName) _uid <- CD.nonSetupDeps deps ], - configDependencies = [ (packageName srcid, uid) - | ConfiguredId srcid (Just PkgDesc.CLibName) uid <- CD.nonSetupDeps deps ], + configDependencies = [ (packageName srcid, lname, uid) + | ConfiguredId srcid cname uid <- CD.nonSetupDeps deps + , lname <- case cname of + Just (PkgDesc.CLibName) -> [Nothing] + Just (PkgDesc.CSubLibName sl) -> [Just sl] + _ -> [] ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, configVerbosity = toFlag verbosity, diff --git a/cabal-install/Distribution/Client/GenBounds.hs b/cabal-install/Distribution/Client/GenBounds.hs index 0f2727ad2fc..fa3c0b8dc90 100644 --- a/cabal-install/Distribution/Client/GenBounds.hs +++ b/cabal-install/Distribution/Client/GenBounds.hs @@ -36,7 +36,8 @@ import Distribution.PackageDescription.Parsec ( readGenericPackageDescription ) import Distribution.Types.ComponentRequestedSpec ( defaultComponentRequestedSpec ) -import Distribution.Types.Dependency +import Distribution.Types.LibDependency + ( libDepPackageName, libDepVersionRange ) import Distribution.Simple.Compiler ( Compiler, PackageDBStack, compilerInfo ) import Distribution.Simple.Program @@ -121,7 +122,7 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo case epd of Left _ -> putStrLn "finalizePD failed" Right (pd,_) -> do - let needBounds = filter (not . hasUpperBound . depVersion) $ + let needBounds = filter (not . hasUpperBound . libDepVersionRange) $ enabledBuildDepends pd defaultComponentRequestedSpec if (null needBounds) @@ -136,19 +137,13 @@ genBounds verbosity packageDBs repoCtxt comp platform progdb mSandboxPkgInfo putStrLn boundsNeededMsg - let isNeeded pkg = unPackageName (packageName pkg) - `elem` map depName needBounds + let isNeeded pkg = packageName pkg + `elem` map libDepPackageName needBounds let thePkgs = filter isNeeded pkgs let padTo = maximum $ map (length . unPackageName . packageName) pkgs traverse_ (putStrLn . (++",") . showBounds padTo) thePkgs - depName :: Dependency -> String - depName (Dependency pn _) = unPackageName pn - - depVersion :: Dependency -> VersionRange - depVersion (Dependency _ vr) = vr - -- | The message printed when some dependencies are found to be lacking proper -- PVP-mandated bounds. boundsNeededMsg :: String diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 880f6d6554d..6d8d09047ed 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -1241,9 +1241,12 @@ installReadyPackage platform cinfo configFlags configConstraints = [ thisPackageVersion srcid | ConfiguredId srcid (Just PackageDescription.CLibName) _ipid <- CD.nonSetupDeps deps ], - configDependencies = [ (packageName srcid, dep_ipid) - | ConfiguredId srcid (Just PackageDescription.CLibName) dep_ipid - <- CD.nonSetupDeps deps ], + configDependencies = [ (packageName srcid, lname, uid) + | ConfiguredId srcid cname uid <- CD.nonSetupDeps deps + , lname <- case cname of + Just (PackageDescription.CLibName) -> [Nothing] + Just (PackageDescription.CSubLibName sl) -> [Just sl] + _ -> [] ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, configBenchmarks = toFlag False, diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs index 5a72ce7a709..a9686d0c5fe 100644 --- a/cabal-install/Distribution/Client/List.hs +++ b/cabal-install/Distribution/Client/List.hs @@ -17,6 +17,8 @@ import Distribution.Package ( PackageName, Package(..), packageName , packageVersion, UnitId ) import Distribution.Types.Dependency +import Distribution.Types.LibDependency + ( LibDependency(..), libDependencyToDependency ) import Distribution.Types.UnqualComponentName import Distribution.ModuleName (ModuleName) import Distribution.License (License) @@ -231,7 +233,8 @@ info verbosity packageDBs repoCtxt comp progdb selectedInstalledPkgs = InstalledPackageIndex.lookupDependency installedPkgIndex - (Dependency name verConstraint) + -- Nothing is OK for now, list sublibs later + (LibDependency name Nothing verConstraint) selectedSourcePkgs = PackageIndex.lookupDependency sourcePkgIndex (Dependency name verConstraint) selectedSourcePkg' = latestWithPref pref selectedSourcePkgs @@ -468,9 +471,9 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer = -- NB: only for the PUBLIC library (concatMap getListOfExposedModules . maybeToList . Source.library) source, - dependencies = - combine (map (SourceDependency . simplifyDependency) - . Source.allBuildDepends) source + dependencies = combine + (map (SourceDependency . simplifyDependency . libDependencyToDependency) + . Source.allBuildDepends) source (map InstalledDependency . Installed.depends) installed, haddockHtml = fromMaybe "" . join . fmap (listToMaybe . Installed.haddockHTMLs) diff --git a/cabal-install/Distribution/Client/Outdated.hs b/cabal-install/Distribution/Client/Outdated.hs index 8ec0d63bea9..e6d2f3c5d27 100644 --- a/cabal-install/Distribution/Client/Outdated.hs +++ b/cabal-install/Distribution/Client/Outdated.hs @@ -40,6 +40,7 @@ import Distribution.Types.ComponentRequestedSpec (ComponentRequestedSpec(..)) import Distribution.Types.Dependency (Dependency(..), depPkgName, simplifyDependency) +import Distribution.Types.LibDependency (libDependencyToDependency) import Distribution.Verbosity (Verbosity, silent) import Distribution.Version (Version, LowerBound(..), UpperBound(..) @@ -151,10 +152,11 @@ depsFromPkgDesc verbosity comp platform = do case epd of Left _ -> die' verbosity "finalizePD failed" Right (pd, _) -> do + -- TODO: What about setup dependencies? let bd = allBuildDepends pd debug verbosity "Reading the list of dependencies from the package description" - return bd + return $ libDependencyToDependency <$> bd -- | Various knobs for customising the behaviour of 'listOutdated'. data ListOutdatedSettings = ListOutdatedSettings { diff --git a/cabal-install/Distribution/Client/PackageUtils.hs b/cabal-install/Distribution/Client/PackageUtils.hs index b1236fb38b1..b79c84181e7 100644 --- a/cabal-install/Distribution/Client/PackageUtils.hs +++ b/cabal-install/Distribution/Client/PackageUtils.hs @@ -15,26 +15,21 @@ module Distribution.Client.PackageUtils ( ) where import Distribution.Package - ( packageVersion, packageName ) + ( packageName ) import Distribution.Types.ComponentRequestedSpec ( ComponentRequestedSpec ) import Distribution.Types.Dependency -import Distribution.Types.UnqualComponentName +import Distribution.Types.LibDependency import Distribution.PackageDescription - ( PackageDescription(..), libName, enabledBuildDepends ) -import Distribution.Version - ( withinRange, isAnyVersion ) + ( PackageDescription(..), enabledBuildDepends ) --- | The list of dependencies that refer to external packages --- rather than internal package components. +-- | The list of dependencies that refer to external packages rather than +-- internal package components. -- +-- External deps should not be on a sub-lib, and internal deps should have a +-- compatable version range with the current package (or none at all), but Cabal +-- enforces these invariants so we need not worry about them. externalBuildDepends :: PackageDescription -> ComponentRequestedSpec -> [Dependency] -externalBuildDepends pkg spec = filter (not . internal) (enabledBuildDepends pkg spec) - where - -- True if this dependency is an internal one (depends on a library - -- defined in the same package). - internal (Dependency depName versionRange) = - (depName == packageName pkg && - packageVersion pkg `withinRange` versionRange) || - (Just (packageNameToUnqualComponentName depName) `elem` map libName (subLibraries pkg) && - isAnyVersion versionRange) +externalBuildDepends pkg spec = [ libDependencyToDependency dep + | dep <- enabledBuildDepends pkg spec + , libDepPackageName dep /= packageName pkg ] diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 1a51276dd8c..d231d76e810 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -3198,14 +3198,8 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) -- NB: This does NOT use InstallPlan.depends, which includes executable -- dependencies which should NOT be fed in here (also you don't have -- enough info anyway) - configDependencies = [ (case mb_cn of - -- Special case for internal libraries - Just (CSubLibName uqn) - | packageId elab == srcid - -> mkPackageName (unUnqualComponentName uqn) - _ -> packageName srcid, - cid) - | ConfiguredId srcid mb_cn cid <- elabLibDependencies elab ] + configDependencies = [ (packageName srcid, componentNameString =<< libname, cid) + | ConfiguredId srcid libname cid <- elabLibDependencies elab ] configConstraints = case elabPkgOrComp of ElabPackage _ -> diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index b3739057d1b..889f5a8a2e3 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -35,7 +35,7 @@ import qualified Distribution.Backpack as Backpack import Distribution.Package ( newSimpleUnitId, unsafeMkDefUnitId, ComponentId, PackageId, mkPackageName , PackageIdentifier(..), packageVersion, packageName ) -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.PackageDescription ( GenericPackageDescription(packageDescription) , PackageDescription(..), specVersion, buildType @@ -702,7 +702,7 @@ getExternalSetupMethod verbosity options pkg bt = do return (packageVersion pkg, Nothing, options') installedCabalVersion options' compiler progdb = do index <- maybeGetInstalledPackages options' compiler progdb - let cabalDep = Dependency (mkPackageName "Cabal") (useCabalVersion options') + let cabalDep = LibDependency (mkPackageName "Cabal") Nothing (useCabalVersion options') options'' = options' { usePackageIndex = Just index } case PackageIndex.lookupDependency index cabalDep of [] -> die' verbosity $ "The package '" ++ display (packageName pkg) diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 68820f4995a..36188477a8f 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -8,19 +8,21 @@ import qualified Distribution.Compat.Map.Strict as M import Data.Maybe import Data.Monoid as Mon import Data.Set as S +import Prelude hiding (pi) import Distribution.Compiler import Distribution.InstalledPackageInfo as IPI import Distribution.Package -- from Cabal import Distribution.Simple.BuildToolDepends -- from Cabal import Distribution.Simple.Utils (cabalVersion) -- from Cabal +import Distribution.Types.LibDependency -- from Cabal import Distribution.Types.ExeDependency -- from Cabal import Distribution.Types.PkgconfigDependency -- from Cabal import Distribution.Types.ComponentName -- from Cabal -import Distribution.Types.UnqualComponentName -- from Cabal import Distribution.Types.CondTree -- from Cabal import Distribution.Types.MungedPackageId -- from Cabal import Distribution.Types.MungedPackageName -- from Cabal +import Distribution.Types.UnqualComponentName -- from Cabal import Distribution.PackageDescription as PD -- from Cabal import Distribution.PackageDescription.Configuration as PDC import qualified Distribution.Simple.PackageIndex as SI @@ -161,19 +163,10 @@ convGPD os arch cinfo strfl solveExes pn let fds = flagInfo strfl flags - -- | We have to be careful to filter out dependencies on - -- internal libraries, since they don't refer to real packages - -- and thus cannot actually be solved over. We'll do this - -- by creating a set of package names which are "internal" - -- and dropping them as we convert. - - ipns = S.fromList $ [ unqualComponentNameToPackageName nm - | (nm, _) <- sub_libs ] - conv :: Mon.Monoid a => Component -> (a -> BuildInfo) -> DependencyReason PN -> - CondTree ConfVar [Dependency] a -> FlaggedDeps PN + CondTree ConfVar [LibDependency] a -> FlaggedDeps PN conv comp getInfo dr = - convCondTree M.empty dr pkg os arch cinfo pn fds comp getInfo ipns solveExes . + convCondTree M.empty dr pkg os arch cinfo pn fds comp getInfo solveExes . PDC.addBuildableCondition getInfo initDR = DependencyReason pn M.empty S.empty @@ -242,16 +235,6 @@ flagInfo (StrongFlags strfl) = weak m = WeakOrTrivial $ not (strfl || m) flagType m = if m then Manual else Automatic --- | Internal package names, which should not be interpreted as true --- dependencies. -type IPNs = Set PN - --- | Convenience function to delete a 'Dependency' if it's --- for a 'PN' that isn't actually real. -filterIPNs :: IPNs -> Dependency -> Maybe Dependency -filterIPNs ipns d@(Dependency pn _) - | S.notMember pn ipns = Just d - | otherwise = Nothing -- | Convert condition trees to flagged dependencies. Mutually -- recursive with 'convBranch'. See 'convBranch' for an explanation @@ -259,22 +242,26 @@ filterIPNs ipns d@(Dependency pn _) convCondTree :: Map FlagName Bool -> DependencyReason PN -> PackageDescription -> OS -> Arch -> CompilerInfo -> PN -> FlagInfo -> Component -> (a -> BuildInfo) -> - IPNs -> SolveExecutables -> - CondTree ConfVar [Dependency] a -> FlaggedDeps PN -convCondTree flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes@(SolveExecutables solveExes') (CondNode info ds branches) = + CondTree ConfVar [LibDependency] a -> FlaggedDeps PN +convCondTree flags dr pkg os arch cinfo pn fds comp getInfo solveExes@(SolveExecutables solveExes') (CondNode info ds branches) = -- Merge all library and build-tool dependencies at every level in -- the tree of flagged dependencies. Otherwise 'extractCommon' -- could create duplicate dependencies, and the number of -- duplicates could grow exponentially from the leaves to the root -- of the tree. mergeSimpleDeps $ - L.map (\d -> D.Simple (convLibDep dr d) comp) - (mapMaybe (filterIPNs ipns) ds) -- unconditional package dependencies + [ D.Simple (convLibDep dr d) comp + | d <- ds -- unconditional package dependencies + -- We have to be careful to filter out dependencies on + -- internal libraries, since they don't refer to real packages + -- and thus cannot actually be solved over. + , packageName pkg /= libDepPackageName d + ] ++ L.map (\e -> D.Simple (LDep dr (Ext e)) comp) (PD.allExtensions bi) -- unconditional extension dependencies ++ L.map (\l -> D.Simple (LDep dr (Lang l)) comp) (PD.allLanguages bi) -- unconditional language dependencies ++ L.map (\(PkgconfigDependency pkn vr) -> D.Simple (LDep dr (Pkg pkn vr)) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies - ++ concatMap (convBranch flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes) branches + ++ concatMap (convBranch flags dr pkg os arch cinfo pn fds comp getInfo solveExes) branches -- build-tools dependencies -- NB: Only include these dependencies if SolveExecutables -- is True. It might be false in the legacy solver @@ -390,14 +377,13 @@ convBranch :: Map FlagName Bool -> FlagInfo -> Component -> (a -> BuildInfo) - -> IPNs -> SolveExecutables - -> CondBranch ConfVar [Dependency] a + -> CondBranch ConfVar [LibDependency] a -> FlaggedDeps PN -convBranch flags dr pkg os arch cinfo pn fds comp getInfo ipns solveExes (CondBranch c' t' mf') = +convBranch flags dr pkg os arch cinfo pn fds comp getInfo solveExes (CondBranch c' t' mf') = go c' - (\flags' dr' -> convCondTree flags' dr' pkg os arch cinfo pn fds comp getInfo ipns solveExes t') - (\flags' dr' -> maybe [] (convCondTree flags' dr' pkg os arch cinfo pn fds comp getInfo ipns solveExes) mf') + (\flags' dr' -> convCondTree flags' dr' pkg os arch cinfo pn fds comp getInfo solveExes t') + (\flags' dr' -> maybe [] (convCondTree flags' dr' pkg os arch cinfo pn fds comp getInfo solveExes) mf') flags dr where go :: Condition ConfVar @@ -475,9 +461,12 @@ unionDRs :: DependencyReason pn -> DependencyReason pn -> DependencyReason pn unionDRs (DependencyReason pn' fs1 ss1) (DependencyReason _ fs2 ss2) = DependencyReason pn' (M.union fs1 fs2) (S.union ss1 ss2) +convDep :: DependencyReason PN -> Dependency -> LDep PN +convDep dr (Dependency pn vr) = LDep dr $ Dep Nothing pn (Constrained vr) + -- | Convert a Cabal dependency on a library to a solver-specific dependency. -convLibDep :: DependencyReason PN -> Dependency -> LDep PN -convLibDep dr (Dependency pn vr) = LDep dr $ Dep Nothing pn (Constrained vr) +convLibDep :: DependencyReason PN -> LibDependency -> LDep PN +convLibDep dr ldep = convDep dr $ libDependencyToDependency ldep -- | Convert a Cabal dependency on an executable (build-tools) to a solver-specific dependency. convExeDep :: DependencyReason PN -> ExeDependency -> LDep PN @@ -486,5 +475,5 @@ convExeDep dr (ExeDependency pn exe vr) = LDep dr $ Dep (Just exe) pn (Constrain -- | Convert setup dependencies convSetupBuildInfo :: PN -> SetupBuildInfo -> FlaggedDeps PN convSetupBuildInfo pn nfo = - L.map (\d -> D.Simple (convLibDep (DependencyReason pn M.empty S.empty) d) ComponentSetup) + L.map (\d -> D.Simple (convDep (DependencyReason pn M.empty S.empty) d) ComponentSetup) (PD.setupDepends nfo) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 85dba049081..5543023a968 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -50,7 +50,8 @@ import Distribution.License (License(..)) import qualified Distribution.ModuleName as Module import qualified Distribution.Package as C hiding (HasUnitId(..)) -import qualified Distribution.Types.ExeDependency as C +import qualified Distribution.Types.ExeDependency as C +import qualified Distribution.Types.LibDependency as C import qualified Distribution.Types.LegacyExeDependency as C import qualified Distribution.Types.PkgconfigDependency as C import qualified Distribution.Types.UnqualComponentName as C @@ -304,9 +305,9 @@ exInst pn v hash deps = ExInst pn v hash (map exInstHash deps) -- these packages. type ExampleDb = [Either ExampleInstalled ExampleAvailable] -type DependencyTree a = C.CondTree C.ConfVar [C.Dependency] a +type DependencyTree a = C.CondTree C.ConfVar [C.LibDependency] a -type DependencyComponent a = C.CondBranch C.ConfVar [C.Dependency] a +type DependencyComponent a = C.CondBranch C.ConfVar [C.LibDependency] a exDbPkgs :: ExampleDb -> [ExamplePkgName] exDbPkgs = map (either exInstName exAvName) @@ -515,8 +516,11 @@ exAvSrcPkg ex = , C.condTreeComponents = map mkFlagged flaggedDeps } - mkDirect :: (ExamplePkgName, C.VersionRange) -> C.Dependency - mkDirect (dep, vr) = C.Dependency (C.mkPackageName dep) vr + mkDirectSetup :: (ExamplePkgName, C.VersionRange) -> C.Dependency + mkDirectSetup (dep, vr) = C.Dependency (C.mkPackageName dep) vr + + mkDirect :: (ExamplePkgName, C.VersionRange) -> C.LibDependency + mkDirect (dep, vr) = C.LibDependency (C.mkPackageName dep) Nothing vr mkFlagged :: (ExampleFlagName, Dependencies, Dependencies) -> DependencyComponent C.BuildInfo @@ -527,7 +531,7 @@ exAvSrcPkg ex = -- Split a set of dependencies into direct dependencies and flagged -- dependencies. A direct dependency is a tuple of the name of package and - -- its version range meant to be converted to a 'C.Dependency' with + -- its version range meant to be converted to a 'C.LibDependency' with -- 'mkDirect' for example. A flagged dependency is the set of dependencies -- guarded by a flag. splitDeps :: [ExampleDependency] @@ -553,7 +557,7 @@ exAvSrcPkg ex = -- custom-setup only supports simple dependencies mkSetupDeps :: [ExampleDependency] -> [C.Dependency] mkSetupDeps deps = - let (directDeps, []) = splitDeps deps in map mkDirect directDeps + let (directDeps, []) = splitDeps deps in map mkDirectSetup directDeps mkSimpleVersion :: ExamplePkgVersion -> C.Version mkSimpleVersion n = C.mkVersion [n, 0, 0] 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 483f21ad6d6..1d4a42f6f3c 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/BuildDeps/DepCycle/DepCycle.cabal b/cabal-testsuite/PackageTests/BuildDeps/DepCycle/DepCycle.cabal index 22ba92a4d2e..201b30572a5 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/DepCycle/DepCycle.cabal +++ b/cabal-testsuite/PackageTests/BuildDeps/DepCycle/DepCycle.cabal @@ -4,9 +4,9 @@ build-type: Simple cabal-version: >= 1.10 library foo - build-depends: bar + build-depends: DepCycle:bar default-language: Haskell2010 library bar - build-depends: foo + build-depends: DepCycle:foo default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs b/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs index b3eee723add..35ec93de39d 100644 --- a/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs +++ b/cabal-testsuite/PackageTests/CaretOperator/setup.test.hs @@ -4,7 +4,7 @@ import Control.Monad import Distribution.Version import Distribution.Simple.LocalBuildInfo import Distribution.Package -import Distribution.Types.Dependency +import Distribution.Types.LibDependency import Distribution.PackageDescription import Language.Haskell.Extension (Language(..)) @@ -22,7 +22,7 @@ main = setupTest $ do let Just gotLib = library (localPkgDescr lbi) bi = libBuildInfo gotLib assertEqual "defaultLanguage" (Just Haskell2010) (defaultLanguage bi) - forM_ (targetBuildDepends bi) $ \(Dependency pn vr) -> + forM_ (targetBuildDepends bi) $ \(LibDependency pn _ vr) -> when (pn == mkPackageName "pretty") $ assertEqual "targetBuildDepends/pretty" vr (majorBoundVersion (mkVersion [1,1,1,0])) diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/Lib.cabal b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/Lib.cabal index 85f5d879a9d..6f03ac60bb7 100644 --- a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/Lib.cabal +++ b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/Lib.cabal @@ -13,6 +13,6 @@ library sublib executable exe main-is: Exe.hs - build-depends: base, sublib + build-depends: base, Lib:sublib hs-source-dirs: exe default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs index 2afa4025caf..49d59c69df0 100644 --- a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs +++ b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs @@ -5,6 +5,6 @@ main = setupTest $ do base_id <- getIPID "base" setup_install ["sublib", "--cid", "sublib-0.1-abc"] setup_install [ "exe", "--exact-configuration" - , "--dependency", "sublib=sublib-0.1-abc" + , "--dependency", "Lib:sublib=sublib-0.1-abc" , "--dependency", "base=" ++ base_id ] runExe' "exe" [] >>= assertOutputContains "OK" 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 From aa5a4fae9c8e716e0c9b328702295a630c55edad Mon Sep 17 00:00:00 2001 From: John Ericson Date: Fri, 17 Mar 2017 20:50:51 -0400 Subject: [PATCH 3/4] Update tests In a number of cases the build process is now interleved differently, but this seems harmless. It's probably just the new lib-dep identifiers causing a different (valid) topological sort to be used. --- .../ConfigureComponent/SubLib/setup-explicit-fail.out | 2 +- cabal-testsuite/PackageTests/InternalLibraries/cabal.out | 8 ++++---- .../PackageTests/InternalLibraries/sandbox-shadow.out | 6 +++--- .../PackageTests/InternalLibraries/sandbox.out | 6 +++--- .../InternalLibraries/setup-gen-pkg-config.cabal.out | 6 +++--- .../InternalLibraries/setup-gen-pkg-config.out | 6 +++--- .../InternalLibraries/setup-gen-script.cabal.out | 6 +++--- .../PackageTests/InternalLibraries/setup-gen-script.out | 6 +++--- .../PackageTests/InternalLibraries/setup.cabal.out | 6 +++--- cabal-testsuite/PackageTests/InternalLibraries/setup.out | 6 +++--- 10 files changed, 29 insertions(+), 29 deletions(-) diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out index f5ef78b9875..d8a310afbad 100644 --- a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out +++ b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out @@ -10,4 +10,4 @@ Registering library 'sublib' for Lib-0.1.0.0.. # Setup configure Configuring executable 'exe' for Lib-0.1.0.0.. setup: Encountered missing dependencies: - sublib -any + Lib:sublib -any diff --git a/cabal-testsuite/PackageTests/InternalLibraries/cabal.out b/cabal-testsuite/PackageTests/InternalLibraries/cabal.out index 088ce80de16..cf138d6014e 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/cabal.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/cabal.out @@ -3,14 +3,14 @@ Resolving dependencies... Build profile: -w ghc- -O1 In order, the following will be built: - p-0.1.0.0 (lib:q) (first run) - - p-0.1.0.0 (exe:foo) (first run) - p-0.1.0.0 (lib) (first run) + - p-0.1.0.0 (exe:foo) (first run) Configuring library 'q' for p-0.1.0.0.. Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Configuring executable 'foo' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Configuring library for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Configuring executable 'foo' for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out b/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out index 8542120cc3f..7346634cafc 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/sandbox-shadow.out @@ -8,11 +8,11 @@ Resolving dependencies... Configuring p-0.1.0.0... Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. Installing internal library q in -Installing executable foo in Installing library in +Installing executable foo in Installed p-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out b/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out index d3a1e071feb..162edda0440 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/sandbox.out @@ -7,11 +7,11 @@ Resolving dependencies... Configuring p-0.1.0.0... Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. Installing internal library q in -Installing executable foo in Installing library in +Installing executable foo in Installed p-0.1.0.0 diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.cabal.out b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.cabal.out index eb872a3a8c1..36f94a67ceb 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.cabal.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.cabal.out @@ -4,15 +4,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup-gen-pkg-config.cabal.dist/usr/bin is not in the system search path. -Installing library in # Setup register # Setup configure Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.out b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.out index c0fd0070a6b..2a970a35b57 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-pkg-config.out @@ -3,15 +3,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup-gen-pkg-config.dist/usr/bin is not in the system search path. -Installing library in # Setup register # Setup configure Configuring r-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.cabal.out b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.cabal.out index fdaf3951fce..058e4eed4ef 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.cabal.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.cabal.out @@ -4,15 +4,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup-gen-script.cabal.dist/usr/bin is not in the system search path. -Installing library in # Setup register # Setup configure Resolving dependencies... diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.out b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.out index d694c339d63..44dc5172b0a 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup-gen-script.out @@ -3,15 +3,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup-gen-script.dist/usr/bin is not in the system search path. -Installing library in # Setup register # Setup configure Configuring r-0.1.0.0... diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup.cabal.out b/cabal-testsuite/PackageTests/InternalLibraries/setup.cabal.out index 79da69f77df..c2c383a434a 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup.cabal.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup.cabal.out @@ -14,15 +14,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup.cabal.dist/usr/bin is not in the system search path. -Installing library in # Setup register Registering library 'q' for p-0.1.0.0.. Registering library for p-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/InternalLibraries/setup.out b/cabal-testsuite/PackageTests/InternalLibraries/setup.out index fa3c5969afd..baabb771255 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/setup.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/setup.out @@ -12,15 +12,15 @@ Configuring p-0.1.0.0... # Setup build Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. -Preprocessing executable 'foo' for p-0.1.0.0.. -Building executable 'foo' for p-0.1.0.0.. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. +Preprocessing executable 'foo' for p-0.1.0.0.. +Building executable 'foo' for p-0.1.0.0.. # Setup copy Installing internal library q in +Installing library in Installing executable foo in Warning: The directory /setup.dist/usr/bin is not in the system search path. -Installing library in # Setup register Registering library 'q' for p-0.1.0.0.. Registering library for p-0.1.0.0.. From 3c2e70ebba09514ef0256d1777645fc3b4347cc4 Mon Sep 17 00:00:00 2001 From: John Ericson Date: Fri, 17 Mar 2017 20:50:51 -0400 Subject: [PATCH 4/4] Allow more erroneous warnings for now. Eventually, configuring will be rewritten so extra constraints do note pollute the checks. When that happens this commit should be reverted. --- .../PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out | 2 +- .../PackageTests/BuildDeps/InternalLibrary0/setup.out | 2 +- .../ConfigureComponent/SubLib/setup-explicit.out | 1 + cabal-testsuite/PackageTests/InternalLibraries/cabal.out | 2 ++ .../InternalVersions/BuildDependsBad/setup.cabal.out | 6 ------ 5 files changed, 5 insertions(+), 8 deletions(-) diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out index 28e5610ef52..f87f365099f 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out @@ -1,4 +1,4 @@ # Setup configure Resolving dependencies... Configuring InternalLibrary0-0.1... -cabal: The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. +cabal: The field 'build-depends: InternalLibrary0 -any' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out index 4f3af5cb828..32c363951b1 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out @@ -1,3 +1,3 @@ # Setup configure Configuring InternalLibrary0-0.1... -setup: The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. +setup: The field 'build-depends: InternalLibrary0 -any' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.out b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.out index 3d7efb0f2cc..0d601bab747 100644 --- a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.out +++ b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.out @@ -9,6 +9,7 @@ Installing internal library sublib in Registering library 'sublib' for Lib-0.1.0.0.. # Setup configure Configuring executable 'exe' for Lib-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: Lib:sublib -any && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. # Setup build Preprocessing executable 'exe' for Lib-0.1.0.0.. Building executable 'exe' for Lib-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/InternalLibraries/cabal.out b/cabal-testsuite/PackageTests/InternalLibraries/cabal.out index cf138d6014e..7e45d3d5e21 100644 --- a/cabal-testsuite/PackageTests/InternalLibraries/cabal.out +++ b/cabal-testsuite/PackageTests/InternalLibraries/cabal.out @@ -9,8 +9,10 @@ Configuring library 'q' for p-0.1.0.0.. Preprocessing library 'q' for p-0.1.0.0.. Building library 'q' for p-0.1.0.0.. Configuring library for p-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: p:q -any && ==0.1.0.0, p -any && -any && ==0.1.0.0, p:q -any && -any && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing library for p-0.1.0.0.. Building library for p-0.1.0.0.. Configuring executable 'foo' for p-0.1.0.0.. +Warning: The package has an extraneous version range for a dependency on an internal library: p:q -any && ==0.1.0.0 && ==0.1.0.0, p -any && -any && ==0.1.0.0 && ==0.1.0.0, p:q -any && -any && ==0.1.0.0 && ==0.1.0.0. This version range includes the current package but isn't needed as the current package's library will always be used. Preprocessing executable 'foo' for p-0.1.0.0.. Building executable 'foo' for p-0.1.0.0.. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out index 815f6399b4a..fd5f048c2cc 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out @@ -1,10 +1,4 @@ # Setup configure Resolving dependencies... -Warning: solver failed to find a solution: -Could not resolve dependencies: -[__0] next goal: build-depends-bad-version (user goal) -[__0] rejecting: build-depends-bad-version-0.1.0.0 (conflict: build-depends-bad-version==0.1.0.0, build-depends-bad-version => build-depends-bad-version>=2) -After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: build-depends-bad-version (2) -Trying configure anyway. Configuring build-depends-bad-version-0.1.0.0... cabal: The package has an impossible version range for a dependency on an internal library: build-depends-bad-version >=2. This version range does not include the current package, and must be removed as the current package's library will always be used.