diff --git a/Cabal/Distribution/PackageDescription/Check.hs b/Cabal/Distribution/PackageDescription/Check.hs index 367cec61066..210533625c4 100644 --- a/Cabal/Distribution/PackageDescription/Check.hs +++ b/Cabal/Distribution/PackageDescription/Check.hs @@ -635,7 +635,7 @@ checkFields pkg = depMissingInternalExecutable = [ dep - | dep@(ExeDependency _ eName _) <- internalExeDeps + | dep@(ExeDependency _ (Just eName) _) <- internalExeDeps , not $ eName `elem` internalExecutables ] diff --git a/Cabal/Distribution/Parsec/Class.hs b/Cabal/Distribution/Parsec/Class.hs index c665c82226d..e0ec99aece5 100644 --- a/Cabal/Distribution/Parsec/Class.hs +++ b/Cabal/Distribution/Parsec/Class.hs @@ -141,7 +141,7 @@ instance Parsec ExeDependency where parsec = do name <- lexemeParsec _ <- P.char ':' - exe <- lexemeParsec + exe <- (Just <$> lexemeParsec) <|> (P.char '*' >> pure Nothing) ver <- parsec <|> pure anyVersion return (ExeDependency name exe ver) diff --git a/Cabal/Distribution/Simple/BuildToolDepends.hs b/Cabal/Distribution/Simple/BuildToolDepends.hs index 846089144d2..4b4a8a136c1 100644 --- a/Cabal/Distribution/Simple/BuildToolDepends.hs +++ b/Cabal/Distribution/Simple/BuildToolDepends.hs @@ -34,7 +34,7 @@ desugarBuildTool :: PackageDescription -> Maybe ExeDependency desugarBuildTool pkg led = if foundLocal - then Just $ ExeDependency (packageName pkg) toolName reqVer + then Just $ ExeDependency (packageName pkg) (Just toolName) reqVer else Map.lookup name whiteMap where LegacyExeDependency name reqVer = led @@ -44,7 +44,7 @@ desugarBuildTool pkg led = , "cpphs", "greencard", "hspec-discover" ] whiteMap = Map.fromList $ flip map whitelist $ \n -> - (n, ExeDependency (mkPackageName n) (mkUnqualComponentName n) reqVer) + (n, ExeDependency (mkPackageName n) (Just $ mkUnqualComponentName n) reqVer) -- | Get everything from "build-tool-depends", along with entries from -- "build-tools" that we know how to desugar. @@ -84,13 +84,20 @@ isInternal pkg (ExeDependency n _ _) = n == packageName pkg -- | Get internal "build-tool-depends", along with internal "build-tools" -- --- This is a tiny function, but used in a number of places. The same --- restrictions that apply to `isInternal` also apply to this function. +-- Besides filtering to just internal deps, this also desugars wildcard deps +-- since we know the same version/configuration of the package will be used to +-- install them, and thus we know the precise set of executables that wildcard +-- expands to. +-- +-- The same restrictions that apply to `isInternal` also apply to this function. getAllInternalToolDependencies :: PackageDescription -> BuildInfo -> [UnqualComponentName] getAllInternalToolDependencies pkg bi = [ toolname - | dep@(ExeDependency _ toolname _) <- getAllToolDependencies pkg bi + | dep@(ExeDependency _ optToolname _) <- getAllToolDependencies pkg bi , isInternal pkg dep + , toolname <- case optToolname of + Just tn -> pure tn + Nothing -> exeName <$> executables pkg ] diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 74c2891e37d..6dce0e32027 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -571,6 +571,9 @@ configure (pkg_descr0', pbi) cfg = do ++ intercalate "," unsupportedFLibs -- Configure certain external build tools, see below for which ones. + -- + -- TODO: HACK we're currently ignoring wildcard deps as we don't know + -- precisely which executables the resolved package will contain. let requiredBuildTools = do bi <- enabledBuildInfos pkg_descr enabled -- First, we collect any tool dep that we know is external. This is, @@ -581,7 +584,7 @@ configure (pkg_descr0', pbi) cfg = do -- 2. `build-tool-depends` that aren't from the current package. let externBuildToolDeps = [ LegacyExeDependency (unUnqualComponentName eName) versionRange - | buildTool@(ExeDependency _ eName versionRange) + | buildTool@(ExeDependency _ (Just eName) versionRange) <- getAllToolDependencies pkg_descr bi , not $ isInternal pkg_descr buildTool ] -- Second, we collect any build-tools entry we don't know how to diff --git a/Cabal/Distribution/Types/ExeDependency.hs b/Cabal/Distribution/Types/ExeDependency.hs index e7d28fc2ef8..d70348a5912 100644 --- a/Cabal/Distribution/Types/ExeDependency.hs +++ b/Cabal/Distribution/Types/ExeDependency.hs @@ -23,7 +23,9 @@ import Text.PrettyPrint ((<+>), text) -- data ExeDependency = ExeDependency PackageName - UnqualComponentName -- name of executable component of package + -- Name of specific executable component of package, or + -- nothing for a wilcard dependency on them all + (Maybe UnqualComponentName) VersionRange deriving (Generic, Read, Show, Eq, Typeable, Data) @@ -32,15 +34,18 @@ instance NFData ExeDependency where rnf = genericRnf instance Text ExeDependency where disp (ExeDependency name exe ver) = - (disp name <<>> text ":" <<>> disp exe) <+> disp ver + (disp name <<>> text ":" <<>> exe') <+> disp ver + where exe' = case exe of + Just e -> disp e + Nothing -> text "*" parse = do name <- parse _ <- Parse.char ':' - exe <- parse + exe <- (Just <$> parse) <++ (Parse.char '*' >> pure Nothing) Parse.skipSpaces ver <- parse <++ return anyVersion Parse.skipSpaces return (ExeDependency name exe ver) -qualifiedExeName :: ExeDependency -> ComponentName -qualifiedExeName (ExeDependency _ ucn _) = CExeName ucn +qualifiedExeName :: ExeDependency -> Maybe ComponentName +qualifiedExeName (ExeDependency _ ucn _) = CExeName <$> ucn diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 31580d908a5..c8ed60ba278 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -54,7 +54,7 @@ module Distribution.Client.ProjectPlanning ( import Prelude () import Distribution.Client.Compat.Prelude -import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.ProjectPlanning.Types as Ty import Distribution.Client.PackageHash import Distribution.Client.RebuildMonad import Distribution.Client.ProjectConfig @@ -95,12 +95,14 @@ import Distribution.ModuleName import Distribution.Package hiding (InstalledPackageId, installedPackageId) import Distribution.Types.Dependency +import Distribution.Types.ExeDependency import Distribution.Types.PkgconfigDependency import Distribution.Types.UnqualComponentName import Distribution.System import qualified Distribution.PackageDescription as Cabal import qualified Distribution.PackageDescription as PD import qualified Distribution.PackageDescription.Configuration as PD +import Distribution.Simple.BuildToolDepends import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.Simple.Compiler hiding (Flag) import qualified Distribution.Simple.GHC as GHC --TODO: [code cleanup] eliminate @@ -1011,7 +1013,7 @@ planPackages comp platform solver SolverSettings{..} -- former we just apply all these flags to all local targets which -- is silly. We should check if the flags are appropriate. [ LabeledPackageConstraint - (PackageConstraint (scopeToplevel pkgname) + (PackageConstraint (scopeToplevel pkgname) (PackagePropertyFlags flags)) ConstraintSourceConfigFlagOrTarget | let flags = solverSettingFlagAssignment @@ -1270,12 +1272,42 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB compLibDependencies = -- concatMap (elaborateLibSolverId mapDep) external_lib_dep_sids ordNub (map (\ci -> ConfiguredId (ci_pkgid ci) (ci_id ci)) (cc_includes cc)) + + filterExeMapDep :: SolverId -> [ElaboratedPlanPackage] + filterExeMapDep = filter go . mapDep + where + toolDeps = getAllToolDependencies pd $ Cabal.componentBuildInfo comp + exeKV :: [(PackageName, Maybe (Set UnqualComponentName))] + exeKV = map go' toolDeps where + go' (ExeDependency p n _) = (p, Set.singleton <$> n) + + -- Nothing means wildcard, the complete subset + exeMap :: Map PackageName (Maybe (Set UnqualComponentName)) + exeMap = Map.fromListWith mappend exeKV + + go (InstallPlan.Installed _) = error "unexpected state" + go (InstallPlan.PreExisting _) = True + go (InstallPlan.Configured (ElaboratedConfiguredPackage { + elabPkgSourceId = PackageIdentifier { pkgName, .. }, + elabPkgOrComp, + .. + })) = case elabPkgOrComp of + ElabPackage _ -> True + ElabComponent comp' -> + case Ty.compSolverName comp' of + CD.ComponentExe n + | Just maybeSet <- Map.lookup pkgName exeMap + -> case maybeSet of + Nothing -> True -- Wildcard, accept anything + Just set -> Set.member n set + _ -> error "unexpected state" + compExeDependencies = map confInstId - (concatMap (elaborateExeSolverId mapDep) external_exe_dep_sids) ++ + (concatMap (elaborateExeSolverId filterExeMapDep) external_exe_dep_sids) ++ cc_internal_build_tools cc compExeDependencyPaths = - concatMap (elaborateExePath mapDep) external_exe_dep_sids ++ + concatMap (elaborateExePath filterExeMapDep) external_exe_dep_sids ++ [ path | cid' <- cc_internal_build_tools cc , Just path <- [Map.lookup cid' exe_map]] @@ -2985,4 +3017,3 @@ improveInstallPlanWithInstalledPackages installedPkgIdSet = --TODO: decide what to do if we encounter broken installed packages, -- since overwriting is never safe. -