diff --git a/ChangeLog.md b/ChangeLog.md index c816248f59..25a2c1b3f9 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -64,6 +64,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 diff --git a/src/Stack/Setup.hs b/src/Stack/Setup.hs index 893fe88903..94207f7fe5 100644 --- a/src/Stack/Setup.hs +++ b/src/Stack/Setup.hs @@ -138,7 +138,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) @@ -234,7 +234,7 @@ setupEnv mResolveMissingGHC = do , soptsSanityCheck = False , soptsSkipGhcCheck = configSkipGHCCheck config , soptsSkipMsys = configSkipMsys config - , soptsUpgradeCabal = False + , soptsUpgradeCabal = Nothing , soptsResolveMissingGHC = mResolveMissingGHC , soptsSetupInfoYaml = defaultSetupInfoYaml , soptsGHCBindistURL = Nothing @@ -493,11 +493,11 @@ ensureCompiler sopts = do m <- augmentPathMap (edBins ed) (unEnvOverride menv0) mkEnvOverride (configPlatform config) (removeHaskellEnvVars m) - when (soptsUpgradeCabal sopts) $ do + forM_ (soptsUpgradeCabal sopts) $ \version -> 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 version case mtools of Just (Just (ToolGhcjs cv), _) -> ensureGhcjsBooted menv cv (soptsInstallIfMissing sopts) (soptsGHCJSBootOpts sopts) @@ -626,68 +626,75 @@ 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 + $logInfo "Manipulating the global Cabal is only for debugging purposes" let name = $(mkPackageName "Cabal") rmap <- resolvePackages menv Nothing Map.empty (Set.singleton name) - newest <- - case map rpIdent rmap of + installed <- getCabalPkgVer menv wc + case cabalVersion of + Specific version -> do + if installed /= version then + doCabalInstall menv wc installed version + else + $logInfo $ T.concat ["No install necessary. Cabal " + , T.pack $ versionString installed + , " is already installed"] + 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' -> do + if installed > version then + doCabalInstall menv wc installed version + else + $logInfo $ "No upgrade necessary. Latest Cabal already installed" x -> error $ "Unexpected results for resolvePackages: " ++ show x - installed <- getCabalPkgVer menv wc - if installed >= newest - then $logInfo $ T.concat - [ "Currently installed Cabal is " + +-- Configure and run the necessary commands for a cabal install +doCabalInstall :: (StackM env m, HasConfig env, HasGHCVariant env) + => EnvOverride + -> WhichCompiler + -> Version + -> Version + -> m () +doCabalInstall menv wc installed version = do + withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do + $logInfo $ T.concat + [ "Installing Cabal-" + , T.pack $ versionString version + , " to replace " , T.pack $ versionString installed - , ", newest is " - , T.pack $ versionString newest - , ". I'm not upgrading Cabal." ] - else withSystemTempDir "stack-cabal-upgrade" $ \tmpdir -> do - $logInfo $ T.concat - [ "Installing Cabal-" - , T.pack $ versionString newest - , " to replace " - , T.pack $ versionString installed - ] - let ident = PackageIdentifier name newest - -- 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 - let installRoot = toFilePath $ parent (parent compilerPath) - $(mkRelDir "new-cabal") - newestDir - - dir <- - case Map.lookup ident m of - Nothing -> error "upgradeCabal: Invariant violated, dir missing" - Just dir -> return dir - - runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing - platform <- view platformL - let setupExe = toFilePath $ dir - (case platform of - Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe") - _ -> $(mkRelFile "Setup")) - dirArgument name' = concat - [ "--" - , name' - , "dir=" - , installRoot FP. name' - ] - args = "configure" : map dirArgument (words "lib bin data doc") - runCmd (Cmd (Just dir) setupExe menv args) Nothing - runCmd (Cmd (Just dir) setupExe menv ["build"]) Nothing - runCmd (Cmd (Just dir) setupExe menv ["install"]) Nothing - $logInfo "New Cabal library installed" + let name = $(mkPackageName "Cabal") + ident = PackageIdentifier name version + m <- unpackPackageIdents menv tmpdir Nothing (Map.singleton ident Nothing) + compilerPath <- join $ findExecutable menv (compilerExeName wc) + versionDir <- parseRelDir $ versionString version + let installRoot = toFilePath $ parent (parent compilerPath) + $(mkRelDir "new-cabal") + versionDir + dir <- case Map.lookup ident m of + Nothing -> error "upgradeCabal: Invariant violated, dir missing" + Just dir -> return dir + runCmd (Cmd (Just dir) (compilerExeName wc) menv ["Setup.hs"]) Nothing + platform <- view platformL + let setupExe = toFilePath $ dir case platform of + Platform _ Cabal.Windows -> $(mkRelFile "Setup.exe") + _ -> $(mkRelFile "Setup") + dirArgument name' = concat [ "--" + , name' + , "dir=" + , installRoot FP. name' + ] + args = "configure" : map dirArgument (words "lib bin data doc") + runCmd (Cmd (Just dir) setupExe menv args) Nothing + runCmd (Cmd (Just dir) setupExe menv ["build"]) Nothing + runCmd (Cmd (Just dir) setupExe menv ["install"]) Nothing + $logInfo "New Cabal library installed" -- | Get the version of the system compiler, if available getSystemCompiler :: (MonadIO m, MonadLogger m, MonadBaseControl IO m, MonadCatch m) => EnvOverride -> WhichCompiler -> m (Maybe (CompilerVersion, Arch)) diff --git a/src/Stack/SetupCmd.hs b/src/Stack/SetupCmd.hs index ea772ef896..0d8034f879 100644 --- a/src/Stack/SetupCmd.hs +++ b/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) , scoGHCJSBootOpts :: ![String] @@ -50,6 +50,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 @@ -60,10 +76,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" diff --git a/src/Stack/Solver.hs b/src/Stack/Solver.hs index 8cc678c6dd..34bb1331fb 100644 --- a/src/Stack/Solver.hs +++ b/src/Stack/Solver.hs @@ -293,13 +293,12 @@ 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 , soptsGHCBindistURL = Nothing diff --git a/src/Stack/Types/Version.hs b/src/Stack/Types/Version.hs index b0a70a5ff5..6124656e07 100644 --- a/src/Stack/Types/Version.hs +++ b/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 upgrade; Latest or a specific version. +data UpgradeTo = Specific Version | Latest deriving (Show) + -- | A package version. newtype Version = Version {unVersion :: Vector Word} diff --git a/src/main/Main.hs b/src/main/Main.hs index ae005f14d2..8f57488f02 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -578,7 +578,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