diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs index 0d047db5590..9b56777c107 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo.hs @@ -92,7 +92,10 @@ data InstalledPackageInfo frameworks :: [String], haddockInterfaces :: [FilePath], haddockHTMLs :: [FilePath], - pkgRoot :: Maybe FilePath + pkgRoot :: Maybe FilePath, + -- Artifacts included in this package: + providesStaticArtifacts :: Bool, + providesDynamicArtifacts :: Bool } deriving (Eq, Generic, Typeable, Read, Show) @@ -173,5 +176,7 @@ emptyInstalledPackageInfo haddockInterfaces = [], haddockHTMLs = [], pkgRoot = Nothing, - libVisibility = LibraryVisibilityPrivate + libVisibility = LibraryVisibilityPrivate, + providesStaticArtifacts = True, + providesDynamicArtifacts = True } diff --git a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs index f176ea01187..022826913cc 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs @@ -121,6 +121,8 @@ ipiFieldGrammar = mkInstalledPackageInfo <@> monoidalFieldAla "haddock-interfaces" (alaList' FSep FilePathNT) L.haddockInterfaces <@> monoidalFieldAla "haddock-html" (alaList' FSep FilePathNT) L.haddockHTMLs <@> optionalFieldAla "pkgroot" FilePathNT L.pkgRoot + <@> booleanFieldDef "provides-static-artifacts" L.providesStaticArtifacts True + <@> booleanFieldDef "provides-dynamic-artifacts" L.providesDynamicArtifacts 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..b5775160aab 100644 --- a/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs +++ b/Cabal-syntax/src/Distribution/Types/InstalledPackageInfo/Lens.hs @@ -196,3 +196,11 @@ libVisibility :: Lens' InstalledPackageInfo LibraryVisibility libVisibility f s = fmap (\x -> s { T.libVisibility = x }) (f (T.libVisibility s)) {-# INLINE libVisibility #-} +providesStaticArtifacts :: Lens' InstalledPackageInfo Bool +providesStaticArtifacts f s = fmap (\x -> s { T.providesStaticArtifacts = x }) (f (T.providesStaticArtifacts s)) +{-# INLINE providesStaticArtifacts #-} + +providesDynamicArtifacts :: Lens' InstalledPackageInfo Bool +providesDynamicArtifacts f s = fmap (\x -> s { T.providesDynamicArtifacts = x }) (f (T.providesDynamicArtifacts s)) +{-# INLINE providesDynamicArtifacts #-} + diff --git a/Cabal-tests/tests/ParserTests/ipi/Includes2.expr b/Cabal-tests/tests/ParserTests/ipi/Includes2.expr index 9c15199c79f..a1cde3e2ef0 100644 --- a/Cabal-tests/tests/ParserTests/ipi/Includes2.expr +++ b/Cabal-tests/tests/ParserTests/ipi/Includes2.expr @@ -89,4 +89,6 @@ InstalledPackageInfo { haddockHTMLs = [ "/home/travis/build/haskell/cabal/cabal-testsuite/PackageTests/Backpack/Includes2/cabal-internal.dist/work/./dist/build/x86_64-linux/ghc-8.2.2/Includes2-0.1.0.0/l/mylib/Includes2-0.1.0.0-inplace-mylib+3gY9SyjX86dBypHcOaev1n/doc/html/Includes2"], - pkgRoot = Nothing} + pkgRoot = Nothing, + providesStaticArtifacts = True, + providesDynamicArtifacts = True} diff --git a/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr index 42a593f2540..b1924ae83b9 100644 --- a/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr +++ b/Cabal-tests/tests/ParserTests/ipi/internal-preprocessor-test.expr @@ -73,4 +73,6 @@ InstalledPackageInfo { "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/doc/html/internal-preprocessor-test"], pkgRoot = Just - "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist"} + "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist", + providesStaticArtifacts = True, + providesDynamicArtifacts = True} diff --git a/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr index f2d62e05938..6344f41c57f 100644 --- a/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr +++ b/Cabal-tests/tests/ParserTests/ipi/issue-2276-ghc-9885.expr @@ -2181,4 +2181,6 @@ InstalledPackageInfo { "/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0/transformers.haddock"], haddockHTMLs = [ "/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0"], - pkgRoot = Nothing} + pkgRoot = Nothing, + providesStaticArtifacts = True, + providesDynamicArtifacts = True} diff --git a/Cabal-tests/tests/ParserTests/ipi/transformers.expr b/Cabal-tests/tests/ParserTests/ipi/transformers.expr index daef7608a77..6dec5cea3ab 100644 --- a/Cabal-tests/tests/ParserTests/ipi/transformers.expr +++ b/Cabal-tests/tests/ParserTests/ipi/transformers.expr @@ -181,4 +181,6 @@ InstalledPackageInfo { haddockHTMLs = [ "/opt/ghc/8.2.2/share/doc/ghc-8.2.2/html/libraries/transformers-0.5.2.0"], pkgRoot = Just - "/opt/ghc/8.2.2/lib/ghc-8.2.2"} + "/opt/ghc/8.2.2/lib/ghc-8.2.2", + providesStaticArtifacts = True, + providesDynamicArtifacts = True} diff --git a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs index 7d68bb251de..4e10783eb41 100644 --- a/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs +++ b/Cabal-tests/tests/UnitTests/Distribution/Utils/Structured.hs @@ -29,7 +29,7 @@ tests = testGroup "Distribution.Utils.Structured" , testCase "GenericPackageDescription" $ md5Check (Proxy :: Proxy GenericPackageDescription) 0xa3e9433662ecf0c7a3c26f6d75a53ba1 , testCase "LocalBuildInfo" $ - md5Check (Proxy :: Proxy LocalBuildInfo) 0x91ffcd61bbd83525e8edba877435a031 + md5Check (Proxy :: Proxy LocalBuildInfo) 0x89eabee921ae834a5222e4a10ce68439 #endif ] diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index 29b839e261f..203b86b07b7 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/Cabal/src/Distribution/Simple/Register.hs @@ -448,7 +448,9 @@ 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.providesStaticArtifacts = providesStaticArtifacts, + IPI.providesDynamicArtifacts = providesDynamicArtifacts } where ghc84 = case compilerId $ compiler lbi of @@ -492,6 +494,15 @@ generalInstalledPackageInfo adjustRelIncDirs pkg abi_hash lib lbi clbi installDi = (libdir installDirs : dynlibdir installDirs : extraLibDirs bi, []) -- the compiler doesn't understand the dynamic-library-dirs field so we -- add the dyn directory to the "normal" list in the library-dirs field + (providesStaticArtifacts, providesDynamicArtifacts) = case compilerFlavor comp of + GHC -> + let + none f t = all (not . f) t + libDefaults = none ($ lbi) [withVanillaLib, withSharedLib] && hasLibrary + statics = libDefaults || any ($ lbi) [withVanillaLib] + dynamics = any ($ lbi) [withSharedLib] + in (statics, dynamics) + _ -> (True, True) -- Assume nothing is missing. -- | Construct 'InstalledPackageInfo' for a library that is in place in the -- build tree. 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..7765ebfddfa 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,32 @@ 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 | IPI.providesStaticArtifacts ipi = staticOutsOnly | otherwise = mempty + dynamics | IPI.providesDynamicArtifacts ipi = dynOutsOnly | otherwise = 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 +187,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 +254,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 554785ff847..2b1cf80eb76 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 @@ -314,6 +315,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 @@ -326,6 +333,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 a53c7ded1aa..4ce8249f525 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), (configFullyStaticExe, False)] + , 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 83184d5902c..4b5d9c93928 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 7ed747fa98e..b63e88b91cc 100644 --- a/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs @@ -536,7 +536,8 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags --installShadowPkgs = projectConfigShadowPkgs, installStrongFlags = projectConfigStrongFlags, installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, - installOnlyConstrained = projectConfigOnlyConstrained + installOnlyConstrained = projectConfigOnlyConstrained, + installRequireArtifacts = projectConfigRequireArtifacts } = installFlags ProjectFlags @@ -784,6 +785,7 @@ convertToLegacySharedConfig installStrongFlags = projectConfigStrongFlags, installAllowBootLibInstalls = projectConfigAllowBootLibInstalls, installOnlyConstrained = projectConfigOnlyConstrained, + installRequireArtifacts = projectConfigRequireArtifacts, installOnly = mempty, installOnlyDeps = projectConfigOnlyDeps, installIndexState = projectConfigIndexState, @@ -1194,7 +1196,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 be3aae9bd5c..0b2faac587c 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 @@ -200,6 +201,7 @@ data ProjectConfigShared projectConfigStrongFlags :: Flag StrongFlags, projectConfigAllowBootLibInstalls :: Flag AllowBootLibInstalls, projectConfigOnlyConstrained :: Flag OnlyConstrained, + projectConfigRequireArtifacts :: Flag RequireArtifacts, projectConfigPerComponent :: Flag Bool, projectConfigIndependentGoals :: Flag IndependentGoals, projectConfigPreferOldest :: Flag PreferOldest, @@ -411,6 +413,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 978af213b1b..20d20795e6b 100644 --- a/cabal-install/src/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/src/Distribution/Client/ProjectPlanning.hs @@ -1088,6 +1088,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 6db91d9cf98..c751c116ecc 100644 --- a/cabal-install/src/Distribution/Client/Setup.hs +++ b/cabal-install/src/Distribution/Client/Setup.hs @@ -958,6 +958,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 @@ -980,6 +981,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 @@ -1044,6 +1046,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 }) } @@ -1067,6 +1070,7 @@ data FreezeFlags = FreezeFlags { freezeStrongFlags :: Flag StrongFlags, freezeAllowBootLibInstalls :: Flag AllowBootLibInstalls, freezeOnlyConstrained :: Flag OnlyConstrained, + freezeRequireArtifacts :: Flag RequireArtifacts, freezeVerbosity :: Flag Verbosity } @@ -1087,6 +1091,7 @@ defaultFreezeFlags = FreezeFlags { freezeStrongFlags = Flag (StrongFlags False), freezeAllowBootLibInstalls = Flag (AllowBootLibInstalls False), freezeOnlyConstrained = Flag OnlyConstrainedNone, + freezeRequireArtifacts = Flag (RequireArtifacts True), freezeVerbosity = toFlag normal } @@ -1142,6 +1147,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 }) } @@ -1589,6 +1595,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, @@ -1632,6 +1639,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, @@ -1857,7 +1865,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." @@ -2454,10 +2463,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 @@ -2520,6 +2530,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 diff --git a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs index 94f4190880e..d1599e6169f 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs @@ -479,6 +479,7 @@ instance Arbitrary ProjectConfigShared where projectConfigStrongFlags <- arbitrary projectConfigAllowBootLibInstalls <- arbitrary projectConfigOnlyConstrained <- arbitrary + projectConfigRequireArtifacts <- arbitrary projectConfigPerComponent <- arbitrary projectConfigIndependentGoals <- arbitrary projectConfigPreferOldest <- arbitrary @@ -521,6 +522,7 @@ instance Arbitrary ProjectConfigShared where <*> shrinker projectConfigStrongFlags <*> shrinker projectConfigAllowBootLibInstalls <*> shrinker projectConfigOnlyConstrained + <*> shrinker projectConfigRequireArtifacts <*> shrinker projectConfigPerComponent <*> shrinker projectConfigIndependentGoals <*> shrinker projectConfigPreferOldest @@ -808,8 +810,8 @@ instance Arbitrary FineGrainedConflicts where instance Arbitrary MinimizeConflictSet where arbitrary = MinimizeConflictSet <$> arbitrary -instance Arbitrary IndependentGoals where - arbitrary = IndependentGoals <$> arbitrary +instance Arbitrary RequireArtifacts where + arbitrary = RequireArtifacts <$> arbitrary instance Arbitrary PreferOldest where arbitrary = PreferOldest <$> arbitrary @@ -824,3 +826,6 @@ instance Arbitrary OnlyConstrained where arbitrary = oneof [ pure OnlyConstrainedAll , pure OnlyConstrainedNone ] + +instance Arbitrary IndependentGoals where + arbitrary = IndependentGoals <$> arbitrary diff --git a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs index e7e0c3671ba..fa92072d8d6 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/TreeDiffInstances.hs @@ -55,6 +55,7 @@ instance ToExpr PackageConfig instance ToExpr PackageDB instance ToExpr PackageProperty instance ToExpr PreferOldest +instance ToExpr RequireArtifacts instance ToExpr PreSolver instance ToExpr ProjectConfig instance ToExpr ProjectConfigBuildOnly diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.out b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.out new file mode 100644 index 00000000000..b136181d32c --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.out @@ -0,0 +1,14 @@ +# cabal v2-configure +# cabal v2-build +Resolving dependencies... +Build profile: -w ghc- -O1 +In order, the following will be built: + - dynamic-1.0 (lib) (first run) +Configuring library for dynamic-1.0.. +Preprocessing library for dynamic-1.0.. +Building library for dynamic-1.0.. +# cabal v2-sdist +Wrote tarball sdist to /cabal.dist/dynamic-sdist-repo/dynamic-1.0.tar.gz +# cabal v2-configure +# depender depender +Dynamic's number is 3. diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.test.hs b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.test.hs new file mode 100644 index 00000000000..8c9d0ddbfd5 --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/cabal.test.hs @@ -0,0 +1,235 @@ +import Test.Cabal.Prelude + +-- Build and install a package dynamically only, then build and install a +-- package statically that depends on that dynamic package. Old cabals are +-- tempted to consider both the source package and the installed package +-- (IPI) option with dynamic-only flags as valid, so they normally construct a +-- build plan with this IPI option that results in a build error like the +-- following: +-- > [1 of 1] Compiling Main ( Main.hs, ../setup.dist/work/depender/dist/build/depender/depender-tmp/Main.o ) +-- > +-- > Main.hs:3:1: error: +-- > Could not find module `Dynamic' +-- > There are files missing in the `dynamic-1.0' package, +-- > try running 'ghc-pkg check'. +-- > Use -v (or `:set -v` in ghci) to see a list of the files searched for. +-- > | +-- > | import qualified Dynamic (number) +-- > | ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ +-- +-- However, with ‘--require-artifacts’ rather than ‘--no-require-artifacts’, +-- cabal will detect this error in advance and reject this particular IPI, +-- leaving only building the source package as the only valid package option +-- (I) we can choose as an assignment for the QPN (and any other valid IPIs if +-- there were multiple pre-installed packages to choose from, including those +-- with configure flags that work for us). + +import Data.Maybe (fromMaybe) -- for ghcPkg1' +import Data.Version +import System.Directory +import System.FilePath + +main = do + cabalTest $ do + -- Skip if on Windows, since my default Chocolatey Windows setup (and the CI + -- server setup at the time, presumably) lacks support for dynamic builds + -- since the base package appears to be static only, lacking e.g. ‘.dyn_o’ + -- files. Normal Windows installations would need suport for dynamic + -- builds, or else this test would fail when it tries to build with the + -- dynamic flags. + skipIfWindows + + withPackageDb $ do + -- If ghc-pkg is too old, cabal-install still works but has the + -- same bug which we fixed, and our test would fail. Skip. + skipIfOldGhcPkg + + -- Build a package with only dynamic build artifacts. + sdistRepoDir <- ( "dynamic-sdist-repo") . testWorkDir <$> getTestEnv + installDynamic sdistRepoDir + + -- TODO: Before building a package that depends on this, just + -- double check that we actually have an IPI in the same packageDB + -- that will be used so that cabal-install will see it and be tempted. + + -- Build a package that requires static build artifacts. Old + -- cabal-installs don't bother to check static and dynamic + -- configuration, so it'll probably produce a build plan that'll + -- fail as we described above. With the build artifact checker, + -- our pre-installed IPI option we made earlier is detected to not + -- be a valid option in advance, so rather than producing a build + -- plan we know will fail, instead reject this particular option, + -- so that the moduler resolver cabal-install uses only picks the + -- only valid option left, which is to build from source. (For our + -- test to work, we need the depender build to be aware of both the + -- pre-installed option and also the source package so that it can + -- rebuild from source with the correct flags, so that the + -- bug/enhancement scenario can be reproduced.) + installDepender sdistRepoDir + +-- Run ‘ghc-pkg field base pkg-vanilla-lib’ to test whether the ghc-pkg +-- we are using is new enough to support the 5 new IPI fields in the ‘.conf’ +-- files. If ghc-pkg is too old, then its Cabal-syntax dependency +-- (cabal-install also uses Cabal-syntax for the IPI fields) will emit an +-- ‘Unknown field’ warning if cabal-install tries to update or register an IPI +-- with new fields, but it should otherwise work besides having full +-- functionality of the artifact checker. +skipIfOldGhcPkg :: TestM () +skipIfOldGhcPkg = do + control <- resultExitCode <$> ghcPkg1' "field" ["*", "id"] + hasArts <- resultExitCode <$> ghcPkg1' "field" ["*", "pkg-vanilla-lib"] + + -- cabal-install will still work without these 5 build artifact fields, + -- except the artifact checker wouldn't detect missing artifacts + -- without knowing what artifacts installed packages provide. + skipIf "ghc-pkg too old for 5 arts fields" $ hasArts /= control + +-- ghcPkg' that can return non-zero. +-- +-- It's basically a copy except without ‘requireSuccess’. +ghcPkg1' :: String -> [String] -> TestM Result +ghcPkg1' cmd args = do + env <- getTestEnv + unless (testHavePackageDb env) $ + error "Must initialize package database using withPackageDb" + -- NB: testDBStack already has the local database + ghcConfProg <- requireProgramM ghcProgram + let db_stack = testPackageDBStack env + extraArgs = ghcPkgPackageDBParams + (fromMaybe + (error "ghc-pkg: cannot detect version") + (programVersion ghcConfProg)) + db_stack + recordHeader ["ghc-pkg", cmd] + runProgram1M ghcPkgProgram (cmd : extraArgs ++ args) Nothing + where + runProgram1M :: Program -> [String] -> Maybe String -> TestM Result + runProgram1M prog args input = do + configured_prog <- requireProgramM prog + -- TODO: Consider also using other information from + -- ConfiguredProgram, e.g., env and args + run1M (programPath configured_prog) args input + + run1M :: FilePath -> [String] -> Maybe String -> TestM Result + run1M path args input = do + env <- getTestEnv + r <- liftIO $ run (testVerbosity env) + (Just (testCurrentDir env)) + (testEnvironment env) + path + args + input + recordLog r + return r + +-- Flags. +-- (Swap the line comments to trigger the bug the artifect checker validation +-- step fixes - the ‘missing files’ error.) +--commonArgs = ["--disable-backup", "--no-require-artifacts"] +commonArgs = ["--disable-backup"] +dynamicArgs = + [ + "--enable-shared", + "--enable-executable-dynamic", + "--disable-library-vanilla", + "--disable-static", + "--disable-executable-static" + ] +staticArgs = + [ + "--enable-static" + ] + +-- Build a package with only dynamic build artifacts. +installDynamic :: FilePath -> TestM () +installDynamic sdistRepoDir = do + withDirectory "dynamic" $ do + withSourceCopyDir ("dyn") $ do + cwd <- fmap testSourceCopyDir getTestEnv + -- (Now do ‘cd ..’, since withSourceCopyDir made our previous + -- previous such withDirectories now accumulate to be + -- relative to cabal.dist/dyn, not testSourceDir + -- (see 'testCurrentDir').) + withDirectory ".." $ do + -- Our project still resides in ‘dynamic/’. + withDirectory "dynamic" $ do + cabal "v2-configure" $ [] ++ commonArgs ++ dynamicArgs + cabal "v2-build" $ [] + recordMode DoNotRecord $ do + cabal "v2-install" $ ["--lib"] ++ commonArgs ++ dynamicArgs + tmpBuildDir <- ( "dynamic-sdist-build") . testWorkDir <$> getTestEnv + cabal "v2-sdist" $ ["-o", sdistRepoDir, "--builddir", tmpBuildDir] + +-- Build a package that requires static build artifacts. (The same packageDB +-- is shared.) +installDepender :: FilePath -> TestM () +installDepender sdistRepoDir = do + withDirectory "depender" $ do + withSourceCopyDir ("depr") $ do + cwd <- fmap testSourceCopyDir getTestEnv + -- (As before.) + withDirectory ".." $ do + withDirectory "depender" $ do + -- depender knows of the source package and the installed package. + -- The installed package should only have dynamic files (.dyn_hi, + -- .so), but not any static files (.a, .hi). New ghc-pkg IPI file + -- fields track these, so with a new GHC, a new cabal-install + -- should reject the installed package while building the tree + -- (reason: missing build artifacts) and instead choose the sdist + -- (source package) so that it can figure out its own configuration + -- flags. + -- + -- (For instance, if you comment out the sdist references so that we + -- only see the installed package, you should see an error message + -- like this (e.g. remove those two ‘-- ’ strings to write out only + -- a ‘packages: ./../dep…’ line):) + -- > Error: cabal: Could not resolve dependencies: + -- > [__0] trying: depender-1.0 (user goal) + -- > [__1] next goal: dynamic (dependency of depender) + -- > [__1] rejecting: dynamic-1.0/installed-19c7c1e50b8f1e56115c4f668dfdadd7114fc2c7dad267c2df43028892cc0ff5 (missing build artifacts: static artifacts) + -- > [__1] fail (backjumping, conflict set: depender, dynamic) + -- > After searching the rest of the dependency tree exhaustively, these were the goals I've had most trouble fulfilling: depender (3), dynamic (2) + + -- Setup the project file. + -- > sed -nEe 's/\{SDIST\}/…path…to…sdist…dir…/g; p' < cabal.project.in > cabal.project + writeSourceFile "cabal.project" . unlines $ + [ + "packages: ./../depender/*.cabal", + -- "" {- + "", + "repository my-local-repository", + " url: file+noindex://" ++ sdistRepoDir ++ "#shared-cache" + -- -} + ] + + -- Make sure our test scenario setup lets the depender see + -- the pre-installed dynamic package IPI we built. + guessedPackageDbPath <- do + recordMode DoNotRecord $ do + guessPackageDbPathDepender + let sharedPackageDbFlags = ["--package-db=" ++ guessedPackageDbPath] + + -- Use 'staticArgs' here. + cabal "v2-configure" $ [] ++ commonArgs ++ staticArgs ++ sharedPackageDbFlags + recordMode DoNotRecord $ do + cabal "v2-build" $ [] ++ sharedPackageDbFlags + + -- Optional: check the output. + recordMode DoNotRecord $ do + cabal "v2-install" $ [] ++ commonArgs ++ staticArgs + withPlan $ do + runPlanExe' "depender" "depender" [] + >>= assertOutputContains "Dynamic's number is 3." + +guessPackageDbPathDepender :: TestM FilePath +guessPackageDbPathDepender = do + env <- getTestEnv + hasGhc <- isAvailableProgram ghcProgram + skipUnless "failed to guess package-db: couldn't find ghc" hasGhc + tryProgramVersion <- programVersion <$> requireProgramM ghcProgram + let convertVersion = makeVersion . versionNumbers + programVersion <- maybe (skip "failed to guess package-db: unknown ghc version" >> return "") return $ showVersion . convertVersion <$> tryProgramVersion + path <- liftIO . canonicalizePath $ testCabalDir env "store" "ghc-" ++ programVersion "package.db" + exists <- liftIO $ doesPathExist path + skipUnless ("failed to guess package-db: guessed dir path does not exist: " ++ path) exists + return path diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/.gitignore b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/.gitignore new file mode 100644 index 00000000000..79360221e2d --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/.gitignore @@ -0,0 +1 @@ +/cabal.project diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/Main.hs b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/Main.hs new file mode 100644 index 00000000000..e52d310f48e --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/Main.hs @@ -0,0 +1,7 @@ +module Main where + +import qualified Dynamic (number) + +main :: IO () +main = do + putStrLn $ "Dynamic's number is " ++ (show Dynamic.number) ++ "." diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/cabal.project.in b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/cabal.project.in new file mode 100644 index 00000000000..128937b421e --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/cabal.project.in @@ -0,0 +1,4 @@ +packages: ./*.cabal + +repository my-local-repository + url: file+noindex://{SDIST_PATH}#shared-cache diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/depender.cabal b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/depender.cabal new file mode 100644 index 00000000000..1081e29415e --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/depender/depender/depender.cabal @@ -0,0 +1,9 @@ +cabal-version: >= 1.10 +name: depender +version: 1.0 +build-type: Simple + +executable depender + build-depends: dynamic, base + default-language: Haskell2010 + main-is: Main.hs diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/Dynamic.hs b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/Dynamic.hs new file mode 100644 index 00000000000..9d4113f47ad --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/Dynamic.hs @@ -0,0 +1,10 @@ +module Dynamic where + +simple :: (a -> b -> c) -> b -> a -> c +simple f = \a b -> f b a + +name :: String +name = "Dynamic" + +number :: Integer +number = 3 diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/cabal.project b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/cabal.project new file mode 100644 index 00000000000..e85216b030d --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/cabal.project @@ -0,0 +1 @@ +packages: ./*.cabal diff --git a/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/dynamic.cabal b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/dynamic.cabal new file mode 100644 index 00000000000..45295460c13 --- /dev/null +++ b/cabal-testsuite/PackageTests/LinkerOptions/DynDeps/dynamic/dynamic/dynamic.cabal @@ -0,0 +1,10 @@ +cabal-version: >= 1.10 +name: dynamic +version: 1.0 +build-type: Simple + +library + default-language: Haskell2010 + build-depends: base + exposed-modules: + Dynamic diff --git a/changelog.d/pr-8624 b/changelog.d/pr-8624 new file mode 100644 index 00000000000..cd11307041b --- /dev/null +++ b/changelog.d/pr-8624 @@ -0,0 +1,9 @@ +synopsis: Track static vs. dynamic dependencies +packages: cabal-install-solver cabal-install +prs: #8624 +description: { + Track build artifacts in installed packages. + + Add a step to the validation phase of the modular resolver that detects + installed package options with incompatible build artifact configuration. +} diff --git a/changelog.d/pr-8696 b/changelog.d/pr-8696 new file mode 100644 index 00000000000..67d676579e5 --- /dev/null +++ b/changelog.d/pr-8696 @@ -0,0 +1,10 @@ +synopsis: Extend the InstalledPackageInfo record with fields for artifacts. +packages: Cabal-syntax Cabal Cabal-tests +prs: #8696 +description: { + Extend the InstalledPackageInfo record with new fields involving build + artifact configuration. The moduler resolver could then (in a separate set + of changes) use these new fields to avoid selecting installed package + options missing required artifacts and producing build plans that would + fail, even if alternatives would succeed. +} diff --git a/doc/cabal-project.rst b/doc/cabal-project.rst index 2e47dfdc53c..dd603448900 100644 --- a/doc/cabal-project.rst +++ b/doc/cabal-project.rst @@ -663,6 +663,19 @@ The following settings control the behavior of the dependency solver: explicitly constrained. When set to `none`, the solver will consider all packages. +.. cfg-field:: require-artifacts: boolean + --require-artifacts + --no-require-artifacts + :synopsis: Only consider installed package options with compatible artifacts. + + :default: True + :since: 3.9 + + Enable the dependency resolver step that considers only installed package + options that have compatible build artifact configuration (e.g. so it + doesn't prefer an installed dynamic-only package over a source package when + static files are required). + Package configuration options -----------------------------