Add --install-cabal option for stack setup.

Closes #2386.

ChangeLog.md

@@ -15,6 +15,9 @@ Major changes:
   that all packages be present in a snapshot, however.
   [#2805](https://github.com/commercialhaskell/stack/issues/2805)
 
+* `stack setup` now accepts a `--install-cabal VERSION` option which
+  will install a specific version of the Cabal library globally.
+
 Behavior changes:
 
 * The default package metadata backend has been changed from Git to

doc/GUIDE.md

@@ -2074,7 +2074,9 @@ users. Here's a quick rundown:
 * `stack setup --upgrade-cabal` can install a newer version of the Cabal
   library, used for performing actual builds. You shouldn't generally do this,
   since new Cabal versions may introduce incompatibilities with package sets,
-  but it can be useful if you're trying to test a specific bugfix.
+  but it can be useful if you're trying to test a specific bugfix. Since Stack
+  1.3.3, `stack setup --install-cabal VERSION` is also available if you need a
+  specific version.
 * `stack list-dependencies` lists all of the packages and versions used for a
   project
 * `stack sig` subcommand can help you with GPG signing & verification

src/Stack/Setup.hs

@@ -137,7 +137,7 @@ data SetupOpts = SetupOpts
     -- ^ Don't check for a compatible GHC version/architecture
     , soptsSkipMsys :: !Bool
     -- ^ Do not use a custom msys installation on Windows
-    , soptsUpgradeCabal :: !Bool
+    , soptsUpgradeCabal :: !(Maybe UpgradeTo)
     -- ^ Upgrade the global Cabal library in the database to the newest
     -- version. Only works reliably with a stack-managed installation.
     , soptsResolveMissingGHC :: !(Maybe Text)
@@ -231,7 +231,7 @@ setupEnv mResolveMissingGHC = do
             , soptsSanityCheck = False
             , soptsSkipGhcCheck = configSkipGHCCheck config
             , soptsSkipMsys = configSkipMsys config
-            , soptsUpgradeCabal = False
+            , soptsUpgradeCabal = Nothing
             , soptsResolveMissingGHC = mResolveMissingGHC
             , soptsSetupInfoYaml = defaultSetupInfoYaml
             , soptsGHCBindistURL = Nothing
@@ -489,11 +489,12 @@ ensureCompiler sopts = do
                 m <- augmentPathMap (edBins ed) (unEnvOverride menv0)
                 mkEnvOverride (configPlatform config) (removeHaskellEnvVars m)
 
-    when (soptsUpgradeCabal sopts) $ do
+    let cabalVersion = soptsUpgradeCabal sopts
+    when (isJust $ cabalVersion) $ do
         unless needLocal $ do
-            $logWarn "Trying to upgrade Cabal library on a GHC not installed by stack."
+            $logWarn "Trying to change a Cabal library on a GHC not installed by stack."
             $logWarn "This may fail, caveat emptor!"
-        upgradeCabal menv wc
+        upgradeCabal menv wc (fromJust cabalVersion)
 
     case mtools of
         Just (Just (ToolGhcjs cv), _) -> ensureGhcjsBooted menv cv (soptsInstallIfMissing sopts)
@@ -622,46 +623,47 @@ ensureDockerStackExe containerPlatform = do
         downloadStackExe platforms sri stackExeDir (const $ return ())
     return stackExePath
 
--- | Install the newest version of Cabal globally
+-- | Install the newest version or a specific version of Cabal globally
 upgradeCabal :: (StackM env m, HasConfig env, HasGHCVariant env)
              => EnvOverride
              -> WhichCompiler
+             -> UpgradeTo
              -> m ()
-upgradeCabal menv wc = do
+upgradeCabal menv wc cabalVersion = do
     let name = $(mkPackageName "Cabal")
     rmap <- resolvePackages menv Nothing Map.empty (Set.singleton name)
-    newest <-
-        case map rpIdent rmap of
+    version <- case cabalVersion of
+        Specific v -> return v
+        Latest     -> case map rpIdent rmap of
             [] -> error "No Cabal library found in index, cannot upgrade"
-            [PackageIdentifier name' version]
-                | name == name' -> return version
+            [PackageIdentifier name' version] | name == name' -> return version
             x -> error $ "Unexpected results for resolvePackages: " ++ show x
     installed <- getCabalPkgVer menv wc
-    if installed >= newest
+    if installed >= version
         then $logInfo $ T.concat
             [ "Currently installed Cabal is "
             , T.pack $ versionString installed
-            , ", newest is "
-            , T.pack $ versionString newest
-            , ". I'm not upgrading Cabal."
+            , case cabalVersion of
+                  Specific _ -> " (specified)"
+                  Latest     -> " (latest)"
+            , ". No work to be done."
             ]
         else withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do
             $logInfo $ T.concat
                 [ "Installing Cabal-"
-                , T.pack $ versionString newest
+                , T.pack $ versionString version
                 , " to replace "
                 , T.pack $ versionString installed
                 ]
-            let ident = PackageIdentifier name newest
+            let ident = PackageIdentifier name version
             -- Nothing below: use the newest .cabal file revision
             m <- unpackPackageIdents menv tmpdir Nothing (Map.singleton ident Nothing)
 
             compilerPath <- join $ findExecutable menv (compilerExeName wc)
-            newestDir <- parseRelDir $ versionString newest
+            newestDir <- parseRelDir $ versionString version
             let installRoot = toFilePath $ parent (parent compilerPath)
                                        </> $(mkRelDir "new-cabal")
                                        </> newestDir
-
             dir <-
                 case Map.lookup ident m of
                     Nothing -> error "upgradeCabal: Invariant violated, dir missing"

src/Stack/SetupCmd.hs

@@ -30,7 +30,7 @@ import           Stack.Types.Version
 data SetupCmdOpts = SetupCmdOpts
     { scoCompilerVersion :: !(Maybe CompilerVersion)
     , scoForceReinstall  :: !Bool
-    , scoUpgradeCabal    :: !Bool
+    , scoUpgradeCabal    :: !(Maybe UpgradeTo)
     , scoSetupInfoYaml   :: !String
     , scoGHCBindistURL   :: !(Maybe String)
     }
@@ -48,6 +48,22 @@ setupYamlCompatParser = stackSetupYaml <|> setupInfoYaml
             <> OA.metavar "URL"
             <> OA.value defaultSetupInfoYaml )
 
+cabalUpgradeParser :: OA.Parser UpgradeTo
+cabalUpgradeParser = Specific <$> version' <|> latestParser
+    where
+        versionReader = do
+            s <- OA.readerAsk
+            case parseVersion (T.pack s) of
+                Nothing -> OA.readerError $ "Invalid version: " ++ s
+                Just v  -> return v
+        version' = OA.option versionReader (
+            OA.long "install-cabal"
+         <> OA.metavar "VERSION"
+         <> OA.help "Install a specific version of Cabal" )
+        latestParser = OA.flag' Latest (
+            OA.long "upgrade-cabal"
+         <> OA.help "Install latest version of Cabal globally" )
+
 setupParser :: OA.Parser SetupCmdOpts
 setupParser = SetupCmdOpts
     <$> OA.optional (OA.argument readVersion
@@ -58,10 +74,7 @@ setupParser = SetupCmdOpts
             "reinstall"
             "reinstalling GHC, even if available (incompatible with --system-ghc)"
             OA.idm
-    <*> OA.boolFlags False
-            "upgrade-cabal"
-            "installing the newest version of the Cabal library globally"
-            OA.idm
+    <*> OA.optional cabalUpgradeParser
     <*> setupYamlCompatParser
     <*> OA.optional (OA.strOption
             (OA.long "ghc-bindist"

src/Stack/Solver.hs

@@ -293,15 +293,14 @@ setupCompiler compiler = do
         , soptsUseSystem         = configSystemGHC config
         , soptsWantedCompiler    = compiler
         , soptsCompilerCheck     = configCompilerCheck config
-
         , soptsStackYaml         = Nothing
         , soptsForceReinstall    = False
         , soptsSanityCheck       = False
         , soptsSkipGhcCheck      = False
         , soptsSkipMsys          = configSkipMsys config
-        , soptsUpgradeCabal      = False
+        , soptsUpgradeCabal      = Nothing
         , soptsResolveMissingGHC = msg
-        , soptsSetupInfoYaml    = defaultSetupInfoYaml
+        , soptsSetupInfoYaml     = defaultSetupInfoYaml
         , soptsGHCBindistURL     = Nothing
         }
     return dirs

src/Stack/Types/Version.hs

@@ -27,7 +27,8 @@ module Stack.Types.Version
   ,toMajorVersion
   ,latestApplicableVersion
   ,checkVersion
-  ,nextMajorVersion)
+  ,nextMajorVersion
+  ,UpgradeTo(..))
   where
 
 import           Control.Applicative
@@ -64,6 +65,9 @@ instance Exception VersionParseFail
 instance Show VersionParseFail where
     show (VersionParseFail bs) = "Invalid version: " ++ show bs
 
+-- | A package version or the latest.
+data UpgradeTo = Specific Version | Latest deriving (Show)
+
 -- | A package version.
 newtype Version =
   Version {unVersion :: Vector Word}

src/main/Main.hs

@@ -574,7 +574,7 @@ pathCmd keys go = withBuildConfig go (Stack.Path.path keys)
 setupCmd :: SetupCmdOpts -> GlobalOpts -> IO ()
 setupCmd sco@SetupCmdOpts{..} go@GlobalOpts{..} = do
   lc <- loadConfigWithOpts go
-  when (scoUpgradeCabal && nixEnable (configNix (lcConfig lc))) $ do
+  when (isJust scoUpgradeCabal && nixEnable (configNix (lcConfig lc))) $ do
     throwIO UpgradeCabalUnusable
   withUserFileLock go (configStackRoot $ lcConfig lc) $ \lk -> do
     let getCompilerVersion = loadCompilerVersion go lc