WIP; add prefer-version setting

Cabal-syntax/src/Distribution/CabalSpecVersion.hs

@@ -36,6 +36,7 @@ data CabalSpecVersion
     CabalSpecV3_12
   | CabalSpecV3_14
   | CabalSpecV3_16
+  | CabalSpecV3_18
   deriving (Eq, Ord, Show, Read, Enum, Bounded, Data, Generic)
 
 instance Binary CabalSpecVersion
@@ -46,6 +47,7 @@ instance NFData CabalSpecVersion where rnf = genericRnf
 --
 -- @since 3.0.0.0
 showCabalSpecVersion :: CabalSpecVersion -> String
+showCabalSpecVersion CabalSpecV3_18 = "3.18"
 showCabalSpecVersion CabalSpecV3_16 = "3.16"
 showCabalSpecVersion CabalSpecV3_14 = "3.14"
 showCabalSpecVersion CabalSpecV3_12 = "3.12"
@@ -69,13 +71,14 @@ showCabalSpecVersion CabalSpecV1_2 = "1.2"
 showCabalSpecVersion CabalSpecV1_0 = "1.0"
 
 cabalSpecLatest :: CabalSpecVersion
-cabalSpecLatest = CabalSpecV3_16
+cabalSpecLatest = CabalSpecV3_18
 
 -- | Parse 'CabalSpecVersion' from version digits.
 --
 -- It may fail if for recent versions the version is not exact.
 cabalSpecFromVersionDigits :: [Int] -> Maybe CabalSpecVersion
 cabalSpecFromVersionDigits v
+  | v == [3, 18] = Just CabalSpecV3_18
   | v == [3, 16] = Just CabalSpecV3_16
   | v == [3, 14] = Just CabalSpecV3_14
   | v == [3, 12] = Just CabalSpecV3_12
@@ -101,6 +104,7 @@ cabalSpecFromVersionDigits v
 
 -- | @since 3.4.0.0
 cabalSpecToVersionDigits :: CabalSpecVersion -> [Int]
+cabalSpecToVersionDigits CabalSpecV3_18 = [3, 18]
 cabalSpecToVersionDigits CabalSpecV3_16 = [3, 16]
 cabalSpecToVersionDigits CabalSpecV3_14 = [3, 14]
 cabalSpecToVersionDigits CabalSpecV3_12 = [3, 12]

cabal-install-solver/src/Distribution/Solver/Types/Settings.hs

@@ -3,7 +3,7 @@
 module Distribution.Solver.Types.Settings
     ( ReorderGoals(..)
     , IndependentGoals(..)
-    , PreferOldest(..)
+    , PreferVersion(..)
     , MinimizeConflictSet(..)
     , AvoidReinstalls(..)
     , ShadowPkgs(..)
@@ -41,8 +41,11 @@ newtype MinimizeConflictSet = MinimizeConflictSet Bool
 newtype IndependentGoals = IndependentGoals Bool
   deriving (BooleanFlag, Eq, Generic, Show)
 
-newtype PreferOldest = PreferOldest Bool
-  deriving (BooleanFlag, Eq, Generic, Show)
+data PreferVersion =
+  PreferOldest
+  | PreferLatest
+  | PreferLatestExceptInstalled
+  deriving (Eq, Generic, Show)
 
 newtype AvoidReinstalls = AvoidReinstalls Bool
   deriving (BooleanFlag, Eq, Generic, Show)
@@ -73,7 +76,7 @@ instance Binary ReorderGoals
 instance Binary CountConflicts
 instance Binary FineGrainedConflicts
 instance Binary IndependentGoals
-instance Binary PreferOldest
+instance Binary PreferVersion
 instance Binary MinimizeConflictSet
 instance Binary AvoidReinstalls
 instance Binary ShadowPkgs
@@ -86,7 +89,7 @@ instance Structured ReorderGoals
 instance Structured CountConflicts
 instance Structured FineGrainedConflicts
 instance Structured IndependentGoals
-instance Structured PreferOldest
+instance Structured PreferVersion
 instance Structured MinimizeConflictSet
 instance Structured AvoidReinstalls
 instance Structured ShadowPkgs
@@ -99,7 +102,7 @@ instance NFData ReorderGoals
 instance NFData CountConflicts
 instance NFData FineGrainedConflicts
 instance NFData IndependentGoals
-instance NFData PreferOldest
+instance NFData PreferVersion
 instance NFData MinimizeConflictSet
 instance NFData AvoidReinstalls
 instance NFData ShadowPkgs
@@ -111,6 +114,11 @@ instance Pretty OnlyConstrained where
   pretty OnlyConstrainedAll  = PP.text "all"
   pretty OnlyConstrainedNone = PP.text "none"
 
+instance Pretty PreferVersion where
+  pretty PreferOldest = PP.text "oldest"
+  pretty PreferLatest = PP.text "latest"
+  pretty PreferLatestExceptInstalled = PP.text "legacy"
+
 instance Parsec OnlyConstrained where
   parsec = P.choice
     [ P.string "all"  >> return OnlyConstrainedAll
@@ -135,8 +143,13 @@ instance Parsec StrongFlags where
 instance Parsec AllowBootLibInstalls where
   parsec = AllowBootLibInstalls <$> parsec
 
-instance Parsec PreferOldest where
-  parsec = PreferOldest <$> parsec
+instance Parsec PreferVersion where
+  parsec = P.choice
+    [ P.string "oldest"  >> return PreferOldest
+    , P.try (P.string "latest" >> return PreferLatest)
+    -- TODO: think about naming
+    , P.string "legacy" >> return PreferLatestExceptInstalled
+    ]
 
 instance Parsec IndependentGoals where
   parsec = IndependentGoals <$> parsec

cabal-install/parser-tests/Tests/ParserTests.hs

@@ -7,6 +7,7 @@ module Tests.ParserTests (parserTests) where
 import Control.Monad.IO.Class
   ( MonadIO (liftIO)
   )
+import GHC.Stack (HasCallStack)
 import Data.Either (fromRight)
 import qualified Data.Map as Map
 import Data.Maybe (fromJust)
@@ -44,7 +45,7 @@ import Distribution.Solver.Types.Settings
   , IndependentGoals (..)
   , MinimizeConflictSet (..)
   , OnlyConstrained (..)
-  , PreferOldest (..)
+  , PreferVersion (..)
   , ReorderGoals (..)
   , StrongFlags (..)
   )
@@ -227,7 +228,7 @@ testProjectConfigShared = do
     projectConfigOnlyConstrained = Flag OnlyConstrainedAll
     projectConfigPerComponent = Flag True
     projectConfigIndependentGoals = Flag (IndependentGoals True)
-    projectConfigPreferOldest = Flag (PreferOldest True)
+    projectConfigPreferVersion = Flag PreferOldest
     projectConfigProgPathExtra = toNubList ["/foo/bar", "/baz/quux"]
     projectConfigMultiRepl = toFlag True
 
@@ -577,7 +578,7 @@ readConfig testSubDir projectFileName = do
         readProjectFileSkeletonLegacy verbosity httpTransport distDirLayout extensionName extensionDescription
   return (parsec, legacy)
 
-assertConfigEquals :: (Eq a, Show a) => a -> ProjectConfigSkeleton -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> Assertion
+assertConfigEquals :: (Eq a, Show a, HasCallStack) => a -> ProjectConfigSkeleton -> ProjectConfigSkeleton -> (ProjectConfigSkeleton -> a) -> Assertion
 assertConfigEquals expected config configLegacy access = do
   assertEqual "Expectation does not match result of Legacy parser" expected actualLegacy
   assertEqual "Parsed Config does not match expected" expected actual

cabal-install/src/Distribution/Client/Config.hs

@@ -427,7 +427,7 @@ instance Semigroup SavedConfig where
           , installFineGrainedConflicts = combine installFineGrainedConflicts
           , installMinimizeConflictSet = combine installMinimizeConflictSet
           , installIndependentGoals = combine installIndependentGoals
-          , installPreferOldest = combine installPreferOldest
+          , installPreferVersion = combine installPreferVersion
           , installShadowPkgs = combine installShadowPkgs
           , installStrongFlags = combine installStrongFlags
           , installAllowBootLibInstalls = combine installAllowBootLibInstalls

cabal-install/src/Distribution/Client/Dependency/Types.hs

@@ -46,11 +46,12 @@ data PackagesPreferenceDefault
     -- installed version.
     --
     -- * This is the standard policy for upgrade.
+    -- * This is enabled by --prefer-version=latest for install
     PreferAllLatest
   | -- | Always prefer the oldest version irrespective of any existing
     -- installed version or packages explicitly requested.
     --
-    -- * This is enabled by --prefer-oldest.
+    -- * This is enabled by --prefer-version=oldest for install.
     PreferAllOldest
   | -- | Always prefer the installed versions over ones that would need to be
     -- installed. Secondarily, prefer latest versions (eg the latest installed

cabal-install/src/Distribution/Client/ProjectConfig.hs

@@ -392,7 +392,7 @@ resolveSolverSettings
       solverSettingIndexState = flagToMaybe projectConfigIndexState
       solverSettingActiveRepos = flagToMaybe projectConfigActiveRepos
       solverSettingIndependentGoals = fromFlag projectConfigIndependentGoals
-      solverSettingPreferOldest = fromFlag projectConfigPreferOldest
+      solverSettingPreferVersion = fromFlag projectConfigPreferVersion
       -- solverSettingShadowPkgs        = fromFlag projectConfigShadowPkgs
       -- solverSettingReinstall         = fromFlag projectConfigReinstall
       -- solverSettingAvoidReinstalls   = fromFlag projectConfigAvoidReinstalls
@@ -415,7 +415,7 @@ resolveSolverSettings
           , projectConfigAllowBootLibInstalls = Flag (AllowBootLibInstalls False)
           , projectConfigOnlyConstrained = Flag OnlyConstrainedNone
           , projectConfigIndependentGoals = Flag (IndependentGoals False)
-          , projectConfigPreferOldest = Flag (PreferOldest False)
+          , projectConfigPreferVersion = Flag PreferLatestExceptInstalled
           -- projectConfigShadowPkgs        = Flag False,
           -- projectConfigReinstall         = Flag False,
           -- projectConfigAvoidReinstalls   = Flag False,

cabal-install/src/Distribution/Client/ProjectConfig/FieldGrammar.hs

@@ -21,6 +21,8 @@ import Distribution.Simple.InstallDirs
 import Distribution.Solver.Types.ConstraintSource (ConstraintSource (..))
 import Distribution.Solver.Types.ProjectConfigPath
 import Distribution.Types.PackageVersionConstraint (PackageVersionConstraint (..))
+import Data.Bool (bool)
+import Distribution.Solver.Types.Settings (PreferVersion(..))
 
 projectConfigFieldGrammar :: ProjectConfigPath -> [String] -> ParsecFieldGrammar' ProjectConfig
 projectConfigFieldGrammar source knownPrograms =
@@ -105,7 +107,7 @@ projectConfigSharedFieldGrammar source =
     <*> optionalFieldDef "reject-unconstrained-dependencies" L.projectConfigOnlyConstrained mempty
     <*> optionalFieldDef "per-component" L.projectConfigPerComponent mempty
     <*> optionalFieldDef "independent-goals" L.projectConfigIndependentGoals mempty
-    <*> optionalFieldDef "prefer-oldest" L.projectConfigPreferOldest mempty
+    <*> packageConfigPreferVersion
     <*> monoidalFieldAla "extra-prog-path-shared-only" (alaNubList' FSep FilePathNT) L.projectConfigProgPathExtra
     <*> optionalFieldDef "multi-repl" L.projectConfigMultiRepl mempty
 
@@ -263,3 +265,10 @@ packageConfigCoverageGrammar =
     <$> optionalFieldDef "coverage" L.packageConfigCoverage mempty
     <*> optionalFieldDef "library-coverage" L.packageConfigCoverage mempty
       ^^^ deprecatedSince CabalSpecV1_22 "Please use 'coverage' field instead."
+
+packageConfigPreferVersion :: ParsecFieldGrammar ProjectConfigShared (Flag PreferVersion)
+packageConfigPreferVersion =
+  mappend <$> (fmap (bool PreferLatestExceptInstalled PreferOldest) <$> (optionalFieldDef "prefer-oldest" L.projectConfigPreferOldest mempty)
+               ^^^ deprecatedSince CabalSpecV1_22 "Please use 'coverage' field instead."
+              )
+          <*> (optionalFieldDef "prefer-version" L.projectConfigPreferVersion mempty)

cabal-install/src/Distribution/Client/ProjectConfig/Legacy.hs

@@ -760,7 +760,7 @@ convertLegacyAllPackageFlags globalFlags configFlags configExFlags installFlags
       , installMinimizeConflictSet = projectConfigMinimizeConflictSet
       , installPerComponent = projectConfigPerComponent
       , installIndependentGoals = projectConfigIndependentGoals
-      , installPreferOldest = projectConfigPreferOldest
+      , installPreferVersion = projectConfigPreferVersion
       , -- installShadowPkgs         = projectConfigShadowPkgs,
       installStrongFlags = projectConfigStrongFlags
       , installAllowBootLibInstalls = projectConfigAllowBootLibInstalls
@@ -1044,7 +1044,7 @@ convertToLegacySharedConfig
           , installFineGrainedConflicts = projectConfigFineGrainedConflicts
           , installMinimizeConflictSet = projectConfigMinimizeConflictSet
           , installIndependentGoals = projectConfigIndependentGoals
-          , installPreferOldest = projectConfigPreferOldest
+          , installPreferVersion = projectConfigPreferVersion
           , installShadowPkgs = mempty -- projectConfigShadowPkgs,
           , installStrongFlags = projectConfigStrongFlags
           , installAllowBootLibInstalls = projectConfigAllowBootLibInstalls
@@ -1506,6 +1506,7 @@ legacySharedConfigFieldDescrs constraintSrc =
           , "minimize-conflict-set"
           , "independent-goals"
           , "prefer-oldest"
+          , "prefer-version"
           , "strong-flags"
           , "allow-boot-library-installs"
           , "reject-unconstrained-dependencies"

cabal-install/src/Distribution/Client/ProjectConfig/Lens.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
 module Distribution.Client.ProjectConfig.Lens where
 
 import Distribution.Client.BuildReports.Types (ReportLevel (..))
@@ -36,8 +37,11 @@ import Distribution.Simple.InstallDirs
 import Distribution.Simple.Setup
   ( DumpBuildInfo (..)
   , Flag
+  , pattern Flag
+  , pattern NoFlag
   , HaddockTarget (..)
   , TestShowDetails (..)
+  , flagToMaybe
   )
 import Distribution.Solver.Types.ConstraintSource (ConstraintSource)
 import Distribution.Solver.Types.Settings
@@ -47,7 +51,7 @@ import Distribution.Solver.Types.Settings
   , IndependentGoals (..)
   , MinimizeConflictSet (..)
   , OnlyConstrained (..)
-  , PreferOldest (..)
+  , PreferVersion (..)
   , ReorderGoals (..)
   , StrongFlags (..)
   )
@@ -292,10 +296,25 @@ projectConfigOnlyConstrained :: Lens' ProjectConfigShared (Flag OnlyConstrained)
 projectConfigOnlyConstrained f s = fmap (\x -> s{T.projectConfigOnlyConstrained = x}) (f (T.projectConfigOnlyConstrained s))
 {-# INLINEABLE projectConfigOnlyConstrained #-}
 
-projectConfigPreferOldest :: Lens' ProjectConfigShared (Flag PreferOldest)
-projectConfigPreferOldest f s = fmap (\x -> s{T.projectConfigPreferOldest = x}) (f (T.projectConfigPreferOldest s))
+projectConfigPreferOldest :: Lens' ProjectConfigShared (Flag Bool)
+projectConfigPreferOldest f s = fmap (\x -> s{T.projectConfigPreferVersion = fromBool x}) (f (toBool $ T.projectConfigPreferVersion s))
+  where
+    toBool :: Flag PreferVersion -> Flag Bool
+    toBool mpv = case flagToMaybe mpv of
+      Just PreferOldest -> Flag True
+      Just PreferLatestExceptInstalled -> Flag False
+      _ -> NoFlag
+    fromBool :: Flag Bool -> Flag PreferVersion
+    fromBool mpo = case flagToMaybe mpo of
+      Just True -> Flag PreferOldest
+      Just False -> Flag PreferLatestExceptInstalled
+      _ -> NoFlag
 {-# INLINEABLE projectConfigPreferOldest #-}
 
+projectConfigPreferVersion :: Lens' ProjectConfigShared (Flag PreferVersion)
+projectConfigPreferVersion f s = fmap (\x -> s{T.projectConfigPreferVersion = x}) (f (T.projectConfigPreferVersion s))
+{-# INLINEABLE projectConfigPreferVersion #-}
+
 projectConfigProgPathExtra :: Lens' ProjectConfigShared (NubList FilePath)
 projectConfigProgPathExtra f s = fmap (\x -> s{T.projectConfigProgPathExtra = x}) (f (T.projectConfigProgPathExtra s))
 {-# INLINEABLE projectConfigProgPathExtra #-}

cabal-install/src/Distribution/Client/ProjectConfig/Types.hs

@@ -229,7 +229,7 @@ data ProjectConfigShared = ProjectConfigShared
   , projectConfigOnlyConstrained :: Flag OnlyConstrained
   , projectConfigPerComponent :: Flag Bool
   , projectConfigIndependentGoals :: Flag IndependentGoals
-  , projectConfigPreferOldest :: Flag PreferOldest
+  , projectConfigPreferVersion :: Flag PreferVersion
   , projectConfigProgPathExtra :: NubList FilePath
   , projectConfigMultiRepl :: Flag Bool
   -- More things that only make sense for manual mode, not --local mode
@@ -469,7 +469,7 @@ data SolverSettings = SolverSettings
   , solverSettingIndexState :: Maybe TotalIndexState
   , solverSettingActiveRepos :: Maybe ActiveRepos
   , solverSettingIndependentGoals :: IndependentGoals
-  , solverSettingPreferOldest :: PreferOldest
+  , solverSettingPreferVersion :: PreferVersion
   -- Things that only make sense for manual mode, not --local mode
   -- too much control!
   -- solverSettingShadowPkgs        :: Bool,

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -1353,18 +1353,12 @@ planPackages
           . setAllowBootLibInstalls solverSettingAllowBootLibInstalls
           . setOnlyConstrained solverSettingOnlyConstrained
           . setSolverVerbosity verbosity
-          -- TODO: [required eventually] decide if we need to prefer
-          -- installed for global packages, or prefer latest even for
-          -- global packages. Perhaps should be configurable but with a
-          -- different name than "upgrade-dependencies".
           . setPreferenceDefault
-            ( if Cabal.asBool solverSettingPreferOldest
-                then PreferAllOldest
-                else PreferLatestForSelected
+            ( case solverSettingPreferVersion of
+                PreferOldest -> PreferAllOldest
+                PreferLatest -> PreferAllLatest
+                PreferLatestExceptInstalled -> PreferLatestForSelected
             )
-          {-(if solverSettingUpgradeDeps
-               then PreferAllLatest
-               else PreferLatestForSelected)-}
 
           . removeLowerBounds solverSettingAllowOlder
           . removeUpperBounds solverSettingAllowNewer