diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -1,4 +1,4 @@ -Copyright (c) 2003-2022, Cabal Development Team. +Copyright (c) 2003-2023, Cabal Development Team. See the AUTHORS file for the full list of copyright holders. See */LICENSE for the copyright holders of the subcomponents. diff --git a/cabal-install-solver.cabal b/cabal-install-solver.cabal --- a/cabal-install-solver.cabal +++ b/cabal-install-solver.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cabal-install-solver -version: 3.8.1.0 +version: 3.10.1.0 synopsis: The command-line interface for Cabal and Hackage. description: The solver component used in cabal-install command-line program @@ -11,7 +11,7 @@ license-file: LICENSE author: Cabal Development Team (see AUTHORS file) maintainer: Cabal Development Team -copyright: 2003-2022, Cabal Development Team +copyright: 2003-2023, Cabal Development Team category: Distribution build-type: Simple Extra-Source-Files: @@ -105,23 +105,23 @@ build-depends: , array >=0.4 && <0.6 - , base >=4.10 && <4.17 + , base >=4.10 && <4.18 , bytestring >=0.10.6.0 && <0.12 - , Cabal ^>=3.8 - , Cabal-syntax ^>=3.8 + , Cabal ^>=3.10 + , Cabal-syntax ^>=3.10 , containers >=0.5.6.2 && <0.7 , edit-distance ^>= 0.2.2 , filepath ^>=1.4.0.0 - , mtl >=2.0 && <2.3 + , mtl >=2.0 && <2.4 , pretty ^>=1.1 - , transformers >=0.4.2.0 && <0.6 + , transformers >=0.4.2.0 && <0.7 if flag(debug-expensive-assertions) cpp-options: -DDEBUG_EXPENSIVE_ASSERTIONS if flag(debug-conflict-sets) cpp-options: -DDEBUG_CONFLICT_SETS - build-depends: base >=4.8 + build-depends: base >=4.9 if flag(debug-tracetree) cpp-options: -DDEBUG_TRACETREE @@ -138,7 +138,7 @@ UnitTests.Distribution.Solver.Modular.MessageUtils build-depends: - , base >= 4.10 && <4.17 + , base >= 4.10 && <4.18 , Cabal , Cabal-syntax , cabal-install-solver diff --git a/src/Distribution/Solver/Modular/Linking.hs b/src/Distribution/Solver/Modular/Linking.hs --- a/src/Distribution/Solver/Modular/Linking.hs +++ b/src/Distribution/Solver/Modular/Linking.hs @@ -11,8 +11,10 @@ import Distribution.Solver.Compat.Prelude hiding (get,put) import Control.Exception (assert) -import Control.Monad.Reader -import Control.Monad.State +import Control.Monad (forM_, zipWithM_) +import Control.Monad.Reader (Reader, runReader, local, ask) +import Control.Monad.State (MonadState, StateT, get, put, modify, execStateT) +import Control.Monad.Trans (lift) import Data.Map ((!)) import qualified Data.Map as M import qualified Data.Set as S diff --git a/src/Distribution/Solver/Modular/Preference.hs b/src/Distribution/Solver/Modular/Preference.hs --- a/src/Distribution/Solver/Modular/Preference.hs +++ b/src/Distribution/Solver/Modular/Preference.hs @@ -86,18 +86,31 @@ preferPackagePreferences :: (PN -> PackagePreferences) -> EndoTreeTrav d c preferPackagePreferences pcs = preferPackageStanzaPreferences pcs . + -- Each package is assigned a list of weights (currently three of them), + -- and options are ordered by comparison of these lists. + -- + -- The head of the list (and thus the top priority for ordering) + -- is whether the package version is "preferred" + -- (https://hackage.haskell.org/packages/preferred-versions). + -- + -- The next two elements depend on 'PackagePreferences'. + -- For 'PreferInstalled' they are whether the version is installed (0 or 1) + -- and how close is the version to the latest one (between 0.0 and 1.0). + -- For 'PreferLatest' the weights are the same, but swapped, so that + -- ordering considers how new is the package first. + -- For 'PreferOldest' one weight measures how close is the version to the + -- the oldest one possible (between 0.0 and 1.0) and another checks whether + -- the version is installed (0 or 1). addWeights [ \pn _ opt -> preferred pn opt - - -- Note that we always rank installed before uninstalled, and later - -- versions before earlier, but we can change the priority of the - -- two orderings. , \pn vs opt -> case preference pn of PreferInstalled -> installed opt PreferLatest -> latest vs opt + PreferOldest -> oldest vs opt , \pn vs opt -> case preference pn of PreferInstalled -> latest vs opt PreferLatest -> installed opt + PreferOldest -> installed opt ] where -- Prefer packages with higher version numbers over packages with @@ -107,6 +120,11 @@ let l = length sortedVersions index = fromMaybe l $ L.findIndex (<= version opt) sortedVersions in fromIntegral index / fromIntegral l + + -- Prefer packages with lower version numbers over packages with + -- higher version numbers. + oldest :: [Ver] -> POption -> Weight + oldest sortedVersions opt = 1 - latest sortedVersions opt preference :: PN -> InstalledPreference preference pn = diff --git a/src/Distribution/Solver/Modular/Solver.hs b/src/Distribution/Solver/Modular/Solver.hs --- a/src/Distribution/Solver/Modular/Solver.hs +++ b/src/Distribution/Solver/Modular/Solver.hs @@ -162,7 +162,11 @@ nonInstallable = L.map mkPackageName [ "base" + , "ghc-bignum" , "ghc-prim" + , "ghc-boot" + , "ghc" + , "ghci" , "integer-gmp" , "integer-simple" , "template-haskell" diff --git a/src/Distribution/Solver/Modular/Validate.hs b/src/Distribution/Solver/Modular/Validate.hs --- a/src/Distribution/Solver/Modular/Validate.hs +++ b/src/Distribution/Solver/Modular/Validate.hs @@ -12,7 +12,8 @@ -- assignment returned by exploration of the tree should be a complete valid -- assignment, i.e., actually constitute a solution. -import Control.Monad.Reader +import Control.Monad (foldM, mzero, liftM2) +import Control.Monad.Reader (MonadReader, Reader, runReader, local, asks) import Data.Either (lefts) import Data.Function (on) diff --git a/src/Distribution/Solver/Types/InstalledPreference.hs b/src/Distribution/Solver/Types/InstalledPreference.hs --- a/src/Distribution/Solver/Types/InstalledPreference.hs +++ b/src/Distribution/Solver/Types/InstalledPreference.hs @@ -7,5 +7,5 @@ -- | Whether we prefer an installed version of a package or simply the latest -- version. -- -data InstalledPreference = PreferInstalled | PreferLatest +data InstalledPreference = PreferInstalled | PreferLatest | PreferOldest deriving Show diff --git a/src/Distribution/Solver/Types/PkgConfigDb.hs b/src/Distribution/Solver/Types/PkgConfigDb.hs --- a/src/Distribution/Solver/Types/PkgConfigDb.hs +++ b/src/Distribution/Solver/Types/PkgConfigDb.hs @@ -24,6 +24,7 @@ import Prelude () import Control.Exception (handle) +import Control.Monad (mapM) import qualified Data.Map as M import System.FilePath (splitSearchPath) @@ -31,7 +32,8 @@ import Distribution.Package (PkgconfigName, mkPkgconfigName) import Distribution.Parsec import Distribution.Simple.Program - (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram) + (ProgramDb, getProgramOutput, pkgConfigProgram, needProgram, ConfiguredProgram) +import Distribution.Simple.Program.Run (getProgramInvocationOutputAndErrors, programInvocation) import Distribution.Simple.Utils (info) import Distribution.Types.PkgconfigVersion import Distribution.Types.PkgconfigVersionRange @@ -65,9 +67,15 @@ -- The output of @pkg-config --list-all@ also includes a description -- for each package, which we do not need. let pkgNames = map (takeWhile (not . isSpace)) pkgList - pkgVersions <- lines <$> getProgramOutput verbosity pkgConfig - ("--modversion" : pkgNames) - (return . pkgConfigDbFromList . zip pkgNames) pkgVersions + (pkgVersions, _errs, exitCode) <- + getProgramInvocationOutputAndErrors verbosity + (programInvocation pkgConfig ("--modversion" : pkgNames)) + case exitCode of + ExitSuccess -> (return . pkgConfigDbFromList . zip pkgNames) (lines pkgVersions) + -- if there's a single broken pc file the above fails, so we fall back into calling it individually + _ -> do + info verbosity ("call to pkg-config --modversion on all packages failed. Falling back to querying pkg-config individually on each package") + pkgConfigDbFromList . catMaybes <$> mapM (getIndividualVersion pkgConfig) pkgNames where -- For when pkg-config invocation fails (possibly because of a -- too long command line). @@ -79,6 +87,15 @@ ioErrorHandler :: IOException -> IO PkgConfigDb ioErrorHandler e = noPkgConfig (show e) + + getIndividualVersion :: ConfiguredProgram -> String -> IO (Maybe (String, String)) + getIndividualVersion pkgConfig pkg = do + (pkgVersion, _errs, exitCode) <- + getProgramInvocationOutputAndErrors verbosity + (programInvocation pkgConfig ["--modversion",pkg]) + return $ case exitCode of + ExitSuccess -> Just (pkg, pkgVersion) + _ -> Nothing -- | Create a `PkgConfigDb` from a list of @(packageName, version)@ pairs. pkgConfigDbFromList :: [(String, String)] -> PkgConfigDb diff --git a/src/Distribution/Solver/Types/Settings.hs b/src/Distribution/Solver/Types/Settings.hs --- a/src/Distribution/Solver/Types/Settings.hs +++ b/src/Distribution/Solver/Types/Settings.hs @@ -3,6 +3,7 @@ module Distribution.Solver.Types.Settings ( ReorderGoals(..) , IndependentGoals(..) + , PreferOldest(..) , MinimizeConflictSet(..) , AvoidReinstalls(..) , ShadowPkgs(..) @@ -40,6 +41,9 @@ newtype IndependentGoals = IndependentGoals Bool deriving (BooleanFlag, Eq, Generic, Show) +newtype PreferOldest = PreferOldest Bool + deriving (BooleanFlag, Eq, Generic, Show) + newtype AvoidReinstalls = AvoidReinstalls Bool deriving (BooleanFlag, Eq, Generic, Show) @@ -69,6 +73,7 @@ instance Binary CountConflicts instance Binary FineGrainedConflicts instance Binary IndependentGoals +instance Binary PreferOldest instance Binary MinimizeConflictSet instance Binary AvoidReinstalls instance Binary ShadowPkgs @@ -81,6 +86,7 @@ instance Structured CountConflicts instance Structured FineGrainedConflicts instance Structured IndependentGoals +instance Structured PreferOldest instance Structured MinimizeConflictSet instance Structured AvoidReinstalls instance Structured ShadowPkgs