From c6d63972edc489fe06be803ed03f9aac94cafaa1 Mon Sep 17 00:00:00 2001 From: Byron Johnson Date: Wed, 10 Aug 2022 21:45:56 -0600 Subject: [PATCH] Track build artifacts in installed packages. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 1) Extend the InstalledPackageInfo record with 5 records involving configuration flags that affect which build artifacts (dynamic and static files) are provided. (This record corresponds to the ‘.conf’ files in package-db directories, and Cabal-syntax provides an interface to this record. Cabal-syntax is used as a dependency by ‘ghc-pkg’ and ‘cabal-install’, and old Cabal-syntax implementations may produce an ‘Unknown field’ warning when used with new ‘.conf’ files.) 2) Add a step to the validation phase of the modular resolver that also rules out pre-installed package options that would introduce a missing artifact condition, so that alternatives if available can be chosen instead, rather than producing assignments for a build plan that would fail with ‘files missing’ (e.g. ‘….hi’ or ‘….dyn_hi’). --- .../Types/InstalledPackageInfo.hs | 15 +- .../InstalledPackageInfo/FieldGrammar.hs | 5 + .../Types/InstalledPackageInfo/Lens.hs | 20 ++ Cabal/src/Distribution/Simple/Register.hs | 7 +- .../cabal-install-solver.cabal | 1 + .../src/Distribution/Solver/Modular.hs | 2 +- .../Distribution/Solver/Modular/Builder.hs | 2 +- .../Distribution/Solver/Modular/Explore.hs | 2 +- .../src/Distribution/Solver/Modular/Index.hs | 6 +- .../Solver/Modular/IndexConversion.hs | 48 ++-- .../Distribution/Solver/Modular/Linking.hs | 8 +- .../Distribution/Solver/Modular/Message.hs | 1 + .../Distribution/Solver/Modular/Preference.hs | 221 ++++++++++++++++++ .../src/Distribution/Solver/Modular/Solver.hs | 8 +- .../src/Distribution/Solver/Modular/Tree.hs | 2 + .../Distribution/Solver/Modular/Validate.hs | 2 +- .../Solver/Types/ArtifactSelection.hs | 76 ++++++ .../src/Distribution/Solver/Types/Settings.hs | 6 + .../src/Distribution/Client/Config.hs | 1 + .../src/Distribution/Client/Configure.hs | 9 + .../src/Distribution/Client/Dependency.hs | 36 ++- .../src/Distribution/Client/Fetch.hs | 3 + .../src/Distribution/Client/Freeze.hs | 3 + .../src/Distribution/Client/Install.hs | 13 ++ .../src/Distribution/Client/ProjectConfig.hs | 12 +- .../Client/ProjectConfig/Legacy.hs | 6 +- .../Client/ProjectConfig/Types.hs | 4 + .../Distribution/Client/ProjectPlanning.hs | 4 + .../src/Distribution/Client/Setup.hs | 19 +- 29 files changed, 503 insertions(+), 39 deletions(-) create mode 100644 cabal-install-solver/src/Distribution/Solver/Types/ArtifactSelection.hs diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs index 0d047db5590..716a9369fb1 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs @@ -92,7 +92,13 @@ data InstalledPackageInfo frameworks :: [String], haddockInterfaces :: [FilePath], haddockHTMLs :: [FilePath], - pkgRoot :: Maybe FilePath + pkgRoot :: Maybe FilePath, + -- Artifacts included in this package: + pkgVanillaLib :: Bool, + pkgSharedLib :: Bool, + pkgDynExe :: Bool, + pkgProfLib :: Bool, + pkgProfExe :: Bool } deriving (Eq, Generic, Typeable, Read, Show) @@ -173,5 +179,10 @@ emptyInstalledPackageInfo haddockInterfaces = [], haddockHTMLs = [], pkgRoot = Nothing, - libVisibility = LibraryVisibilityPrivate + libVisibility = LibraryVisibilityPrivate, + pkgVanillaLib = True, + pkgSharedLib = True, + pkgDynExe = True, + pkgProfLib = True, + pkgProfExe = True } diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index f176ea01187..cfbafa41947 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -121,6 +121,11 @@ ipiFieldGrammar = mkInstalledPackageInfo <@> monoidalFieldAla "haddock-interfaces" (alaList' FSep FilePathNT) L.haddockInterfaces <@> monoidalFieldAla "haddock-html" (alaList' FSep FilePathNT) L.haddockHTMLs <@> optionalFieldAla "pkgroot" FilePathNT L.pkgRoot + <@> booleanFieldDef "pkg-vanilla-lib" L.pkgVanillaLib True + <@> booleanFieldDef "pkg-shared-lib" L.pkgSharedLib True + <@> booleanFieldDef "pkg-dyn-exe" L.pkgDynExe True + <@> booleanFieldDef "pkg-prof-lib" L.pkgProfLib True + <@> booleanFieldDef "pkg-prof-exe" L.pkgProfExe True where mkInstalledPackageInfo _ Basic {..} = InstalledPackageInfo -- _basicPkgName is not used diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs index 9d1df886370..8bd6e6a2a88 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -196,3 +196,23 @@ libVisibility :: Lens' InstalledPackageInfo LibraryVisibility libVisibility f s = fmap (\x -> s { T.libVisibility = x }) (f (T.libVisibility s)) {-# INLINE libVisibility #-} +pkgVanillaLib :: Lens' InstalledPackageInfo Bool +pkgVanillaLib f s = fmap (\x -> s { T.pkgVanillaLib = x }) (f (T.pkgVanillaLib s)) +{-# INLINE pkgVanillaLib #-} + +pkgSharedLib :: Lens' InstalledPackageInfo Bool +pkgSharedLib f s = fmap (\x -> s { T.pkgSharedLib = x }) (f (T.pkgSharedLib s)) +{-# INLINE pkgSharedLib #-} + +pkgDynExe :: Lens' InstalledPackageInfo Bool +pkgDynExe f s = fmap (\x -> s { T.pkgDynExe = x }) (f (T.pkgDynExe s)) +{-# INLINE pkgDynExe #-} + +pkgProfLib :: Lens' InstalledPackageInfo Bool +pkgProfLib f s = fmap (\x -> s { T.pkgProfLib = x }) (f (T.pkgProfLib s)) +{-# INLINE pkgProfLib #-} + +pkgProfExe :: Lens' InstalledPackageInfo Bool +pkgProfExe f s = fmap (\x -> s { T.pkgProfExe = x }) (f (T.pkgProfExe s)) +{-# INLINE pkgProfExe #-} + diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index 4a8faaeeeb3..c4abbe73d71 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/Cabal/src/Distribution/Simple/Register.hs @@ -448,7 +448,12 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi IPI.haddockInterfaces = [haddockdir installDirs haddockName pkg], IPI.haddockHTMLs = [htmldir installDirs], IPI.pkgRoot = Nothing, - IPI.libVisibility = libVisibility lib + IPI.libVisibility = libVisibility lib, + IPI.pkgVanillaLib = withVanillaLib lbi, + IPI.pkgSharedLib = withProfLib lbi, + IPI.pkgDynExe = withSharedLib lbi, + IPI.pkgProfLib = withStaticLib lbi, + IPI.pkgProfExe = withDynExe lbi } where ghc84 = case compilerId $ compiler lbi of diff --git a/cabal-install-solver/cabal-install-solver.cabal b/cabal-install-solver/cabal-install-solver.cabal index 1b03d228a68..5d909e9280a 100644 --- a/cabal-install-solver/cabal-install-solver.cabal +++ b/cabal-install-solver/cabal-install-solver.cabal @@ -81,6 +81,7 @@ library Distribution.Solver.Modular.Var Distribution.Solver.Modular.Version Distribution.Solver.Modular.WeightedPSQ + Distribution.Solver.Types.ArtifactSelection Distribution.Solver.Types.ComponentDeps Distribution.Solver.Types.ConstraintSource Distribution.Solver.Types.DependencyResolver diff --git a/cabal-install-solver/src/Distribution/Solver/Modular.hs b/cabal-install-solver/src/Distribution/Solver/Modular.hs index c0c4f7a2d35..29bf4b71816 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular.hs @@ -64,7 +64,7 @@ modularResolver sc (Platform arch os) cinfo iidx sidx pkgConfigDB pprefs pcs pns solve' sc cinfo idx pkgConfigDB pprefs gcs pns where -- Indices have to be converted into solver-specific uniform index. - idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) iidx sidx + idx = convPIs os arch cinfo gcs (shadowPkgs sc) (strongFlags sc) (solveExecutables sc) (sourceArtifacts sc) iidx sidx -- Constraints have to be converted into a finite map indexed by PN. gcs = M.fromListWith (++) (map pair pcs) where diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs index 5d196f4fd9f..75423eda9cb 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Builder.hs @@ -179,7 +179,7 @@ addChildren bs@(BS { rdeps = rdm, next = OneGoal (StanzaGoal qsn@(SN qpn _) t gr -- and furthermore we update the set of goals. -- -- TODO: We could inline this above. -addChildren bs@(BS { next = Instance qpn (PInfo fdeps _ fdefs _) }) = +addChildren bs@(BS { next = Instance qpn (PInfo fdeps _ fdefs _ _) }) = addChildren ((scopedExtendOpen qpn fdeps fdefs bs) { next = Goals }) diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs index 90038a28f5c..0a379969edd 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Explore.hs @@ -269,7 +269,7 @@ exploreLog mbj enableBj fineGrainedConflicts (CountConflicts countConflicts) idx -- to be merged with the previous one. couldResolveConflicts :: QPN -> POption -> S.Set CS.Conflict -> Maybe ConflictSet couldResolveConflicts currentQPN@(Q _ pn) (POption i@(I v _) _) conflicts = - let (PInfo deps _ _ _) = idx M.! pn M.! i + let (PInfo deps _ _ _ _) = idx M.! pn M.! i qdeps = qualifyDeps (defaultQualifyOptions idx) currentQPN deps couldBeResolved :: CS.Conflict -> Maybe ConflictSet diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs index 2f28d12de85..6b327dc9f0e 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Index.hs @@ -18,6 +18,7 @@ import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag import Distribution.Solver.Modular.Package import Distribution.Solver.Modular.Tree +import Distribution.Solver.Types.ArtifactSelection -- | An index contains information about package instances. This is a nested -- dictionary. Package names are mapped to instances, which in turn is mapped @@ -32,10 +33,13 @@ type Index = Map PN (Map I PInfo) -- globally, for reasons external to the solver. We currently use this -- for shadowing which essentially is a GHC limitation, and for -- installed packages that are broken. +-- +-- Additionally, track build artifacts provided and build artifacts required. data PInfo = PInfo (FlaggedDeps PN) (Map ExposedComponent ComponentInfo) FlagInfo (Maybe FailReason) + (ArtifactSelection, ArtifactSelection) -- | Info associated with each library and executable in a package instance. data ComponentInfo = ComponentInfo { @@ -64,7 +68,7 @@ defaultQualifyOptions idx = QO { | -- Find all versions of base .. Just is <- [M.lookup base idx] -- .. which are installed .. - , (I _ver (Inst _), PInfo deps _comps _flagNfo _fr) <- M.toList is + , (I _ver (Inst _), PInfo deps _comps _flagNfo _fr _arts) <- M.toList is -- .. and flatten all their dependencies .. , (LDep _ (Dep (PkgComponent dep _) _ci), _comp) <- flattenFlaggedDeps deps ] diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs index 72d0b8193e3..513853db2f6 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/IndexConversion.hs @@ -25,6 +25,8 @@ import Distribution.PackageDescription.Configuration import qualified Distribution.Simple.PackageIndex as SI import Distribution.System +import Distribution.Solver.Types.ArtifactSelection + ( ArtifactSelection(..), allArtifacts, staticOutsOnly, dynOutsOnly, noOuts ) import Distribution.Solver.Types.ComponentDeps ( Component(..), componentNameToComponent ) import Distribution.Solver.Types.Flag @@ -55,11 +57,12 @@ import Distribution.Solver.Modular.Version -- explicitly requested. convPIs :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint] -> ShadowPkgs -> StrongFlags -> SolveExecutables + -> Maybe (ArtifactSelection, ArtifactSelection) -> SI.InstalledPackageIndex -> CI.PackageIndex (SourcePackage loc) -> Index -convPIs os arch comp constraints sip strfl solveExes iidx sidx = +convPIs os arch comp constraints sip strfl solveExes srcArts iidx sidx = mkIndex $ - convIPI' sip iidx ++ convSPI' os arch comp constraints strfl solveExes sidx + convIPI' sip iidx ++ convSPI' os arch comp constraints strfl solveExes srcArts sidx -- | Convert a Cabal installed package index to the simpler, -- more uniform index format of the solver. @@ -75,8 +78,8 @@ convIPI' (ShadowPkgs sip) idx = where -- shadowing is recorded in the package info - shadow (pn, i, PInfo fdeps comps fds _) - | sip = (pn, i, PInfo fdeps comps fds (Just Shadowed)) + shadow (pn, i, PInfo fdeps comps fds _ arts) + | sip = (pn, i, PInfo fdeps comps fds (Just Shadowed) arts) shadow x = x -- | Extract/recover the package ID from an installed package info, and convert it to a solver's I. @@ -90,8 +93,8 @@ convId ipi = (pn, I ver $ Inst $ IPI.installedUnitId ipi) convIP :: SI.InstalledPackageIndex -> IPI.InstalledPackageInfo -> (PN, I, PInfo) convIP idx ipi = case traverse (convIPId (DependencyReason pn M.empty S.empty) comp idx) (IPI.depends ipi) of - Left u -> (pn, i, PInfo [] M.empty M.empty (Just (Broken u))) - Right fds -> (pn, i, PInfo fds components M.empty Nothing) + Left u -> (pn, i, PInfo [] M.empty M.empty (Just (Broken u)) mempty) + Right fds -> (pn, i, PInfo fds components M.empty Nothing (ipiToAS ipi)) where -- TODO: Handle sub-libraries and visibility. components = @@ -151,21 +154,34 @@ convIPId dr comp idx ipid = -- NB: something we pick up from the -- InstalledPackageIndex is NEVER an executable +-- | Extract the 'ArtifactSelection's representing which artifacts are +-- available in this installed package and which artifacts this installed +-- package requires. Assume both are the same. +ipiToAS :: IPI.InstalledPackageInfo -> (ArtifactSelection, ArtifactSelection) +ipiToAS ipi = (\x -> (x, x)) $ mconcat [statics, dynamics] + where + statics :: ArtifactSelection + statics = if any ($ ipi) [IPI.pkgVanillaLib] then staticOutsOnly else mempty + dynamics :: ArtifactSelection + dynamics = if any ($ ipi) [IPI.pkgSharedLib, IPI.pkgDynExe] then dynOutsOnly else mempty + -- | Convert a cabal-install source package index to the simpler, -- more uniform index format of the solver. convSPI' :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint] - -> StrongFlags -> SolveExecutables + -> StrongFlags -> SolveExecutables -> Maybe (ArtifactSelection, ArtifactSelection) -> CI.PackageIndex (SourcePackage loc) -> [(PN, I, PInfo)] -convSPI' os arch cinfo constraints strfl solveExes = - L.map (convSP os arch cinfo constraints strfl solveExes) . CI.allPackages +convSPI' os arch cinfo constraints strfl solveExes srcArts = + L.map (convSP os arch cinfo constraints strfl solveExes srcArts) . CI.allPackages -- | Convert a single source package into the solver-specific format. convSP :: OS -> Arch -> CompilerInfo -> Map PN [LabeledPackageConstraint] - -> StrongFlags -> SolveExecutables -> SourcePackage loc -> (PN, I, PInfo) -convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) = + -> StrongFlags -> SolveExecutables -> Maybe (ArtifactSelection, ArtifactSelection) + -> SourcePackage loc + -> (PN, I, PInfo) +convSP os arch cinfo constraints strfl solveExes srcArts (SourcePackage (PackageIdentifier pn pv) gpd _ _pl) = let i = I pv InRepo pkgConstraints = fromMaybe [] $ M.lookup pn constraints - in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes pn gpd) + in (pn, i, convGPD os arch cinfo pkgConstraints strfl solveExes srcArts pn gpd) -- We do not use 'flattenPackageDescription' or 'finalizePD' -- from 'Distribution.PackageDescription.Configuration' here, because we @@ -173,9 +189,11 @@ convSP os arch cinfo constraints strfl solveExes (SourcePackage (PackageIdentifi -- | Convert a generic package description to a solver-specific 'PInfo'. convGPD :: OS -> Arch -> CompilerInfo -> [LabeledPackageConstraint] - -> StrongFlags -> SolveExecutables -> PN -> GenericPackageDescription + -> StrongFlags -> SolveExecutables + -> Maybe (ArtifactSelection, ArtifactSelection) + -> PN -> GenericPackageDescription -> PInfo -convGPD os arch cinfo constraints strfl solveExes pn +convGPD os arch cinfo constraints strfl solveExes srcArts pn (GenericPackageDescription pkg scannedVersion flags mlib sub_libs flibs exes tests benchs) = let fds = flagInfo strfl flags @@ -238,7 +256,7 @@ convGPD os arch cinfo constraints strfl solveExes pn isPrivate LibraryVisibilityPrivate = True isPrivate LibraryVisibilityPublic = False - in PInfo flagged_deps components fds fr + in PInfo flagged_deps components fds fr (fromMaybe (allArtifacts, noOuts) srcArts) -- | Applies the given predicate (for example, testing buildability or -- visibility) to the given component and environment. Values are combined with diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs index eb3c98a8aca..9b2b74fa170 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Linking.hs @@ -100,9 +100,9 @@ validateLinking index = (`runReader` initVS) . go goP :: QPN -> POption -> Validate (Tree d c) -> Validate (Tree d c) goP qpn@(Q _pp pn) opt@(POption i _) r = do vs <- ask - let PInfo deps _ _ _ = vsIndex vs ! pn ! i - qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps - newSaved = M.insert qpn qdeps (vsSaved vs) + let PInfo deps _ _ _ _ = vsIndex vs ! pn ! i + qdeps = qualifyDeps (vsQualifyOptions vs) qpn deps + newSaved = M.insert qpn qdeps (vsSaved vs) case execUpdateState (pickPOption qpn opt qdeps) vs of Left (cs, err) -> return $ Fail cs (DependenciesNotLinked err) Right vs' -> local (const vs' { vsSaved = newSaved }) r @@ -349,7 +349,7 @@ verifyLinkGroup lg = -- if a constructor is added to the datatype we won't notice it here Just i -> do vs <- get - let PInfo _deps _exes finfo _ = vsIndex vs ! lgPackage lg ! i + let PInfo _deps _exes finfo _ _ = vsIndex vs ! lgPackage lg ! i flags = M.keys finfo stanzas = [TestStanzas, BenchStanzas] forM_ flags $ \fn -> do diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs index eade1c3a1a0..70f36d036aa 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Message.hs @@ -244,6 +244,7 @@ showFR _ MultipleInstances = " (multiple instances)" showFR c (DependenciesNotLinked msg) = " (dependencies not linked: " ++ msg ++ "; conflict set: " ++ showConflictSet c ++ ")" showFR c CyclicDependencies = " (cyclic dependencies; conflict set: " ++ showConflictSet c ++ ")" showFR _ (UnsupportedSpecVer ver) = " (unsupported spec-version " ++ prettyShow ver ++ ")" +showFR _ (MissingArtifacts arts) = " (missing build artifacts: " ++ prettyShow arts ++ ")" -- The following are internal failures. They should not occur. In the -- interest of not crashing unnecessarily, we still just print an error -- message though. diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs index 3c5b6c5f984..1a2b9785881 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Preference.hs @@ -7,6 +7,7 @@ module Distribution.Solver.Modular.Preference , enforceManualFlags , enforcePackageConstraints , enforceSingleInstanceRestriction + , enforceArtifactRequirements , firstGoal , preferBaseGoalChoice , preferLinked @@ -22,7 +23,9 @@ import Prelude () import Distribution.Solver.Compat.Prelude import qualified Data.List as L +import Data.Map ((!)) import qualified Data.Map as M +import qualified Data.Set as S import Control.Monad.Trans.Reader (Reader, runReader, ask, local) import Distribution.PackageDescription (lookupFlagAssignment, unFlagAssignment) -- from Cabal @@ -36,8 +39,11 @@ import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.PackagePreferences import Distribution.Solver.Types.Variable +import Distribution.Solver.Types.ArtifactSelection +import Distribution.Solver.Modular.Assignment import Distribution.Solver.Modular.Dependency import Distribution.Solver.Modular.Flag +import Distribution.Solver.Modular.Index import Distribution.Solver.Modular.Package import qualified Distribution.Solver.Modular.PSQ as P import Distribution.Solver.Modular.Tree @@ -510,3 +516,218 @@ enforceSingleInstanceRestriction = (`runReader` M.empty) . go (Nothing, Just qpn') -> do -- Not linked, already used. This is an error return $ Fail (CS.union (varToConflictSet (P qpn)) (varToConflictSet (P qpn'))) MultipleInstances + +-- | Monad used internally in 'enforceArtifactRequirements'. +-- +-- Track which 'I's / 'POptions' and values for other variables would be chosen +-- up to our location if this path in the tree were taken. That lets us lookup +-- dependencies and consult the index to retrieve the 'PInfo' of the +-- dependencies to see what build artifacts they provide. +-- +-- Also track choices (flag and stanza choices) that we know would introduce a +-- dependency between two solved package options with conflicting build artifact +-- requirements and availability. +type EnforceAR = Reader (Assignment, ARUndeterminedDeps) + +-- | Internal map of variable choices that would introduce a conflict for the +-- artifact requirements check. +data ARUndeterminedDeps + = ARDeps ARReveal (Map ARChoice ARUndeterminedDeps) + deriving (Eq) + +instance Semigroup ARUndeterminedDeps where + ARDeps ar ad <> ARDeps br bd = ARDeps (ar <> br) (M.unionWith (<>) ad bd) + +instance Monoid ARUndeterminedDeps where + mempty = ARDeps mempty M.empty + +-- | Representation of a variable choice with information relevant to the +-- artifact requirements checker. +data ARChoice = ARPackage QPN ArtifactSelection | ARFlag QFN Bool | ARStanza QSN + deriving (Eq, Ord) + +-- | Used to track failures that the artifact requirements checker detects. +data ARReveal + = ARReveal (Maybe ARFailure) + deriving (Eq) + +instance Semigroup ARReveal where + ARReveal Nothing <> b = b + a@(ARReveal (Just _)) <> _ = a + +instance Monoid ARReveal where + mempty = ARReveal Nothing + +-- | An alias for a failure node in the tree. +type ARFailure = (ConflictSet, FailReason) + +-- | If a package depends on a dependency and we consider a package option to +-- satisfy that dependency that does not provide the required build artifacts, +-- detect this condition so we can mark this path in the search tree as invalid +-- with this 'MissingArtifacts' reason. +enforceArtifactRequirements :: Index -> Tree d c -> Tree d c +enforceArtifactRequirements idx = (`runReader` initialTracking) . go + where + -- No assignments or conditional choices are made in the beginning. + initialTracking :: (Assignment, ARUndeterminedDeps) + initialTracking = (A M.empty M.empty M.empty, mempty) + + -- For all child nodes, note that we made a choice that brought about any + -- conflict. + failingChoice :: CS.ConflictSet -> ARUndeterminedDeps -> ARUndeterminedDeps + failingChoice annotation (ARDeps failure choices) = ARDeps failure' choices' + where + (ARReveal arr) = failure + failure' = ARReveal $ (\(cs, fr) -> (annotation `CS.union` cs, fr)) <$> arr + choices' = failingChoice annotation <$> choices + + -- Convert a package dependency, optionally conditional on a flag or stanza + -- have not tried yet, into our tracker so we can merge and reduce it. + depToAR :: Assignment -> QPN -> ArtifactSelection -> FlaggedDep QPN -> ARUndeterminedDeps + depToAR assn@(A _pa fa _sa) qpn requiredArts (Flagged qfn _fInfo trueDeps falseDeps) + = let + flagAR b = ARFlag qfn b + failing = failingChoice (CS.singleton $ F qfn) + conflicting True = failing $ foldMap (depToAR assn qpn requiredArts) trueDeps + conflicting False = failing $ foldMap (depToAR assn qpn requiredArts) falseDeps + in + case M.lookup qfn fa of + (Just b) -> conflicting b + (Nothing) -> ARDeps mempty (M.fromList [(flagAR b, conflicting b) | b <- [True, False]]) + depToAR assn@(A _pa _fa sa) qpn requiredArts (Stanza qsn trueDeps) + = let + stanzaAR = ARStanza qsn + failing = failingChoice (CS.singleton $ S qsn) + conflicting = failing $ foldMap (depToAR assn qpn requiredArts) trueDeps + in + case M.lookup qsn sa of + (Just False) -> mempty + (Just True) -> conflicting + (Nothing) -> ARDeps mempty (M.singleton stanzaAR conflicting) + depToAR _ qpn requiredArts (Simple (LDep _dr (Dep (PkgComponent dep _) _ci)) _comp) + = let + rdepAR providedArts = ARPackage dep providedArts + conflicting providedArts = ARDeps (ARReveal $ Just (cs, fr providedArts)) M.empty + cs = cps [qpn, dep] + fr providedArts = MissingArtifacts $ requiredArts `artsDifference` providedArts + cps qpns = foldr CS.union CS.empty . map (CS.singleton . P) $ qpns + + choices = M.fromList $ + [ (rdepAR providedArts, conflicting providedArts) + | providedArts <- asSelections + , not $ requiredArts `artsSubsetOf` providedArts + ] + in ARDeps mempty choices + depToAR _ _qpn _requiredArts (Simple (LDep _dr _) _comp) = mempty + + -- Find the powerlist. + powerlist :: [a] -> [[a]] + powerlist [] = [[]] + powerlist (x:xs) = [zs | ys <- powerlist xs, zs <- [ys, x:ys]] + + -- All possible selections; there are just 4. + asSelections :: [ArtifactSelection] + asSelections = toAs <$> powerlist asKinds + where + toAs = ArtifactSelection . S.fromList + asKinds = let ArtifactSelection asSet = allArtifacts in S.toList asSet + + -- Find all of the few choices that would contradict one just made. + -- Used to trim the 'ARUndeterminedDeps' tree of choices we know we will + -- not make. + compl :: ARChoice -> [ARChoice] + compl (ARFlag qfn b) = [ARFlag qfn b' | b' <- [True, False], b' /= b] + compl (ARStanza _qsn) = [] + compl (ARPackage qpn providedArts) = [ARPackage qpn as | as <- asSelections, as /= providedArts] + + -- See if we can reduce the record of conditional failures once we make a + -- choice. + reduceARDeps :: ARChoice -> ARUndeterminedDeps -> ARUndeterminedDeps + reduceARDeps choice _arDeps@(ARDeps arr choices) = + case M.lookup choice choices of + (Nothing) -> + ARDeps arr (reduceARDeps choice <$> choices) + (Just arDeps'@(ARDeps arr' choices')) -> + case arr of + (ARReveal (Just _)) -> + ARDeps (arr <> arr') (reduceARDeps choice <$> (trim $ M.delete choice choices <> choices')) + _ -> + arDeps' + where + trim = foldr (\x acc -> M.delete x . acc) id $ compl choice + + -- Selecting a package, flag, or stanza can introduce a missing artifact + -- condition. Check each possible location. + go :: Tree d c -> EnforceAR (Tree d c) + go (PChoice qpn rdm gr cs) = + PChoice qpn rdm gr <$> sequenceA (W.mapWithKey (goP qpn) (fmap go cs)) + go (FChoice qfn rdm y t m d ts) = + FChoice qfn rdm y t m d <$> sequenceA (W.mapWithKey (goF qfn) (fmap go ts)) + go (SChoice qsn rdm y t ts) = + SChoice qsn rdm y t <$> sequenceA (W.mapWithKey (goS qsn) (fmap go ts)) + go (GoalChoice rdm ts) = + GoalChoice rdm <$> traverse go ts + go x@(Fail _ _) = return x + go x@(Done _ _) = return x + + -- Helper routine that inserts fail nodes if we detect a missing artifact + -- condition for this choice. + arGuard :: CS.ConflictSet -> EnforceAR (Tree d c) -> EnforceAR (Tree d c) + arGuard annotation r = do + -- Make sure we don't detect a conflict. + (_assn, arDeps) <- ask + case arDeps of + (ARDeps (ARReveal (Just failure) ) _choices) -> do + -- (Redundantly ensure that our choice is part of the conflict set.) + let + (cs, fr) = failure + cs' = cs `CS.union` annotation + return $ Fail cs' fr + _ -> do + r + + -- Try a package choice. + goP :: QPN -> POption -> EnforceAR (Tree d c) -> EnforceAR (Tree d c) + goP qpn@(Q _ pn) (POption i _) r = do + -- We are trying an instance. Our job here is to detect when a choice + -- would introduce a case of missing artifacts (one package depends on + -- another that doesn't provide the build artifacts the first requires). + -- We'll also track what assignments we would make if we took this path + -- in the tree, and we'll also track which choices would introduce this + -- condition. + + -- Get the dependencies of this 'I' and the build artifacts it provides + -- and requires. + let PInfo deps _exes _finfo _fr (providedArts, requiredArts) = idx ! pn ! i + + let + qdeps = qualifyDeps (defaultQualifyOptions idx) qpn deps + + assign (A pa fa sa, arDeps) = (A (M.insert qpn i $ pa) fa sa, arDeps) + merge (assn, arDeps) = (assn, arDeps <> foldMap (depToAR assn qpn requiredArts) qdeps) + reduce (assn, arDeps) = (assn, reduceARDeps (ARPackage qpn providedArts) $ arDeps) + local (reduce . merge . assign) $ do + arGuard (varToConflictSet (P qpn)) $ do + r + + -- Try a flag choice. + goF :: QFN -> Bool -> EnforceAR (Tree d c) -> EnforceAR (Tree d c) + goF qfn@(FN _qpn@(Q _ _pn) _f) b r = do + let + assign (A pa fa sa, arDeps) = (A pa (M.insert qfn b $ fa) sa, arDeps) + reduce (assn, arDeps) = (assn, reduceARDeps (ARFlag qfn b) $ arDeps) + local (reduce . assign) $ do + arGuard (varToConflictSet (F qfn)) $ do + r + + -- Try a stanza choice. + goS :: QSN -> Bool -> EnforceAR (Tree d c) -> EnforceAR (Tree d c) + goS qsn@(SN (Q _pp _pn) _s) b r = do + let + assign (A pa fa sa, arDeps) = (A pa fa (M.insert qsn b $ sa), arDeps) + reduce (assn, arDeps) + | True <- b = (assn, reduceARDeps (ARStanza qsn) $ arDeps) + | otherwise = (assn, arDeps) + local (reduce . assign) $ do + arGuard (varToConflictSet (S qsn)) $ do + r diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs index 467a743c1da..ba72df0c64b 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Solver.hs @@ -19,6 +19,7 @@ import Distribution.Verbosity import Distribution.Compiler (CompilerInfo) +import Distribution.Solver.Types.ArtifactSelection import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.PackagePreferences import Distribution.Solver.Types.PkgConfigDb (PkgConfigDb) @@ -73,7 +74,9 @@ data SolverConfig = SolverConfig { solveExecutables :: SolveExecutables, goalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering), solverVerbosity :: Verbosity, - pruneAfterFirstSuccess :: PruneAfterFirstSuccess + pruneAfterFirstSuccess :: PruneAfterFirstSuccess, + requireArtifacts :: RequireArtifacts, + sourceArtifacts :: Maybe (ArtifactSelection, ArtifactSelection) } -- | Whether to remove all choices after the first successful choice at each @@ -136,7 +139,8 @@ solve sc cinfo idx pkgConfigDB userPrefs userConstraints userGoals = P.preferPackagePreferences userPrefs validationPhase = P.enforcePackageConstraints userConstraints . P.enforceManualFlags userConstraints - validationCata = P.enforceSingleInstanceRestriction . + validationCata = (if asBool (requireArtifacts sc) then P.enforceArtifactRequirements idx else id) . + P.enforceSingleInstanceRestriction . validateLinking idx . validateTree cinfo idx pkgConfigDB prunePhase = (if asBool (avoidReinstalls sc) then P.avoidReinstalls (const True) else id) . diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs index 039da4b41b0..194f26e81be 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Tree.hs @@ -30,6 +30,7 @@ import Distribution.Solver.Modular.PSQ (PSQ) import Distribution.Solver.Modular.Version import Distribution.Solver.Modular.WeightedPSQ (WeightedPSQ) import qualified Distribution.Solver.Modular.WeightedPSQ as W +import Distribution.Solver.Types.ArtifactSelection import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.Flag import Distribution.Solver.Types.PackagePath @@ -129,6 +130,7 @@ data FailReason = UnsupportedExtension Extension | DependenciesNotLinked String | CyclicDependencies | UnsupportedSpecVer Ver + | MissingArtifacts ArtifactSelection deriving (Eq, Show) -- | Information about a dependency involved in a conflict, for error messages. diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs index 54911f2c367..609be59c8c8 100644 --- a/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install-solver/src/Distribution/Solver/Modular/Validate.hs @@ -210,7 +210,7 @@ validate = go rComps <- asks requiredComponents qo <- asks qualifyOptions -- obtain dependencies and index-dictated exclusions introduced by the choice - let (PInfo deps comps _ mfr) = idx ! pn ! i + let (PInfo deps comps _ mfr _) = idx ! pn ! i -- qualify the deps in the current scope let qdeps = qualifyDeps qo qpn deps -- the new active constraints are given by the instance we have chosen, diff --git a/cabal-install-solver/src/Distribution/Solver/Types/ArtifactSelection.hs b/cabal-install-solver/src/Distribution/Solver/Types/ArtifactSelection.hs new file mode 100644 index 00000000000..7acefb8a6e5 --- /dev/null +++ b/cabal-install-solver/src/Distribution/Solver/Types/ArtifactSelection.hs @@ -0,0 +1,76 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +-- | Provide a type for categorizing artifact requirements. +module Distribution.Solver.Types.ArtifactSelection + ( ArtifactSelection(..) + , ArtifactKind(..) + , allArtifacts + , dynOutsOnly + , staticOutsOnly + , noOuts + , unArtifactSelection + , artsSubsetOf + , artsDifference + ) where + +import Distribution.Solver.Compat.Prelude +import Prelude () + +import qualified Data.Set as S + +import Distribution.Pretty ( Pretty(pretty) ) +import qualified Text.PrettyPrint as PP + +-- | A type for specifying which artifacts are available to be required. +newtype ArtifactSelection = ArtifactSelection (S.Set ArtifactKind) + deriving (Eq, Show, Ord, Generic, Semigroup, Monoid) + +instance Pretty ArtifactSelection where + pretty arts + | arts == allArtifacts = PP.text "all artifacts" + | arts == dynOutsOnly = PP.text "dynamic artifacts" + | arts == staticOutsOnly = PP.text "static artifacts" + | arts == noOuts = PP.text "no output artifacts" + | otherwise = PP.text "unknown artifacts" + +instance Binary ArtifactSelection +instance Structured ArtifactSelection + +-- | Specific kinds of artifacts. +data ArtifactKind + = DynOuts -- ^ Exclude static outputs. + | StaticOuts -- ^ Exclude dynamic outputs. + deriving (Eq, Show, Generic, Ord) + +instance Binary ArtifactKind +instance Structured ArtifactKind + +-- | ArtifactSelection alias: e.g. dynamic and static interface files. +allArtifacts :: ArtifactSelection +allArtifacts = ArtifactSelection $ S.fromList [DynOuts, StaticOuts] + +-- | ArtifactSelection alias: exclude static outputs. +dynOutsOnly :: ArtifactSelection +dynOutsOnly = ArtifactSelection $ S.fromList [DynOuts] + +-- | ArtifactSelection alias: exclude static outputs. +staticOutsOnly :: ArtifactSelection +staticOutsOnly = ArtifactSelection $ S.fromList [StaticOuts] + +-- | ArtifactSelection alias: exclude all artifacts. +noOuts :: ArtifactSelection +noOuts = ArtifactSelection $ S.fromList [] + +-- | Obtain the set of artifact kinds included in this artifact selection. +unArtifactSelection :: ArtifactSelection -> S.Set ArtifactKind +unArtifactSelection (ArtifactSelection set) = set + +-- | Is a selection a subset of another? +artsSubsetOf :: ArtifactSelection -> ArtifactSelection -> Bool +artsSubsetOf = S.isSubsetOf `on` unArtifactSelection + +-- | Return artifacts in the first set not present in the second set. +artsDifference :: ArtifactSelection -> ArtifactSelection -> ArtifactSelection +artsDifference (ArtifactSelection a) (ArtifactSelection b) = + ArtifactSelection $ a `S.difference` b diff --git a/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs b/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs index 4b7fe65b769..077d9fd8fb3 100644 --- a/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs +++ b/cabal-install-solver/src/Distribution/Solver/Types/Settings.hs @@ -14,6 +14,7 @@ module Distribution.Solver.Types.Settings , CountConflicts(..) , FineGrainedConflicts(..) , SolveExecutables(..) + , RequireArtifacts(..) ) where import Distribution.Solver.Compat.Prelude @@ -69,6 +70,9 @@ newtype EnableBackjumping = EnableBackjumping Bool newtype SolveExecutables = SolveExecutables Bool deriving (BooleanFlag, Eq, Generic, Show) +newtype RequireArtifacts = RequireArtifacts Bool + deriving (BooleanFlag, Eq, Generic, Show) + instance Binary ReorderGoals instance Binary CountConflicts instance Binary FineGrainedConflicts @@ -81,6 +85,7 @@ instance Binary StrongFlags instance Binary AllowBootLibInstalls instance Binary OnlyConstrained instance Binary SolveExecutables +instance Binary RequireArtifacts instance Structured ReorderGoals instance Structured CountConflicts @@ -94,6 +99,7 @@ instance Structured StrongFlags instance Structured AllowBootLibInstalls instance Structured OnlyConstrained instance Structured SolveExecutables +instance Structured RequireArtifacts instance Pretty OnlyConstrained where pretty OnlyConstrainedAll = PP.text "all" diff --git a/cabal-install/src/Distribution/Client/Config.hs b/cabal-install/src/Distribution/Client/Config.hs index 023d6a6fdbc..dcac8b8447e 100644 --- a/cabal-install/src/Distribution/Client/Config.hs +++ b/cabal-install/src/Distribution/Client/Config.hs @@ -310,6 +310,7 @@ instance Semigroup SavedConfig where installStrongFlags = combine installStrongFlags, installAllowBootLibInstalls = combine installAllowBootLibInstalls, installOnlyConstrained = combine installOnlyConstrained, + installRequireArtifacts = combine installRequireArtifacts, installReinstall = combine installReinstall, installAvoidReinstalls = combine installAvoidReinstalls, installOverrideReinstall = combine installOverrideReinstall, diff --git a/cabal-install/src/Distribution/Client/Configure.hs b/cabal-install/src/Distribution/Client/Configure.hs index 2cbe16096a4..9bac018d994 100644 --- a/cabal-install/src/Distribution/Client/Configure.hs +++ b/cabal-install/src/Distribution/Client/Configure.hs @@ -41,6 +41,7 @@ import Distribution.Client.Targets ( userToPackageConstraint, userConstraintPackageName ) import Distribution.Client.JobControl (Lock) +import Distribution.Solver.Types.ArtifactSelection import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.Settings import Distribution.Solver.Types.ConstraintSource @@ -308,6 +309,12 @@ planLocalPackage verbosity comp platform configFlags configExFlags benchmarksEnabled = fromFlagOrDefault False $ configBenchmarks configFlags + sourceArts = mconcat $ + [ sourceArtsOf staticOutsOnly [(configVanillaLib, True)] + , sourceArtsOf dynOutsOnly [(configSharedLib, False), (configDynExe, False)] + ] + sourceArtsOf arts fs = if any (\(fld, def) -> fromFlagOrDefault def . (fld $) $ configFlags) fs then arts else mempty + resolverParams :: DepResolverParams resolverParams = removeLowerBounds @@ -320,6 +327,8 @@ planLocalPackage verbosity comp platform configFlags configExFlags [ PackageVersionPreference name ver | PackageVersionConstraint name ver <- configPreferences configExFlags ] + . setSourceArtifacts (Just (sourceArts, sourceArts)) + . addConstraints -- version constraints from the config file or command line -- TODO: should warn or error on constraints that are not on direct diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs index c5cbba8d48e..5ad6047f355 100644 --- a/cabal-install/src/Distribution/Client/Dependency.hs +++ b/cabal-install/src/Distribution/Client/Dependency.hs @@ -53,6 +53,8 @@ module Distribution.Client.Dependency ( setStrongFlags, setAllowBootLibInstalls, setOnlyConstrained, + setRequireArtifacts, + setSourceArtifacts, setMaxBackjumps, setEnableBackjumping, setSolveExecutables, @@ -105,6 +107,7 @@ import Distribution.Verbosity import Distribution.Version import qualified Distribution.Compat.Graph as Graph +import Distribution.Solver.Types.ArtifactSelection (ArtifactSelection) import Distribution.Solver.Types.ComponentDeps (ComponentDeps) import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.ConstraintSource @@ -174,7 +177,9 @@ data DepResolverParams = DepResolverParams { -- | Function to override the solver's goal-ordering heuristics. depResolverGoalOrder :: Maybe (Variable QPN -> Variable QPN -> Ordering), - depResolverVerbosity :: Verbosity + depResolverVerbosity :: Verbosity, + depResolverRequireArtifacts :: RequireArtifacts, + depResolverSourceArtifacts :: Maybe (ArtifactSelection, ArtifactSelection) } showDepResolverParams :: DepResolverParams -> String @@ -199,6 +204,9 @@ showDepResolverParams p = ++ "\nonly constrained packages: " ++ show (depResolverOnlyConstrained p) ++ "\nmax backjumps: " ++ maybe "infinite" show (depResolverMaxBackjumps p) + ++ "\nrequire artifacts: " ++ show (asBool (depResolverRequireArtifacts p)) + ++ "\nsource artifacts provided: " ++ fromMaybe "(default)" (prettyShow . fst <$> depResolverSourceArtifacts p) + ++ "\nsource artifacts required: " ++ fromMaybe "(default)" (prettyShow . snd <$> depResolverSourceArtifacts p) where showLabeledConstraint :: LabeledPackageConstraint -> String showLabeledConstraint (LabeledPackageConstraint pc src) = @@ -259,7 +267,9 @@ basicDepResolverParams installedPkgIndex sourcePkgIndex = depResolverEnableBackjumping = EnableBackjumping True, depResolverSolveExecutables = SolveExecutables True, depResolverGoalOrder = Nothing, - depResolverVerbosity = normal + depResolverVerbosity = normal, + depResolverRequireArtifacts = RequireArtifacts True, + depResolverSourceArtifacts = Nothing } addTargets :: [PackageName] @@ -352,6 +362,18 @@ setOnlyConstrained i params = depResolverOnlyConstrained = i } +setRequireArtifacts :: RequireArtifacts -> DepResolverParams -> DepResolverParams +setRequireArtifacts i params = + params { + depResolverRequireArtifacts = i + } + +setSourceArtifacts :: Maybe (ArtifactSelection, ArtifactSelection) -> DepResolverParams -> DepResolverParams +setSourceArtifacts i params = + params { + depResolverSourceArtifacts = i + } + setMaxBackjumps :: Maybe Int -> DepResolverParams -> DepResolverParams setMaxBackjumps n params = params { @@ -711,7 +733,8 @@ resolveDependencies platform comp pkgConfigDB solver params = $ runSolver solver (SolverConfig reordGoals cntConflicts fineGrained minimize indGoals noReinstalls shadowing strFlags allowBootLibs onlyConstrained_ maxBkjumps enableBj - solveExes order verbosity (PruneAfterFirstSuccess False)) + solveExes order verbosity (PruneAfterFirstSuccess False) + requireArts sourceArts) platform comp installedPkgIndex sourcePkgIndex pkgConfigDB preferences constraints targets where @@ -735,7 +758,9 @@ resolveDependencies platform comp pkgConfigDB solver params = enableBj solveExes order - verbosity) = + verbosity + requireArts + sourceArts) = if asBool (depResolverAllowBootLibInstalls params) then params else dontUpgradeNonUpgradeablePackages params @@ -997,7 +1022,8 @@ resolveWithoutDependencies (DepResolverParams targets constraints _reorderGoals _countConflicts _fineGrained _minimizeConflictSet _indGoals _avoidReinstalls _shadowing _strFlags _maxBjumps _enableBj _solveExes - _allowBootLibInstalls _onlyConstrained _order _verbosity) = + _allowBootLibInstalls _onlyConstrained _order _verbosity + _requireArtifacts _sourceArtifacts) = collectEithers $ map selectPackage (Set.toList targets) where selectPackage :: PackageName -> Either ResolveNoDepsError UnresolvedSourcePackage diff --git a/cabal-install/src/Distribution/Client/Fetch.hs b/cabal-install/src/Distribution/Client/Fetch.hs index 9dcdfb902a9..c44527f1b11 100644 --- a/cabal-install/src/Distribution/Client/Fetch.hs +++ b/cabal-install/src/Distribution/Client/Fetch.hs @@ -170,6 +170,8 @@ planPackages verbosity comp platform fetchFlags . setOnlyConstrained onlyConstrained + . setRequireArtifacts requireArtifacts + . setSolverVerbosity verbosity . addConstraints @@ -205,6 +207,7 @@ planPackages verbosity comp platform fetchFlags maxBackjumps = fromFlag (fetchMaxBackjumps fetchFlags) allowBootLibInstalls = fromFlag (fetchAllowBootLibInstalls fetchFlags) onlyConstrained = fromFlag (fetchOnlyConstrained fetchFlags) + requireArtifacts = fromFlag (fetchRequireArtifacts fetchFlags) checkTarget :: Verbosity -> UserTarget -> IO () diff --git a/cabal-install/src/Distribution/Client/Freeze.hs b/cabal-install/src/Distribution/Client/Freeze.hs index ff9f6fde91a..1cd648c1592 100644 --- a/cabal-install/src/Distribution/Client/Freeze.hs +++ b/cabal-install/src/Distribution/Client/Freeze.hs @@ -178,6 +178,8 @@ planPackages verbosity comp platform freezeFlags . setOnlyConstrained onlyConstrained + . setRequireArtifacts requireArtifacts + . setSolverVerbosity verbosity . addConstraints @@ -206,6 +208,7 @@ planPackages verbosity comp platform freezeFlags maxBackjumps = fromFlag (freezeMaxBackjumps freezeFlags) allowBootLibInstalls = fromFlag (freezeAllowBootLibInstalls freezeFlags) onlyConstrained = fromFlag (freezeOnlyConstrained freezeFlags) + requireArtifacts = fromFlag (freezeRequireArtifacts freezeFlags) -- | Remove all unneeded packages from an install plan. diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index 2baa8af9e49..ddc09d9cc13 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -89,6 +89,7 @@ import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade import qualified Distribution.InstalledPackageInfo as Installed import Distribution.Client.JobControl +import Distribution.Solver.Types.ArtifactSelection import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.Settings @@ -375,6 +376,10 @@ planPackages verbosity comp platform solver . setOnlyConstrained onlyConstrained + . setRequireArtifacts requireArtifacts + + . setSourceArtifacts sourceArtifacts + . setSolverVerbosity verbosity . setPreferenceDefault (if upgradeDeps then PreferAllLatest @@ -438,6 +443,8 @@ planPackages verbosity comp platform solver maxBackjumps = fromFlag (installMaxBackjumps installFlags) allowBootLibInstalls = fromFlag (installAllowBootLibInstalls installFlags) onlyConstrained = fromFlag (installOnlyConstrained installFlags) + requireArtifacts = fromFlag (installRequireArtifacts installFlags) + sourceArtifacts = Just (sourceArts, sourceArts) upgradeDeps = fromFlag (installUpgradeDeps installFlags) onlyDeps = fromFlag (installOnlyDeps installFlags) @@ -446,6 +453,12 @@ planPackages verbosity comp platform solver allowNewer = fromMaybe (AllowNewer mempty) (configAllowNewer configExFlags) + sourceArts = mconcat $ + [ sourceArtsOf staticOutsOnly [(configVanillaLib, True)] + , sourceArtsOf dynOutsOnly [(configSharedLib, False), (configDynExe, False)] + ] + sourceArtsOf arts fs = if any (\(fld, def) -> fromFlagOrDefault def . (fld $) $ configFlags) fs then arts else mempty + -- | Remove the provided targets from the install plan. pruneInstallPlan :: Package targetpkg => [PackageSpecifier targetpkg] diff --git a/cabal-install/src/Distribution/Client/ProjectConfig.hs b/cabal-install/src/Distribution/Client/ProjectConfig.hs index 645ebe6f621..2f903c24bbc 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig.hs @@ -85,6 +85,7 @@ import Distribution.Client.HttpUtils , downloadURI ) import Distribution.Client.Utils.Parsec (renderParseError) +import Distribution.Solver.Types.ArtifactSelection import Distribution.Solver.Types.SourcePackage import Distribution.Solver.Types.Settings import Distribution.Solver.Types.PackageConstraint @@ -221,7 +222,7 @@ projectConfigWithSolverRepoContext verbosity -- 'SolverSettings' with no optional fields (by applying defaults). -- resolveSolverSettings :: ProjectConfig -> SolverSettings -resolveSolverSettings ProjectConfig{ +resolveSolverSettings projectConfig@ProjectConfig{ projectConfigShared, projectConfigLocalPackages, projectConfigSpecificPackage @@ -251,6 +252,8 @@ resolveSolverSettings ProjectConfig{ solverSettingStrongFlags = fromFlag projectConfigStrongFlags solverSettingAllowBootLibInstalls = fromFlag projectConfigAllowBootLibInstalls solverSettingOnlyConstrained = fromFlag projectConfigOnlyConstrained + solverSettingRequireArtifacts = fromFlag projectConfigRequireArtifacts + solverSettingSourceArtifacts = artsFromPackageConfig (projectConfigAllPackages projectConfig) solverSettingIndexState = flagToMaybe projectConfigIndexState solverSettingActiveRepos = flagToMaybe projectConfigActiveRepos solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals @@ -275,6 +278,7 @@ resolveSolverSettings ProjectConfig{ projectConfigStrongFlags = Flag (StrongFlags False), projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls False), projectConfigOnlyConstrained = Flag OnlyConstrainedNone, + projectConfigRequireArtifacts = Flag (RequireArtifacts True), projectConfigIndependentGoals = Flag (IndependentGoals False), projectConfigPreferOldest = Flag (PreferOldest False) --projectConfigShadowPkgs = Flag False, @@ -284,6 +288,12 @@ resolveSolverSettings ProjectConfig{ --projectConfigUpgradeDeps = Flag False } + artsFromPackageConfig packageConfig = (\arts -> Just (arts, arts)) . mconcat $ + [ sourceArtsOf packageConfig staticOutsOnly [(packageConfigVanillaLib, True)] + , sourceArtsOf packageConfig dynOutsOnly [(packageConfigSharedLib, False), (packageConfigDynExe, False)] + ] + sourceArtsOf packageConfig arts fs = if any (\(fld, def) -> fromFlagOrDefault def . (fld $) $ packageConfig) fs then arts else mempty + -- | Resolve the project configuration, with all its optional fields, into -- 'BuildTimeSettings' with no optional fields (by applying defaults). diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs index 95c3fad5629..aaaf98b4ae7 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -535,7 +535,8 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags --installShadowPkgs = projectConfigShadowPkgs, installStrongFlags = projectConfigStrongFlags, installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, - installOnlyConstrained = projectConfigOnlyConstrained + installOnlyConstrained = projectConfigOnlyConstrained, + installRequireArtifacts = projectConfigRequireArtifacts } = installFlags ProjectFlags @@ -782,6 +783,7 @@ convertToLegacySharedConfig installStrongFlags = projectConfigStrongFlags, installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, installOnlyConstrained = projectConfigOnlyConstrained, + installRequireArtifacts = projectConfigRequireArtifacts, installOnly = mempty, installOnlyDeps = projectConfigOnlyDeps, installIndexState = projectConfigIndexState, @@ -1192,7 +1194,7 @@ legacySharedConfigFieldDescrs constraintSrc = concat , "max-backjumps", "reorder-goals", "count-conflicts" , "fine-grained-conflicts" , "minimize-conflict-set", "independent-goals", "prefer-oldest" , "strong-flags" , "allow-boot-library-installs" - , "reject-unconstrained-dependencies", "index-state" + , "reject-unconstrained-dependencies", "require-artifacts", "index-state" ] . commandOptionsToFields $ installOptions ParseArgs diff --git a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs index 143e8fb1049..c663cc58c20 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Types.hs @@ -42,6 +42,7 @@ import Distribution.Client.IndexUtils.ActiveRepos import Distribution.Client.CmdInstall.ClientInstallFlags ( ClientInstallFlags(..) ) +import Distribution.Solver.Types.ArtifactSelection import Distribution.Solver.Types.Settings import Distribution.Solver.Types.ConstraintSource @@ -201,6 +202,7 @@ data ProjectConfigShared projectConfigStrongFlags :: Flag StrongFlags, projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls, projectConfigOnlyConstrained :: Flag OnlyConstrained, + projectConfigRequireArtifacts :: Flag RequireArtifacts, projectConfigPerComponent :: Flag Bool, projectConfigIndependentGoals :: Flag IndependentGoals, projectConfigPreferOldest :: Flag PreferOldest, @@ -412,6 +414,8 @@ data SolverSettings solverSettingStrongFlags :: StrongFlags, solverSettingAllowBootLibInstalls :: AllowBootLibInstalls, solverSettingOnlyConstrained :: OnlyConstrained, + solverSettingRequireArtifacts :: RequireArtifacts, + solverSettingSourceArtifacts :: Maybe (ArtifactSelection, ArtifactSelection), solverSettingIndexState :: Maybe TotalIndexState, solverSettingActiveRepos :: Maybe ActiveRepos, solverSettingIndependentGoals :: IndependentGoals, diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs index 594fec5b2d1..2ea79ae7de4 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1075,6 +1075,10 @@ planPackages verbosity comp platform solver SolverSettings{..} . setOnlyConstrained solverSettingOnlyConstrained + . setRequireArtifacts solverSettingRequireArtifacts + + . setSourceArtifacts solverSettingSourceArtifacts + . setSolverVerbosity verbosity --TODO: [required eventually] decide if we need to prefer diff --git a/cabal-install/src/Distribution/Client/Setup.hs b/cabal-install/src/Distribution/Client/Setup.hs index b4653f977b6..77d32919873 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -956,6 +956,7 @@ data FetchFlags = FetchFlags { fetchStrongFlags :: Flag StrongFlags, fetchAllowBootLibInstalls :: Flag AllowBootLibInstalls, fetchOnlyConstrained :: Flag OnlyConstrained, + fetchRequireArtifacts :: Flag RequireArtifacts, fetchTests :: Flag Bool, fetchBenchmarks :: Flag Bool, fetchVerbosity :: Flag Verbosity @@ -978,6 +979,7 @@ defaultFetchFlags = FetchFlags { fetchStrongFlags = Flag (StrongFlags False), fetchAllowBootLibInstalls = Flag (AllowBootLibInstalls False), fetchOnlyConstrained = Flag OnlyConstrainedNone, + fetchRequireArtifacts = Flag (RequireArtifacts True), fetchTests = toFlag False, fetchBenchmarks = toFlag False, fetchVerbosity = toFlag normal @@ -1042,6 +1044,7 @@ fetchCommand = CommandUI { fetchStrongFlags (\v flags -> flags { fetchStrongFlags = v }) fetchAllowBootLibInstalls (\v flags -> flags { fetchAllowBootLibInstalls = v }) fetchOnlyConstrained (\v flags -> flags { fetchOnlyConstrained = v }) + fetchRequireArtifacts (\v flags -> flags { fetchRequireArtifacts = v }) } @@ -1065,6 +1068,7 @@ data FreezeFlags = FreezeFlags { freezeStrongFlags :: Flag StrongFlags, freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls, freezeOnlyConstrained :: Flag OnlyConstrained, + freezeRequireArtifacts :: Flag RequireArtifacts, freezeVerbosity :: Flag Verbosity } @@ -1085,6 +1089,7 @@ defaultFreezeFlags = FreezeFlags { freezeStrongFlags = Flag (StrongFlags False), freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False), freezeOnlyConstrained = Flag OnlyConstrainedNone, + freezeRequireArtifacts = Flag (RequireArtifacts True), freezeVerbosity = toFlag normal } @@ -1140,6 +1145,7 @@ freezeCommand = CommandUI { freezeStrongFlags (\v flags -> flags { freezeStrongFlags = v }) freezeAllowBootLibInstalls (\v flags -> flags { freezeAllowBootLibInstalls = v }) freezeOnlyConstrained (\v flags -> flags { freezeOnlyConstrained = v }) + freezeRequireArtifacts (\v flags -> flags { freezeRequireArtifacts = v }) } @@ -1587,6 +1593,7 @@ data InstallFlags = InstallFlags { installStrongFlags :: Flag StrongFlags, installAllowBootLibInstalls :: Flag AllowBootLibInstalls, installOnlyConstrained :: Flag OnlyConstrained, + installRequireArtifacts :: Flag RequireArtifacts, installReinstall :: Flag Bool, installAvoidReinstalls :: Flag AvoidReinstalls, installOverrideReinstall :: Flag Bool, @@ -1630,6 +1637,7 @@ defaultInstallFlags = InstallFlags { installStrongFlags = Flag (StrongFlags False), installAllowBootLibInstalls = Flag (AllowBootLibInstalls False), installOnlyConstrained = Flag OnlyConstrainedNone, + installRequireArtifacts = Flag (RequireArtifacts True), installReinstall = Flag False, installAvoidReinstalls = Flag (AvoidReinstalls False), installOverrideReinstall = Flag False, @@ -1855,7 +1863,8 @@ installOptions showOrParseArgs = installShadowPkgs (\v flags -> flags { installShadowPkgs = v }) installStrongFlags (\v flags -> flags { installStrongFlags = v }) installAllowBootLibInstalls (\v flags -> flags { installAllowBootLibInstalls = v }) - installOnlyConstrained (\v flags -> flags { installOnlyConstrained = v }) ++ + installOnlyConstrained (\v flags -> flags { installOnlyConstrained = v }) + installRequireArtifacts (\v flags -> flags { installRequireArtifacts = v }) ++ [ option [] ["reinstall"] "Install even if it means installing the same version again." @@ -2433,10 +2442,11 @@ optionSolverFlags :: ShowOrParseArgs -> (flags -> Flag StrongFlags) -> (Flag StrongFlags -> flags -> flags) -> (flags -> Flag AllowBootLibInstalls) -> (Flag AllowBootLibInstalls -> flags -> flags) -> (flags -> Flag OnlyConstrained) -> (Flag OnlyConstrained -> flags -> flags) + -> (flags -> Flag RequireArtifacts) -> (Flag RequireArtifacts -> flags -> flags) -> [OptionField flags] optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc getfgc setfgc getmc setmc getig setig getpo setpo getsip setsip - getstrfl setstrfl getib setib getoc setoc = + getstrfl setstrfl getib setib getoc setoc getra setra = [ option [] ["max-backjumps"] ("Maximum number of backjumps allowed while solving (default: " ++ show defaultMaxBackjumps ++ "). Use a negative number to enable unlimited backtracking. Use 0 to disable backtracking completely.") getmbj setmbj @@ -2499,6 +2509,11 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc (toFlag `fmap` parsec)) (flagToList . fmap prettyShow)) + , option [] ["require-artifacts"] + "Reject installed dependency package options that are missing required build artifacts (default)." + (fmap asBool . getra) + (setra . fmap RequireArtifacts) + (yesNoOpt showOrParseArgs) ] usagePackages :: String -> String -> String