From c0a4860202393882d2fd0f4de253c3af3a092fe2 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 19 Aug 2016 23:08:18 -0700 Subject: [PATCH] Solve for, build, and add to path build-tools dependencies. This fixes #220: new-build now builds, installs and adds executables to PATH automatically if they show up in 'build-tools'. However, there is still more that could be done: the new behavior only applies to a specific list of 'build-tools' (alex, happy, etc) which Cabal recognizes out of the box. The plan is to introduce a new 'tool-depends' field to allow dependencies on other executables as well. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Simple/Configure.hs | 4 +- .../Distribution/Client/Dependency.hs | 3 +- .../Distribution/Client/InstallPlan.hs | 8 +- .../Distribution/Client/ProjectPlanning.hs | 101 ++++++++++++++---- .../Client/ProjectPlanning/Types.hs | 23 +++- .../Distribution/Client/SolverInstallPlan.hs | 14 +-- .../Distribution/Solver/Modular/Assignment.hs | 4 +- .../Distribution/Solver/Modular/Builder.hs | 8 +- .../Solver/Modular/ConfiguredConversion.hs | 46 +++++--- .../Distribution/Solver/Modular/Dependency.hs | 35 +++--- .../Distribution/Solver/Modular/Index.hs | 2 +- .../Solver/Modular/IndexConversion.hs | 94 ++++++++-------- .../Distribution/Solver/Modular/Linking.hs | 2 +- .../Distribution/Solver/Modular/Package.hs | 9 +- .../Distribution/Solver/Modular/Validate.hs | 3 +- .../Solver/Types/InstSolverPackage.hs | 28 +++++ .../Distribution/Solver/Types/PackagePath.hs | 13 +++ .../Solver/Types/ResolverPackage.hs | 26 +++-- .../Solver/Types/SolverPackage.hs | 3 +- cabal-install/cabal-install.cabal | 7 ++ .../new-build/external_build_tools.sh | 3 + .../external_build_tools/cabal.project | 1 + .../external_build_tools/client/Hello.hs | 8 ++ .../external_build_tools/client/client.cabal | 13 +++ .../happy/MyCustomPreprocessor.hs | 11 ++ .../external_build_tools/happy/happy.cabal | 12 +++ .../Distribution/Solver/Modular/DSL.hs | 45 ++++++-- .../Distribution/Solver/Modular/Solver.hs | 51 +++++++++ 28 files changed, 436 insertions(+), 141 deletions(-) create mode 100644 cabal-install/Distribution/Solver/Types/InstSolverPackage.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 7946ca556a4..d65fd778196 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1393,7 +1393,9 @@ configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency configureRequiredProgram verbosity conf (Dependency (PackageName progName) verRange) = case lookupKnownProgram progName conf of - Nothing -> die ("Unknown build tool " ++ progName) + Nothing -> + -- Try to configure it as a 'simpleProgram' automatically + configureProgram verbosity (simpleProgram progName) conf Just prog -- requireProgramVersion always requires the program have a version -- but if the user says "build-depends: foo" ie no version constraint diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index c577991d564..92e322905fb 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -768,7 +768,7 @@ showPackageProblem (InvalidDep dep pkgid) = configuredPackageProblems :: Platform -> CompilerInfo -> SolverPackage UnresolvedPkgLoc -> [PackageProblem] configuredPackageProblems platform cinfo - (SolverPackage pkg specifiedFlags stanzas specifiedDeps') = + (SolverPackage pkg specifiedFlags stanzas specifiedDeps' _specifiedExeDeps') = [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ] ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] ++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ] @@ -779,6 +779,7 @@ configuredPackageProblems platform cinfo ++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ] ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps , not (packageSatisfiesDependency pkgid dep) ] + -- TODO: sanity tests on executable deps where specifiedDeps :: ComponentDeps [PackageId] specifiedDeps = fmap (map solverSrcId) specifiedDeps' diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index fbc923265d5..66167b1c641 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -79,6 +79,7 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan) import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId +import Distribution.Solver.Types.InstSolverPackage -- TODO: Need this when we compute final UnitIds -- import qualified Distribution.Simple.Configure as Configure @@ -415,8 +416,8 @@ configureInstallPlan :: SolverInstallPlan -> InstallPlan configureInstallPlan solverPlan = flip fromSolverInstallPlan solverPlan $ \mapDep planpkg -> [case planpkg of - SolverInstallPlan.PreExisting pkg _ -> - PreExisting pkg + SolverInstallPlan.PreExisting pkg -> + PreExisting (instSolverPkgIPI pkg) SolverInstallPlan.Configured pkg -> Configured (configureSolverPackage mapDep pkg) @@ -438,9 +439,10 @@ configureInstallPlan solverPlan = confPkgFlags = solverPkgFlags spkg, confPkgStanzas = solverPkgStanzas spkg, confPkgDeps = deps + -- NB: no support for executable dependencies } where - deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgDeps spkg) + deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgLibDeps spkg) -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 35383209033..c3faba0bb71 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -79,6 +79,7 @@ import Distribution.Solver.Types.PkgConfigDb import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SourcePackage import Distribution.Package hiding @@ -1040,8 +1041,8 @@ elaborateInstallPlan platform compiler compilerprogdb elaboratedInstallPlan = flip InstallPlan.fromSolverInstallPlan solverPlan $ \mapDep planpkg -> case planpkg of - SolverInstallPlan.PreExisting pkg _ -> - [InstallPlan.PreExisting pkg] + SolverInstallPlan.PreExisting pkg -> + [InstallPlan.PreExisting (instSolverPkgIPI pkg)] SolverInstallPlan.Configured pkg -> -- SolverPackage @@ -1073,7 +1074,7 @@ elaborateInstallPlan platform compiler compilerprogdb :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc -> [ElaboratedConfiguredPackage] - elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0) + elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0) = snd (mapAccumL buildComponent (Map.empty, Map.empty) comps_graph) where elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep spkg @@ -1121,19 +1122,28 @@ elaborateInstallPlan platform compiler compilerprogdb compComponentName = Just cname compSolverName = CD.componentNameToComponent cname compLibDependencies = - concatMap (elaborateSolverId mapDep) + concatMap (elaborateLibSolverId mapDep) (CD.select (== compSolverName) deps0) ++ internal_lib_deps + compExeDependencies = + (map confInstId $ + concatMap (elaborateExeSolverId mapDep) + (CD.select (== compSolverName) exe_deps0)) ++ + internal_exe_deps + compExeDependencyPaths = + concatMap (elaborateExePath mapDep) + (CD.select (== compSolverName) exe_deps0) ++ + internal_exe_paths bi = Cabal.componentBuildInfo comp confid = ConfiguredId elabPkgSourceId cid - compSetupDependencies = concatMap (elaborateSolverId mapDep) (CD.setupDeps deps0) + compSetupDependencies = concatMap (elaborateLibSolverId mapDep) (CD.setupDeps deps0) internal_lib_deps = [ confid' | Dependency pkgname _ <- PD.targetBuildDepends bi , Just confid' <- [Map.lookup pkgname internal_map] ] - (compExeDependencies, compExeDependencyPaths) + (internal_exe_deps, internal_exe_paths) = unzip $ [ (confInstId confid', path) | Dependency (PackageName toolname) _ <- PD.buildTools bi @@ -1190,22 +1200,56 @@ elaborateInstallPlan platform compiler compilerprogdb (compilerId compiler) cid - elaborateSolverId :: (SolverId -> [ElaboratedPlanPackage]) + elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage]) -> SolverId -> [ConfiguredId] - elaborateSolverId mapDep = map configuredId . filter is_lib . mapDep + elaborateLibSolverId mapDep = map configuredId . filter is_lib . mapDep where is_lib (InstallPlan.PreExisting _) = True is_lib (InstallPlan.Configured elab) = case elabPkgOrComp elab of ElabPackage _ -> True ElabComponent comp -> compSolverName comp == CD.ComponentLib + elaborateExeSolverId :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverId -> [ConfiguredId] + elaborateExeSolverId mapDep = map configuredId . filter is_exe . mapDep + where is_exe (InstallPlan.PreExisting _) = False + is_exe (InstallPlan.Configured elab) = + case elabPkgOrComp elab of + ElabPackage _ -> True + ElabComponent comp -> + case compSolverName comp of + CD.ComponentExe _ -> True + _ -> False + + elaborateExePath :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverId -> [FilePath] + elaborateExePath mapDep = concatMap get_exe_path . mapDep + where + -- Pre-existing executables are assumed to be in PATH + -- already. In fact, this should be impossible. + -- Modest duplication with 'inplace_bin_dir' + get_exe_path (InstallPlan.PreExisting _) = [] + get_exe_path (InstallPlan.Configured elab) = + [if elabBuildStyle elab == BuildInplaceOnly + then distBuildDirectory + (elabDistDirParams elaboratedSharedConfig elab) + "build" + case elabPkgOrComp elab of + ElabPackage _ -> "" + ElabComponent comp -> + case fmap Cabal.componentNameString + (compComponentName comp) of + Just (Just n) -> n + _ -> "" + else InstallDirs.bindir (elabInstallDirs elab)] + elaborateSolverToPackage :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage elaborateSolverToPackage mapDep pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride) - _flags _stanzas deps0) = + _flags _stanzas deps0 exe_deps0) = -- Knot tying: the final elab includes the -- pkgInstalledId, which is calculated by hashing many -- of the other fields of the elaboratedPackage. @@ -1219,7 +1263,7 @@ elaborateInstallPlan platform compiler compilerprogdb elabPkgOrComp = ElabPackage $ ElaboratedPackage {..} } - deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0 requires_reg = PD.hasPublicLib elabPkgDescription pkgInstalledId @@ -1238,6 +1282,8 @@ elaborateInstallPlan platform compiler compilerprogdb ++ " is missing a source hash: " ++ display pkgid pkgLibDependencies = deps + pkgExeDependencies = fmap (concatMap (elaborateExeSolverId mapDep)) exe_deps0 + pkgExeDependencyPaths = fmap (concatMap (elaborateExePath mapDep)) exe_deps0 -- Filled in later pkgStanzasEnabled = Set.empty @@ -1269,7 +1315,7 @@ elaborateInstallPlan platform compiler compilerprogdb -> ElaboratedConfiguredPackage elaborateSolverToCommon mapDep pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) - flags stanzas deps0) = + flags stanzas deps0 _exe_deps0) = elaboratedPackage where elaboratedPackage = ElaboratedConfiguredPackage {..} @@ -1332,7 +1378,7 @@ elaborateInstallPlan platform compiler compilerprogdb elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription -- Computing the deps here is a little awful - deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0 elabSetupScriptCliVersion = packageSetupScriptSpecVersion elabSetupScriptStyle elabPkgDescription deps elabSetupPackageDBStack = buildAndRegisterDbs @@ -1838,7 +1884,8 @@ pruneInstallPlanPass2 pkgs = setStanzasDepsAndTargets elab = elab { elabBuildTargets = elabBuildTargets elab - ++ targetsRequiredForRevDeps, + ++ libTargetsRequiredForRevDeps + ++ exeTargetsRequiredForRevDeps, elabPkgOrComp = case elabPkgOrComp elab of ElabPackage pkg -> @@ -1849,15 +1896,24 @@ pruneInstallPlanPass2 pkgs = keepNeeded _ _ = True in ElabPackage $ pkg { pkgStanzasEnabled = stanzas, - pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg) + pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg), + pkgExeDependencies = CD.filterDeps keepNeeded (pkgExeDependencies pkg), + pkgExeDependencyPaths = CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg) } r@(ElabComponent _) -> r } where - targetsRequiredForRevDeps = + libTargetsRequiredForRevDeps = [ ComponentTarget Cabal.defaultLibName WholeComponent | installedUnitId elab `Set.member` hasReverseLibDeps ] + exeTargetsRequiredForRevDeps = + -- TODO: allow requesting executable with different name + -- than package name + [ ComponentTarget (Cabal.CExeName (unPackageName (packageName (elabPkgSourceId elab)))) + WholeComponent + | installedUnitId elab `Set.member` hasReverseExeDeps + ] availablePkgs :: Set UnitId @@ -1865,8 +1921,15 @@ pruneInstallPlanPass2 pkgs = hasReverseLibDeps :: Set UnitId hasReverseLibDeps = - Set.fromList [ depid | pkg <- pkgs - , depid <- InstallPlan.depends pkg ] + Set.fromList [ SimpleUnitId (confInstId depid) + | InstallPlan.Configured pkg <- pkgs + , depid <- elabLibDependencies pkg ] + + hasReverseExeDeps :: Set UnitId + hasReverseExeDeps = + Set.fromList [ SimpleUnitId depid + | InstallPlan.Configured pkg <- pkgs + , depid <- elabExeDependencies pkg ] mapConfiguredPackage :: (srcpkg -> srcpkg') -> InstallPlan.GenericPlanPackage ipkg srcpkg @@ -2436,7 +2499,9 @@ packageHashInputs ElabPackage (ElaboratedPackage{..}) -> Set.fromList $ [ confInstId dep - | dep <- CD.select relevantDeps pkgLibDependencies ] + | dep <- CD.select relevantDeps pkgLibDependencies ] ++ + [ confInstId dep + | dep <- CD.select relevantDeps pkgExeDependencies ] ElabComponent comp -> Set.fromList (map confInstId (compLibDependencies comp) ++ compExeDependencies comp), diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index f0d7b947276..6ba3f3a9e77 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -16,6 +16,7 @@ module Distribution.Client.ProjectPlanning.Types ( elabDistDirParams, elabExeDependencyPaths, elabLibDependencies, + elabExeDependencies, elabSetupDependencies, ElaboratedPackageOrComponent(..), @@ -73,6 +74,7 @@ import Data.Set (Set) import qualified Data.ByteString.Lazy as LBS import Distribution.Compat.Binary import GHC.Generics (Generic) +import qualified Data.Monoid as Mon @@ -296,9 +298,15 @@ elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pk elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } = compLibDependencies comp +elabExeDependencies :: ElaboratedConfiguredPackage -> [ComponentId] +elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = map confInstId (CD.nonSetupDeps (pkgExeDependencies pkg)) +elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } + = compExeDependencies comp + elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath] -elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ } - = [] -- TODO: not implemented +elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = CD.nonSetupDeps (pkgExeDependencyPaths pkg) elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } = compExeDependencyPaths comp @@ -353,6 +361,14 @@ data ElaboratedPackage -- pkgLibDependencies :: ComponentDeps [ConfiguredId], + -- | Dependencies on executable packages. + -- + pkgExeDependencies :: ComponentDeps [ConfiguredId], + + -- | Paths where executable dependencies live. + -- + pkgExeDependencyPaths :: ComponentDeps [FilePath], + -- | Which optional stanzas (ie testsuites, benchmarks) will actually -- be enabled during the package configure step. pkgStanzasEnabled :: Set OptionalStanza @@ -363,7 +379,8 @@ instance Binary ElaboratedPackage pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId] pkgOrderDependencies pkg = - fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) + fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend` + fmap (map (SimpleUnitId . confInstId)) (pkgExeDependencies pkg) -- | This is used in the install plan to indicate how the package will be -- built. diff --git a/cabal-install/Distribution/Client/SolverInstallPlan.hs b/cabal-install/Distribution/Client/SolverInstallPlan.hs index bfa064095b1..0a6cd44a6a2 100644 --- a/cabal-install/Distribution/Client/SolverInstallPlan.hs +++ b/cabal-install/Distribution/Client/SolverInstallPlan.hs @@ -125,7 +125,7 @@ showInstallPlan :: SolverInstallPlan -> String showInstallPlan = showPlanIndex . planIndex showPlanPackage :: SolverPlanPackage -> String -showPlanPackage (PreExisting ipkg _) = "PreExisting " ++ display (packageId ipkg) +showPlanPackage (PreExisting ipkg) = "PreExisting " ++ display (packageId ipkg) ++ " (" ++ display (installedUnitId ipkg) ++ ")" showPlanPackage (Configured spkg) = "Configured " ++ display (packageId spkg) @@ -207,7 +207,7 @@ showPlanProblem (PackageStateInvalid pkg pkg') = ++ " which is in the " ++ showPlanState pkg' ++ " state" where - showPlanState (PreExisting _ _) = "pre-existing" + showPlanState (PreExisting _) = "pre-existing" showPlanState (Configured _) = "configured" -- | For an invalid plan, produce a detailed list of problems as human readable @@ -279,7 +279,7 @@ nonSetupClosure index pkgids0 = closure Graph.empty pkgids0 Just _ -> closure completed pkgids Nothing -> closure completed' pkgids' where completed' = Graph.insert pkg completed - pkgids' = CD.nonSetupDeps (resolverPackageDeps pkg) ++ pkgids + pkgids' = CD.nonSetupDeps (resolverPackageLibDeps pkg) ++ pkgids -- | Compute the root sets of a plan -- @@ -310,7 +310,7 @@ libraryRoots index = -- | The setup dependencies of each package in the plan setupRoots :: SolverPlanIndex -> [[SolverId]] setupRoots = filter (not . null) - . map (CD.setupDeps . resolverPackageDeps) + . map (CD.setupDeps . resolverPackageLibDeps) . Graph.toList -- | Given a package index where we assume we want to use all the packages @@ -342,7 +342,7 @@ dependencyInconsistencies' index = | -- For each package @pkg@ pkg <- Graph.toList index -- Find out which @sid@ @pkg@ depends on - , sid <- CD.nonSetupDeps (resolverPackageDeps pkg) + , sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg) -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@) , Just dep <- [Graph.lookup sid index] ] @@ -358,8 +358,8 @@ dependencyInconsistencies' index = reallyIsInconsistent [p1, p2] = let pid1 = nodeKey p1 pid2 = nodeKey p2 - in pid1 `notElem` CD.nonSetupDeps (resolverPackageDeps p2) - && pid2 `notElem` CD.nonSetupDeps (resolverPackageDeps p1) + in pid1 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p2) + && pid2 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p1) reallyIsInconsistent _ = True diff --git a/cabal-install/Distribution/Solver/Modular/Assignment.hs b/cabal-install/Distribution/Solver/Modular/Assignment.hs index 9de3c03838a..56303c412b3 100644 --- a/cabal-install/Distribution/Solver/Modular/Assignment.hs +++ b/cabal-install/Distribution/Solver/Modular/Assignment.hs @@ -82,10 +82,10 @@ extend extSupported langSupported pkgPresent var = foldM extendSingle extendSingle a (Pkg pn vr) = if pkgPresent pn vr then Right a else Left (varToConflictSet var, [Pkg pn vr]) - extendSingle a (Dep qpn ci) = + extendSingle a (Dep is_exe qpn ci) = let ci' = M.findWithDefault (Constrained []) qpn a in case (\ x -> M.insert qpn x a) <$> merge ci' ci of - Left (c, (d, d')) -> Left (c, L.map (Dep qpn) (simplify (P qpn) d d')) + Left (c, (d, d')) -> Left (c, L.map (Dep is_exe qpn) (simplify (P qpn) d d')) Right x -> Right x -- We're trying to remove trivial elements of the conflict. If we're just diff --git a/cabal-install/Distribution/Solver/Modular/Builder.hs b/cabal-install/Distribution/Solver/Modular/Builder.hs index 591679ac34d..722194f145f 100644 --- a/cabal-install/Distribution/Solver/Modular/Builder.hs +++ b/cabal-install/Distribution/Solver/Modular/Builder.hs @@ -55,7 +55,7 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs -- This is important, because in general, if a goal is inserted twice, -- the later addition will have better dependency information. go g o (ng@(OpenGoal (Stanza _ _ ) _gr) : ngs) = go g (cons' ng () o) ngs - go g o (ng@(OpenGoal (Simple (Dep qpn _) c) _gr) : ngs) + go g o (ng@(OpenGoal (Simple (Dep _ qpn _) c) _gr) : ngs) | qpn == qpn' = go g o ngs -- we ignore self-dependencies at this point; TODO: more care may be needed | qpn `M.member` g = go (M.adjust ((c, qpn'):) qpn g) o ngs @@ -127,7 +127,7 @@ build = ana go error "Distribution.Solver.Modular.Builder: build.go called with Lang goal" go (BS { index = _ , next = OneGoal (OpenGoal (Simple (Pkg _ _ ) _) _ ) }) = error "Distribution.Solver.Modular.Builder: build.go called with Pkg goal" - go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _) _) gr) }) = + go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep _ qpn@(Q _ pn) _) _) gr) }) = -- If the package does not exist in the index, we construct an emty PChoiceF node for it -- After all, we have no choices here. Alternatively, we could immediately construct -- a Fail node here, but that would complicate the construction of conflict sets. @@ -186,7 +186,9 @@ buildTree idx (IndependentGoals ind) igs = , qualifyOptions = defaultQualifyOptions idx } where - topLevelGoal qpn = OpenGoal (Simple (Dep qpn (Constrained [])) ()) UserGoal + -- Should a top-level goal allowed to be an executable style + -- dependency? Well, I don't think it would make much difference + topLevelGoal qpn = OpenGoal (Simple (Dep False {- not exe -} qpn (Constrained [])) ()) UserGoal qpns | ind = makeIndependent igs | otherwise = L.map (Q (PackagePath DefaultNamespace Unqualified)) igs diff --git a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs index bb2e1999c93..10cf411303e 100644 --- a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs @@ -4,6 +4,7 @@ module Distribution.Solver.Modular.ConfiguredConversion import Data.Maybe import Prelude hiding (pi) +import Data.Either (partitionEithers) import Distribution.Package (UnitId, packageId) @@ -18,6 +19,7 @@ import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.ResolverPackage import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SourcePackage -- | Converts from the solver specific result @CP QPN@ into @@ -28,27 +30,43 @@ convCP :: SI.InstalledPackageIndex -> CP QPN -> ResolverPackage loc convCP iidx sidx (CP qpi fa es ds) = case convPI qpi of - Left pi -> PreExisting - (fromJust $ SI.lookupUnitId iidx pi) ds' - Right pi -> Configured $ SolverPackage - srcpkg - fa - es - ds' + Left pi -> PreExisting $ + InstSolverPackage { + instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi, + instSolverPkgLibDeps = fmap fst ds', + instSolverPkgExeDeps = fmap snd ds' + } + Right pi -> Configured $ + SolverPackage { + solverPkgSource = srcpkg, + solverPkgFlags = fa, + solverPkgStanzas = es, + solverPkgLibDeps = fmap fst ds', + solverPkgExeDeps = fmap snd ds' + } where Just srcpkg = CI.lookupPackageId sidx pi where - ds' :: ComponentDeps [SolverId] - ds' = fmap (map convConfId) ds + ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -}) + ds' = fmap (partitionEithers . map convConfId) ds convPI :: PI QPN -> Either UnitId PackageId convPI (PI _ (I _ (Inst pi))) = Left pi -convPI pi = Right (packageId (convConfId pi)) +convPI pi = Right (packageId (either id id (convConfId pi))) -convConfId :: PI QPN -> SolverId -convConfId (PI (Q _ pn) (I v loc)) = +convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -} +convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) = case loc of - Inst pi -> PreExistingId sourceId pi - _otherwise -> PlannedId sourceId + Inst pi -> Left (PreExistingId sourceId pi) + _otherwise + | Exe _ pn' <- q + -- NB: the dependencies of the executable are also + -- qualified. So the way to tell if this is an executable + -- dependency is to make sure the qualifier is pointing + -- at the actual thing. Fortunately for us, I was + -- silly and didn't allow arbitrarily nested build-tools + -- dependencies, so a shallow check works. + , pn == pn' -> Right (PlannedId sourceId) + | otherwise -> Left (PlannedId sourceId) where sourceId = PackageIdentifier pn v diff --git a/cabal-install/Distribution/Solver/Modular/Dependency.hs b/cabal-install/Distribution/Solver/Modular/Dependency.hs index d4af4f35648..4c2242ec2d1 100644 --- a/cabal-install/Distribution/Solver/Modular/Dependency.hs +++ b/cabal-install/Distribution/Solver/Modular/Dependency.hs @@ -165,6 +165,9 @@ flattenFlaggedDeps = concatMap aux type TrueFlaggedDeps qpn = FlaggedDeps Component qpn type FalseFlaggedDeps qpn = FlaggedDeps Component qpn +-- | Is this dependency on an executable +type IsExe = Bool + -- | A dependency (constraint) associates a package name with a -- constrained instance. -- @@ -172,20 +175,22 @@ type FalseFlaggedDeps qpn = FlaggedDeps Component qpn -- is used both to record the dependencies as well as who's doing the -- depending; having a 'Functor' instance makes bugs where we don't distinguish -- these two far too likely. (By rights 'Dep' ought to have two type variables.) -data Dep qpn = Dep qpn (CI qpn) -- dependency on a package +data Dep qpn = Dep IsExe qpn (CI qpn) -- dependency on a package (possibly for executable | Ext Extension -- dependency on a language extension | Lang Language -- dependency on a language version | Pkg PN VR -- dependency on a pkg-config package deriving (Eq, Show) showDep :: Dep QPN -> String -showDep (Dep qpn (Fixed i v) ) = +showDep (Dep is_exe qpn (Fixed i v) ) = (if P qpn /= v then showVar v ++ " => " else "") ++ - showQPN qpn ++ "==" ++ showI i -showDep (Dep qpn (Constrained [(vr, v)])) = - showVar v ++ " => " ++ showQPN qpn ++ showVR vr -showDep (Dep qpn ci ) = - showQPN qpn ++ showCI ci + showQPN qpn ++ + (if is_exe then " (exe) " else "") ++ "==" ++ showI i +showDep (Dep is_exe qpn (Constrained [(vr, v)])) = + showVar v ++ " => " ++ showQPN qpn ++ + (if is_exe then " (exe) " else "") ++ showVR vr +showDep (Dep is_exe qpn ci ) = + showQPN qpn ++ (if is_exe then " (exe) " else "") ++ showCI ci showDep (Ext ext) = "requires " ++ display ext showDep (Lang lang) = "requires " ++ display lang showDep (Pkg pn vr) = "requires pkg-config package " @@ -237,10 +242,11 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go goD (Ext ext) _ = Ext ext goD (Lang lang) _ = Lang lang goD (Pkg pkn vr) _ = Pkg pkn vr - goD (Dep dep ci) comp - | qBase dep = Dep (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci) - | qSetup comp = Dep (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci) - | otherwise = Dep (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci) + goD (Dep is_exe dep ci) comp + | is_exe = Dep is_exe (Q (PackagePath ns (Exe pn dep)) dep) (fmap (Q pp) ci) + | qBase dep = Dep is_exe (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci) + | qSetup comp = Dep is_exe (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci) + | otherwise = Dep is_exe (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci) -- If P has a setup dependency on Q, and Q has a regular dependency on R, then -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup @@ -252,6 +258,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go inheritedQ :: Qualifier inheritedQ = case q of Setup _ -> q + Exe _ _ -> q Unqualified -> q Base _ -> Unqualified @@ -282,7 +289,7 @@ unqualifyDeps = go go1 (Simple dep comp) = Simple (goD dep) comp goD :: Dep QPN -> Dep PN - goD (Dep qpn ci) = Dep (unq qpn) (fmap unq ci) + goD (Dep is_exe qpn ci) = Dep is_exe (unq qpn) (fmap unq ci) goD (Ext ext) = Ext ext goD (Lang lang) = Lang lang goD (Pkg pn vr) = Pkg pn vr @@ -354,7 +361,7 @@ instance ResetVar CI where resetVar v (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, resetVar v y)) vrs) instance ResetVar Dep where - resetVar v (Dep qpn ci) = Dep qpn (resetVar v ci) + resetVar v (Dep is_exe qpn ci) = Dep is_exe qpn (resetVar v ci) resetVar _ (Ext ext) = Ext ext resetVar _ (Lang lang) = Lang lang resetVar _ (Pkg pn vr) = Pkg pn vr @@ -401,7 +408,7 @@ data OpenGoal comp = OpenGoal (FlaggedDep comp QPN) QGoalReason -- | Closes a goal, i.e., removes all the extraneous information that we -- need only during the build phase. close :: OpenGoal comp -> Goal QPN -close (OpenGoal (Simple (Dep qpn _) _) gr) = Goal (P qpn) gr +close (OpenGoal (Simple (Dep _ qpn _) _) gr) = Goal (P qpn) gr close (OpenGoal (Simple (Ext _) _) _ ) = error "Distribution.Solver.Modular.Dependency.close: called on Ext goal" close (OpenGoal (Simple (Lang _) _) _ ) = diff --git a/cabal-install/Distribution/Solver/Modular/Index.hs b/cabal-install/Distribution/Solver/Modular/Index.hs index 7fc55e42735..56a8f708763 100644 --- a/cabal-install/Distribution/Solver/Modular/Index.hs +++ b/cabal-install/Distribution/Solver/Modular/Index.hs @@ -44,7 +44,7 @@ defaultQualifyOptions idx = QO { -- .. which are installed .. , (I _ver (Inst _), PInfo deps _flagNfo _fr) <- M.toList is -- .. and flatten all their dependencies .. - , (Dep dep _ci, _comp) <- flattenFlaggedDeps deps + , (Dep _is_exe dep _ci, _comp) <- flattenFlaggedDeps deps ] , qoSetupIndependent = True } diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 971c7796bfd..48942ffd541 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -87,7 +87,9 @@ convIPId pn' idx ipid = Nothing -> Nothing Just ipi -> let i = I (pkgVersion (sourcePackageId ipi)) (Inst ipid) pn = pkgName (sourcePackageId ipi) - in Just (D.Simple (Dep pn (Fixed i (P pn'))) ()) + in Just (D.Simple (Dep False pn (Fixed i (P pn'))) ()) + -- NB: something we pick up from the + -- InstalledPackageIndex is NEVER an executable -- | Convert a cabal-install source package index to the simpler, -- more uniform index format of the solver. @@ -118,8 +120,10 @@ convGPD os arch cinfo strfl pi -- 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 [ PackageName nm - | (nm, _) <- sub_libs ] + ipns = S.fromList $ [ PackageName nm + | (nm, _) <- sub_libs ] ++ + [ PackageName nm + | (nm, _) <- exes ] conv :: Mon.Monoid a => Component -> (a -> BuildInfo) -> CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN @@ -139,44 +143,6 @@ convGPD os arch cinfo strfl pi in PInfo flagged_deps fds Nothing --- With convenience libraries, we have to do some work. Imagine you --- have the following Cabal file: --- --- name: foo --- library foo-internal --- build-depends: external-a --- library --- build-depends: foo-internal, external-b --- library foo-helper --- build-depends: foo, external-c --- test-suite foo-tests --- build-depends: foo-helper, external-d --- --- What should the final flagged dependency tree be? Ideally, it --- should look like this: --- --- [ Simple (Dep external-a) (Library foo-internal) --- , Simple (Dep external-b) (Library foo) --- , Stanza (SN foo TestStanzas) $ --- [ Simple (Dep external-c) (Library foo-helper) --- , Simple (Dep external-d) (TestSuite foo-tests) ] --- ] --- --- There are two things to note: --- --- 1. First, we eliminated the "local" dependencies foo-internal --- and foo-helper. This are implicitly assumed to refer to "foo" --- so we don't need to have them around. If you forget this, --- Cabal will then try to pick a version for "foo-helper" but --- no such package exists (this is the cost of overloading --- build-depends to refer to both packages and components.) --- --- 2. Second, it is more precise to have external-c be qualified --- by a test stanza, since foo-helper only needs to be built if --- your are building the test suite (and not the main library). --- If you omit it, Cabal will always attempt to depsolve for --- foo-helper even if you aren't building the test suite. - -- | Create a flagged dependency tree from a list @fds@ of flagged -- dependencies, using @f@ to form the tree node (@f@ will be -- something like @Stanza sn@). @@ -214,15 +180,36 @@ convCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo -> CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN convCondTree os arch cinfo pi@(PI pn _) fds comp getInfo ipns (CondNode info ds branches) = concatMap - (\d -> filterIPNs ipns d (D.Simple (convDep pn d) comp)) + (\d -> filterIPNs ipns d (D.Simple (convLibDep pn d) comp)) ds -- unconditional package dependencies ++ L.map (\e -> D.Simple (Ext e) comp) (PD.allExtensions bi) -- unconditional extension dependencies ++ L.map (\l -> D.Simple (Lang l) comp) (PD.allLanguages bi) -- unconditional language dependencies ++ L.map (\(Dependency pkn vr) -> D.Simple (Pkg pkn vr) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies ++ concatMap (convBranch os arch cinfo pi fds comp getInfo ipns) branches + -- build-tools dependencies + ++ concatMap + (\(Dependency (PackageName exe) vr) -> + case packageProvidingBuildTool exe of + Nothing -> [] + Just pn' -> [D.Simple (convExeDep pn (Dependency pn' vr)) comp]) + (PD.buildTools bi) where bi = getInfo info +-- | This function maps known @build-tools@ entries to Haskell package +-- names which provide them. This mapping corresponds exactly to +-- those build-tools that Cabal understands by default +-- ('builtinPrograms'), and are cabal install'able. This mapping is +-- purely for legacy; for other executables, @tool-depends@ should be +-- used instead. +-- +packageProvidingBuildTool :: String -> Maybe PackageName +packageProvidingBuildTool s = + if s `elem` ["hscolour", "haddock", "happy", "alex", "hsc2hs", + "c2hs", "cpphs", "greencard"] + then Just (PackageName s) + else Nothing + -- | Branch interpreter. Mutually recursive with 'convCondTree'. -- -- Here, we try to simplify one of Cabal's condition tree branches into the @@ -300,19 +287,26 @@ convBranch os arch cinfo pi@(PI pn _) fds comp getInfo ipns (c', t', mf') = -- Note that we make assumptions here on the form of the dependencies that -- can occur at this point. In particular, no occurrences of Fixed, and no -- occurrences of multiple version ranges, as all dependencies below this - -- point have been generated using 'convDep'. + -- point have been generated using 'convLibDep'. + -- + -- WARNING: This is quadratic! extractCommon :: FlaggedDeps Component PN -> FlaggedDeps Component PN -> FlaggedDeps Component PN - extractCommon ps ps' = [ D.Simple (Dep pn1 (Constrained [(vr1 .||. vr2, P pn)])) comp - | D.Simple (Dep pn1 (Constrained [(vr1, _)])) _ <- ps - , D.Simple (Dep pn2 (Constrained [(vr2, _)])) _ <- ps' + extractCommon ps ps' = [ D.Simple (Dep is_exe1 pn1 (Constrained [(vr1 .||. vr2, P pn)])) comp + | D.Simple (Dep is_exe1 pn1 (Constrained [(vr1, _)])) _ <- ps + , D.Simple (Dep is_exe2 pn2 (Constrained [(vr2, _)])) _ <- ps' , pn1 == pn2 + , is_exe1 == is_exe2 ] --- | Convert a Cabal dependency to a solver-specific dependency. -convDep :: PN -> Dependency -> Dep PN -convDep pn' (Dependency pn vr) = Dep pn (Constrained [(vr, P pn')]) +-- | Convert a Cabal dependency on a library to a solver-specific dependency. +convLibDep :: PN -> Dependency -> Dep PN +convLibDep pn' (Dependency pn vr) = Dep False {- not exe -} pn (Constrained [(vr, P pn')]) + +-- | Convert a Cabal dependency on a executable (build-tools) to a solver-specific dependency. +convExeDep :: PN -> Dependency -> Dep PN +convExeDep pn' (Dependency pn vr) = Dep True pn (Constrained [(vr, P pn')]) -- | Convert setup dependencies convSetupBuildInfo :: PI PN -> SetupBuildInfo -> FlaggedDeps Component PN convSetupBuildInfo (PI pn _i) nfo = - L.map (\d -> D.Simple (convDep pn d) ComponentSetup) (PD.setupDepends nfo) + L.map (\d -> D.Simple (convLibDep pn d) ComponentSetup) (PD.setupDepends nfo) diff --git a/cabal-install/Distribution/Solver/Modular/Linking.hs b/cabal-install/Distribution/Solver/Modular/Linking.hs index d37a7a17fe4..da77d0c4eff 100644 --- a/cabal-install/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install/Distribution/Solver/Modular/Linking.hs @@ -301,7 +301,7 @@ linkDeps target = \blame deps -> do go1 :: [Var QPN] -> FlaggedDep Component QPN -> FlaggedDep Component QPN -> UpdateState () go1 blame dep rdep = case (dep, rdep) of - (Simple (Dep qpn _) _, ~(Simple (Dep qpn' _) _)) -> do + (Simple (Dep _ qpn _) _, ~(Simple (Dep _ qpn' _) _)) -> do vs <- get let lg = M.findWithDefault (lgSingleton qpn Nothing) qpn $ vsLinks vs lg' = M.findWithDefault (lgSingleton qpn' Nothing) qpn' $ vsLinks vs diff --git a/cabal-install/Distribution/Solver/Modular/Package.hs b/cabal-install/Distribution/Solver/Modular/Package.hs index ee521072392..011a62e38dc 100644 --- a/cabal-install/Distribution/Solver/Modular/Package.hs +++ b/cabal-install/Distribution/Solver/Modular/Package.hs @@ -76,8 +76,12 @@ instI :: I -> Bool instI (I _ (Inst _)) = True instI _ = False --- | Is the package in the primary group of packages. In particular this --- does not include packages pulled in as setup deps. +-- | Is the package in the primary group of packages. This is used to +-- determine (1) if we should try to establish stanza preferences +-- for this goal, and (2) whether or not a user specified @--constraint@ +-- should apply to this dependency (grep 'primaryPP' to see the +-- use sites). In particular this does not include packages pulled in +-- as setup deps. -- primaryPP :: PackagePath -> Bool primaryPP (PackagePath _ns q) = go q @@ -85,6 +89,7 @@ primaryPP (PackagePath _ns q) = go q go Unqualified = True go (Base _) = True go (Setup _) = False + go (Exe _ _) = False -- | Create artificial parents for each of the package names, making -- them all independent. diff --git a/cabal-install/Distribution/Solver/Modular/Validate.hs b/cabal-install/Distribution/Solver/Modular/Validate.hs index abc021baaa4..38a78e60cbd 100644 --- a/cabal-install/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install/Distribution/Solver/Modular/Validate.hs @@ -153,7 +153,8 @@ validate = cata go let qdeps = qualifyDeps qo qpn deps -- the new active constraints are given by the instance we have chosen, -- plus the dependency information we have for that instance - let newactives = Dep qpn (Fixed i (P qpn)) : L.map (resetVar (P qpn)) (extractDeps pfa psa qdeps) + -- TODO: is the False here right? + let newactives = Dep False {- not exe -} qpn (Fixed i (P qpn)) : L.map (resetVar (P qpn)) (extractDeps pfa psa qdeps) -- We now try to extend the partial assignment with the new active constraints. let mnppa = extend extSupported langSupported pkgPresent (P qpn) ppa newactives -- In case we continue, we save the scoped dependencies diff --git a/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs new file mode 100644 index 00000000000..5c3862a80b7 --- /dev/null +++ b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Solver.Types.InstSolverPackage + ( InstSolverPackage(..) + ) where + +import Distribution.Compat.Binary (Binary(..)) +import Distribution.Package ( Package(..), HasUnitId(..) ) +import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) +import Distribution.Solver.Types.SolverId +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import GHC.Generics (Generic) + +-- | An 'InstSolverPackage' is a pre-existing installed pacakge +-- specified by the dependency solver. +data InstSolverPackage = InstSolverPackage { + instSolverPkgIPI :: InstalledPackageInfo, + instSolverPkgLibDeps :: ComponentDeps [SolverId], + instSolverPkgExeDeps :: ComponentDeps [SolverId] + } + deriving (Eq, Show, Generic) + +instance Binary InstSolverPackage + +instance Package InstSolverPackage where + packageId = packageId . instSolverPkgIPI + +instance HasUnitId InstSolverPackage where + installedUnitId = installedUnitId . instSolverPkgIPI diff --git a/cabal-install/Distribution/Solver/Types/PackagePath.hs b/cabal-install/Distribution/Solver/Types/PackagePath.hs index f5693fbf4fb..5ba2ecac4e5 100644 --- a/cabal-install/Distribution/Solver/Types/PackagePath.hs +++ b/cabal-install/Distribution/Solver/Types/PackagePath.hs @@ -47,6 +47,18 @@ data Qualifier = -- infinite search trees in the solver. Therefore we limit ourselves to -- a single qualifier (within a given namespace). | Setup PackageName + + -- | If we depend on an executable from a package (via + -- @build-tools@), we should solve for the dependencies of that + -- package separately (since we're not going to actually try to + -- link it.) We qualify for EACH package separately; e.g., + -- @'Exe' pn1 pn2@ qualifies the @build-tools@ dependency on + -- @pn2@ from package @pn1@. (If we tracked only @pn1@, that + -- would require a consistent dependency resolution for all + -- of the depended upon executables from a package; if we + -- tracked only @pn2@, that would require us to pick only one + -- version of an executable over the entire install plan.) + | Exe PackageName PackageName deriving (Eq, Ord, Show) -- | String representation of a package path. @@ -68,6 +80,7 @@ showPP (PackagePath ns q) = -- 'Base' qualifier, will always be @base@). go Unqualified = "" go (Setup pn) = display pn ++ "-setup." + go (Exe pn pn2) = display pn ++ "-" ++ display pn2 ++ "-exe." go (Base pn) = display pn ++ "." -- | A qualified entity. Pairs a package path with the entity. diff --git a/cabal-install/Distribution/Solver/Types/ResolverPackage.hs b/cabal-install/Distribution/Solver/Types/ResolverPackage.hs index 34318eed7ce..277f96e1aa3 100644 --- a/cabal-install/Distribution/Solver/Types/ResolverPackage.hs +++ b/cabal-install/Distribution/Solver/Types/ResolverPackage.hs @@ -2,17 +2,19 @@ {-# LANGUAGE DeriveGeneric #-} module Distribution.Solver.Types.ResolverPackage ( ResolverPackage(..) - , resolverPackageDeps + , resolverPackageLibDeps + , resolverPackageExeDeps ) where +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Compat.Binary (Binary(..)) import Distribution.Compat.Graph (IsNode(..)) -import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Package (Package(..), HasUnitId(..)) +import Distribution.Simple.Utils (ordNub) import GHC.Generics (Generic) -- | The dependency resolver picks either pre-existing installed packages @@ -20,23 +22,29 @@ import GHC.Generics (Generic) -- -- This is like the 'InstallPlan.PlanPackage' but with fewer cases. -- -data ResolverPackage loc = PreExisting InstalledPackageInfo (CD.ComponentDeps [SolverId]) +data ResolverPackage loc = PreExisting InstSolverPackage | Configured (SolverPackage loc) deriving (Eq, Show, Generic) instance Binary loc => Binary (ResolverPackage loc) instance Package (ResolverPackage loc) where - packageId (PreExisting ipkg _) = packageId ipkg + packageId (PreExisting ipkg) = packageId ipkg packageId (Configured spkg) = packageId spkg -resolverPackageDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] -resolverPackageDeps (PreExisting _ deps) = deps -resolverPackageDeps (Configured spkg) = solverPkgDeps spkg +resolverPackageLibDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] +resolverPackageLibDeps (PreExisting ipkg) = instSolverPkgLibDeps ipkg +resolverPackageLibDeps (Configured spkg) = solverPkgLibDeps spkg + +resolverPackageExeDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] +resolverPackageExeDeps (PreExisting ipkg) = instSolverPkgExeDeps ipkg +resolverPackageExeDeps (Configured spkg) = solverPkgExeDeps spkg instance IsNode (ResolverPackage loc) where type Key (ResolverPackage loc) = SolverId - nodeKey (PreExisting ipkg _) = PreExistingId (packageId ipkg) (installedUnitId ipkg) + nodeKey (PreExisting ipkg) = PreExistingId (packageId ipkg) (installedUnitId ipkg) nodeKey (Configured spkg) = PlannedId (packageId spkg) -- Use dependencies for ALL components - nodeNeighbors pkg = CD.flatDeps (resolverPackageDeps pkg) + nodeNeighbors pkg = + ordNub $ CD.flatDeps (resolverPackageLibDeps pkg) ++ + CD.flatDeps (resolverPackageExeDeps pkg) diff --git a/cabal-install/Distribution/Solver/Types/SolverPackage.hs b/cabal-install/Distribution/Solver/Types/SolverPackage.hs index 0bd5f8e8fd7..fc91f717862 100644 --- a/cabal-install/Distribution/Solver/Types/SolverPackage.hs +++ b/cabal-install/Distribution/Solver/Types/SolverPackage.hs @@ -23,7 +23,8 @@ data SolverPackage loc = SolverPackage { solverPkgSource :: SourcePackage loc, solverPkgFlags :: FlagAssignment, solverPkgStanzas :: [OptionalStanza], - solverPkgDeps :: ComponentDeps [SolverId] + solverPkgLibDeps :: ComponentDeps [SolverId], + solverPkgExeDeps :: ComponentDeps [SolverId] } deriving (Eq, Show, Generic) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a7e0612e53c..a755cf790c0 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -99,6 +99,12 @@ Extra-Source-Files: tests/IntegrationTests/new-build/executable/Test.hs tests/IntegrationTests/new-build/executable/a.cabal tests/IntegrationTests/new-build/executable/cabal.project + tests/IntegrationTests/new-build/external_build_tools.sh + tests/IntegrationTests/new-build/external_build_tools/cabal.project + tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs + tests/IntegrationTests/new-build/external_build_tools/client/client.cabal + tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs + tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal tests/IntegrationTests/new-build/monitor_cabal_files.sh tests/IntegrationTests/new-build/monitor_cabal_files/cabal.project tests/IntegrationTests/new-build/monitor_cabal_files/p/P.hs @@ -279,6 +285,7 @@ executable cabal Distribution.Solver.Types.ConstraintSource Distribution.Solver.Types.DependencyResolver Distribution.Solver.Types.InstalledPreference + Distribution.Solver.Types.InstSolverPackage Distribution.Solver.Types.LabeledPackageConstraint Distribution.Solver.Types.OptionalStanza Distribution.Solver.Types.PackageConstraint diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh b/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh new file mode 100644 index 00000000000..a12a5c83a12 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh @@ -0,0 +1,3 @@ +. ./common.sh +cd external_build_tools +cabal new-build client diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project new file mode 100644 index 00000000000..b5377830e88 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project @@ -0,0 +1 @@ +packages: client, happy diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs new file mode 100644 index 00000000000..2573eba65c2 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -F -pgmF happy #-} +module Main where + +a :: String +a = "0000" + +main :: IO () +main = putStrLn a diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal new file mode 100644 index 00000000000..23070a812fa --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal @@ -0,0 +1,13 @@ +name: client +version: 0.1.0.0 +synopsis: Checks build-tools are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable hello-world + main-is: Hello.hs + build-depends: base + build-tools: happy + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs new file mode 100644 index 00000000000..09c949ab176 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.IO + +main :: IO () +main = do + (_:source:target:_) <- getArgs + let f '0' = '1' + f c = c + writeFile target . map f =<< readFile source diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal new file mode 100644 index 00000000000..0e95effb701 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal @@ -0,0 +1,12 @@ +name: happy +version: 999.999.999 +synopsis: Checks build-tools on legacy package name are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable happy + main-is: MyCustomPreprocessor.hs + build-depends: base, directory + default-language: Haskell2010 diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 3ae64ccd098..cbe70725ad6 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -122,6 +122,12 @@ data ExampleDependency = -- | Simple dependency on a fixed version | ExFix ExamplePkgName ExamplePkgVersion + -- | Build-tools dependency + | ExBuildToolAny ExamplePkgName + + -- | Build-tools dependency on a fixed version + | ExBuildToolFix ExamplePkgName ExamplePkgVersion + -- | Dependencies indexed by a flag | ExFlag ExampleFlagName Dependencies Dependencies @@ -222,7 +228,7 @@ exDbPkgs = map (either exInstName exAvName) exAvSrcPkg :: ExampleAvailable -> UnresolvedSourcePackage exAvSrcPkg ex = - let (libraryDeps, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) + let (libraryDeps, exts, mlang, pcpkgs, exes) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)] in SourcePackage { packageInfoId = exAvPkgId ex @@ -244,7 +250,8 @@ exAvSrcPkg ex = } , C.genPackageFlags = nub $ concatMap extractFlags $ CD.libraryDeps (exAvDeps ex) ++ concatMap snd testSuites - , C.condLibrary = Just (mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs) + , C.condLibrary = Just (mkCondTree + (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs <> buildtoolsLib exes) disableLib (Buildable libraryDeps)) , C.condSubLibraries = [] @@ -263,27 +270,36 @@ exAvSrcPkg ex = , [Extension] , Maybe Language , [(ExamplePkgName, ExamplePkgVersion)] -- pkg-config + , [(ExamplePkgName, Maybe Int)] ) splitTopLevel [] = - ([], [], Nothing, []) + ([], [], Nothing, [], []) + splitTopLevel (ExBuildToolAny p:deps) = + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pcpkgs, (p, Nothing):exes) + splitTopLevel (ExBuildToolFix p v:deps) = + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pcpkgs, (p, Just v):exes) splitTopLevel (ExExt ext:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (other, ext:exts, lang, pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, ext:exts, lang, pcpkgs, exes) splitTopLevel (ExLang lang:deps) = case splitTopLevel deps of - (other, exts, Nothing, pcpkgs) -> (other, exts, Just lang, pcpkgs) + (other, exts, Nothing, pcpkgs, exes) -> (other, exts, Just lang, pcpkgs, exes) _ -> error "Only 1 Language dependency is supported" splitTopLevel (ExPkg pkg:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (other, exts, lang, pkg:pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pkg:pcpkgs, exes) splitTopLevel (dep:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (dep:other, exts, lang, pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (dep:other, exts, lang, pcpkgs, exes) -- Extract the total set of flags used extractFlags :: ExampleDependency -> [C.Flag] extractFlags (ExAny _) = [] extractFlags (ExFix _ _) = [] + extractFlags (ExBuildToolAny _) = [] + extractFlags (ExBuildToolFix _ _) = [] extractFlags (ExFlag f a b) = C.MkFlag { C.flagName = C.FlagName f , C.flagDescription = "" @@ -310,6 +326,9 @@ exAvSrcPkg ex = let (directDeps, flaggedDeps) = splitDeps deps in C.CondNode { C.condTreeData = x -- Necessary for language extensions + -- TODO: Arguably, build-tools dependencies should also + -- effect constraints on conditional tree. But no way to + -- distinguish between them , C.condTreeConstraints = map mkDirect directDeps , C.condTreeComponents = map (mkFlagged dontBuild) flaggedDeps } @@ -380,6 +399,12 @@ exAvSrcPkg ex = pcpkgLib :: [(ExamplePkgName, ExamplePkgVersion)] -> C.Library pcpkgLib ds = mempty { C.libBuildInfo = mempty { C.pkgconfigDepends = [mkDirect (n, (Just v)) | (n,v) <- ds] } } + buildtoolsLib :: [(ExamplePkgName, Maybe Int)] -> C.Library + buildtoolsLib ds = mempty { C.libBuildInfo = mempty { + C.buildTools = map mkDirect ds + } } + + exAvPkgId :: ExampleAvailable -> C.PackageIdentifier exAvPkgId ex = C.PackageIdentifier { pkgName = C.PackageName (exAvName ex) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index 3b62327c148..25f0da0ba6d 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -156,6 +156,14 @@ tests = [ , runTest $ mkTest dbBJ7 "bj7" ["A"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)]) , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)]) ] + -- Build-tools dependencies + , testGroup "build-tools" [ + runTest $ mkTest dbBuildTools1 "bt1" ["A"] (SolverSuccess [("A", 1), ("alex", 1)]) + , runTest $ mkTest dbBuildTools2 "bt2" ["A"] (SolverSuccess [("A", 1)]) + , runTest $ mkTest dbBuildTools3 "bt3" ["C"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)]) + , runTest $ mkTest dbBuildTools4 "bt4" ["B"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)]) + , runTest $ mkTest dbBuildTools5 "bt5" ["A"] (SolverSuccess [("A", 1), ("alex", 1), ("happy", 1)]) + ] ] where soft prefs test = test { testSoftConstraints = prefs } @@ -1064,3 +1072,46 @@ dbBJ8 = [ , Right $ exAv "B" 1 [ExAny "C"] , Right $ exAv "C" 1 [] ] + +{------------------------------------------------------------------------------- + Databases for build-tools +-------------------------------------------------------------------------------} +dbBuildTools1 :: ExampleDb +dbBuildTools1 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "A" 1 [ExBuildToolAny "alex"] + ] + +-- Test that build-tools on a random thing doesn't matter (only +-- the ones we recognize need to be in db) +dbBuildTools2 :: ExampleDb +dbBuildTools2 = [ + Right $ exAv "A" 1 [ExBuildToolAny "otherdude"] + ] + +-- Test that we can solve for different versions of executables +dbBuildTools3 :: ExampleDb +dbBuildTools3 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "alex" 2 [], + Right $ exAv "A" 1 [ExBuildToolFix "alex" 1], + Right $ exAv "B" 1 [ExBuildToolFix "alex" 2], + Right $ exAv "C" 1 [ExAny "A", ExAny "B"] + ] + +-- Test that exe is not related to library choices +dbBuildTools4 :: ExampleDb +dbBuildTools4 = [ + Right $ exAv "alex" 1 [ExFix "A" 1], + Right $ exAv "A" 1 [], + Right $ exAv "A" 2 [], + Right $ exAv "B" 1 [ExBuildToolFix "alex" 1, ExFix "A" 2] + ] + +-- Test that build-tools on build-tools works +dbBuildTools5 :: ExampleDb +dbBuildTools5 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "happy" 1 [ExBuildToolAny "alex"], + Right $ exAv "A" 1 [ExBuildToolAny "happy"] + ]