From e46608a7cda6dc666dc1649b40dab352905a5314 Mon Sep 17 00:00:00 2001 From: Oleg Grenrus Date: Mon, 13 Apr 2020 16:25:38 +0300 Subject: [PATCH] Resolve #6691: Remove upgrade, uninstall and win32selfupgrade commands All three were hidden commands, first two were unimplemented and the last one no-one knows about. --- cabal-install/Distribution/Client/Setup.hs | 66 ---------------------- cabal-install/main/Main.hs | 45 +-------------- 2 files changed, 1 insertion(+), 110 deletions(-) diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs index d52bc594cd7..90bd1dac7a3 100644 --- a/cabal-install/Distribution/Client/Setup.hs +++ b/cabal-install/Distribution/Client/Setup.hs @@ -30,8 +30,6 @@ module Distribution.Client.Setup , defaultSolver, defaultMaxBackjumps , listCommand, ListFlags(..) , updateCommand, UpdateFlags(..), defaultUpdateFlags - , upgradeCommand - , uninstallCommand , infoCommand, InfoFlags(..) , fetchCommand, FetchFlags(..) , freezeCommand, FreezeFlags(..) @@ -45,7 +43,6 @@ module Distribution.Client.Setup , runCommand , initCommand, initOptions, IT.InitFlags(..) , sdistCommand, SDistFlags(..) - , win32SelfUpgradeCommand, Win32SelfUpgradeFlags(..) , actAsSetupCommand, ActAsSetupFlags(..) , sandboxCommand, defaultSandboxLocation, SandboxFlags(..) , execCommand, ExecFlags(..), defaultExecFlags @@ -1376,18 +1373,6 @@ updateCommand = CommandUI { -- * Other commands -- ------------------------------------------------------------ -upgradeCommand :: CommandUI ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags - ) -upgradeCommand = configureCommand { - commandName = "upgrade", - commandSynopsis = "(command disabled, use install instead)", - commandDescription = Nothing, - commandUsage = usageFlagsOrPackages "upgrade", - commandDefaultFlags = (mempty, mempty, mempty, mempty, mempty, mempty), - commandOptions = commandOptions installCommand - } - cleanCommand :: CommandUI CleanFlags cleanCommand = Cabal.cleanCommand { commandUsage = \pname -> @@ -1421,17 +1406,6 @@ formatCommand = CommandUI { commandOptions = \_ -> [] } -uninstallCommand :: CommandUI (Flag Verbosity) -uninstallCommand = CommandUI { - commandName = "uninstall", - commandSynopsis = "Warn about 'uninstall' not being implemented.", - commandDescription = Nothing, - commandNotes = Nothing, - commandUsage = usageAlternatives "uninstall" ["PACKAGES"], - commandDefaultFlags = toFlag normal, - commandOptions = \_ -> [] - } - manpageCommand :: CommandUI ManpageFlags manpageCommand = CommandUI { commandName = "man", @@ -2510,41 +2484,6 @@ registerCommand :: CommandUI RegisterFlags registerCommand = Cabal.registerCommand { commandUsage = \pname -> "Usage: " ++ pname ++ " v1-register [FLAGS]\n" } --- ------------------------------------------------------------ --- * Win32SelfUpgrade flags --- ------------------------------------------------------------ - -data Win32SelfUpgradeFlags = Win32SelfUpgradeFlags { - win32SelfUpgradeVerbosity :: Flag Verbosity -} deriving Generic - -defaultWin32SelfUpgradeFlags :: Win32SelfUpgradeFlags -defaultWin32SelfUpgradeFlags = Win32SelfUpgradeFlags { - win32SelfUpgradeVerbosity = toFlag normal -} - -win32SelfUpgradeCommand :: CommandUI Win32SelfUpgradeFlags -win32SelfUpgradeCommand = CommandUI { - commandName = "win32selfupgrade", - commandSynopsis = "Self-upgrade the executable on Windows", - commandDescription = Nothing, - commandNotes = Nothing, - commandUsage = \pname -> - "Usage: " ++ pname ++ " win32selfupgrade PID PATH\n", - commandDefaultFlags = defaultWin32SelfUpgradeFlags, - commandOptions = \_ -> - [optionVerbosity win32SelfUpgradeVerbosity - (\v flags -> flags { win32SelfUpgradeVerbosity = v}) - ] -} - -instance Monoid Win32SelfUpgradeFlags where - mempty = gmempty - mappend = (<>) - -instance Semigroup Win32SelfUpgradeFlags where - (<>) = gmappend - -- ------------------------------------------------------------ -- * ActAsSetup flags -- ------------------------------------------------------------ @@ -2936,11 +2875,6 @@ optionSolverFlags showOrParseArgs getmbj setmbj getrg setrg getcc setcc ] -usageFlagsOrPackages :: String -> String -> String -usageFlagsOrPackages name pname = - "Usage: " ++ pname ++ " " ++ name ++ " [FLAGS]\n" - ++ " or: " ++ pname ++ " " ++ name ++ " [PACKAGES]\n" - usagePackages :: String -> String -> String usagePackages name pname = "Usage: " ++ pname ++ " " ++ name ++ " [PACKAGES]\n" diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 01ae5070c88..1d1cffbd8fe 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -24,7 +24,7 @@ import Distribution.Client.Setup , BuildFlags(..), BuildExFlags(..), SkipAddSourceDepsCheck(..) , buildCommand, replCommand, testCommand, benchmarkCommand , InstallFlags(..), defaultInstallFlags - , installCommand, upgradeCommand, uninstallCommand + , installCommand , FetchFlags(..), fetchCommand , FreezeFlags(..), freezeCommand , genBoundsCommand @@ -39,7 +39,6 @@ import Distribution.Client.Setup , ReportFlags(..), reportCommand , runCommand , InitFlags(initVerbosity, initHcPath), initCommand - , Win32SelfUpgradeFlags(..), win32SelfUpgradeCommand , ActAsSetupFlags(..), actAsSetupCommand , SandboxFlags(..), sandboxCommand , ExecFlags(..), execCommand @@ -138,7 +137,6 @@ import Distribution.Client.Types.Credentials (Password (..)) import Distribution.Client.Init (initCabal) import Distribution.Client.Manpage (manpageCmd) import Distribution.Client.ManpageFlags (ManpageFlags (..)) -import qualified Distribution.Client.Win32SelfUpgrade as Win32SelfUpgrade import Distribution.Client.Utils (determineNumJobs ,relaxEncodingErrors ) @@ -273,10 +271,7 @@ mainWorker args = do , regularCmd genBoundsCommand genBoundsAction , regularCmd outdatedCommand outdatedAction , wrapperCmd hscolourCommand hscolourVerbosity hscolourDistPref - , hiddenCmd uninstallCommand uninstallAction , hiddenCmd formatCommand formatAction - , hiddenCmd upgradeCommand upgradeAction - , hiddenCmd win32SelfUpgradeCommand win32SelfUpgradeAction , hiddenCmd actAsSetupCommand actAsSetupAction , hiddenCmd manpageCommand (manpageAction commandSpecs) @@ -865,24 +860,6 @@ updateAction updateFlags extraArgs globalFlags = do withRepoContext verbosity globalFlags' $ \repoContext -> update verbosity updateFlags repoContext -upgradeAction :: ( ConfigFlags, ConfigExFlags, InstallFlags - , HaddockFlags, TestFlags, BenchmarkFlags ) - -> [String] -> Action -upgradeAction (configFlags, _, _, _, _, _) _ _ = die' verbosity $ - "Use the 'cabal install' command instead of 'cabal upgrade'.\n" - ++ "You can install the latest version of a package using 'cabal install'. " - ++ "The 'cabal upgrade' command has been removed because people found it " - ++ "confusing and it often led to broken packages.\n" - ++ "If you want the old upgrade behaviour then use the install command " - ++ "with the --upgrade-dependencies flag (but check first with --dry-run " - ++ "to see what would happen). This will try to pick the latest versions " - ++ "of all dependencies, rather than the usual behaviour of trying to pick " - ++ "installed versions of all dependencies. If you do use " - ++ "--upgrade-dependencies, it is recommended that you do not upgrade core " - ++ "packages (e.g. by using appropriate --constraint= flags)." - where - verbosity = fromFlag (configVerbosity configFlags) - fetchAction :: FetchFlags -> [String] -> Action fetchAction fetchFlags extraArgs globalFlags = do let verbosity = fromFlag (fetchVerbosity fetchFlags) @@ -1035,18 +1012,6 @@ formatAction verbosityFlag extraArgs _globalFlags = do -- Uses 'writeFileAtomic' under the hood. writeGenericPackageDescription path pkgDesc -uninstallAction :: Flag Verbosity -> [String] -> Action -uninstallAction verbosityFlag extraArgs _globalFlags = do - let verbosity = fromFlag verbosityFlag - package = case extraArgs of - p:_ -> p - _ -> "PACKAGE_NAME" - die' verbosity $ "This version of 'cabal-install' does not support the 'uninstall' " - ++ "operation. " - ++ "It will likely be implemented at some point in the future; " - ++ "in the meantime you're advised to use either 'ghc-pkg unregister " - ++ package ++ "' or 'cabal sandbox hc-pkg -- unregister " ++ package ++ "'." - reportAction :: ReportFlags -> [String] -> Action reportAction reportFlags extraArgs globalFlags = do let verbosity = fromFlag (reportVerbosity reportFlags) @@ -1187,14 +1152,6 @@ userConfigAction ucflags extraArgs globalFlags = do _ -> die' verbosity $ "Unknown 'user-config' subcommand: " ++ unwords extraArgs where configFile = getConfigFilePath (globalConfigFile globalFlags) --- | See 'Distribution.Client.Install.withWin32SelfUpgrade' for details. --- -win32SelfUpgradeAction :: Win32SelfUpgradeFlags -> [String] -> Action -win32SelfUpgradeAction selfUpgradeFlags (pid:path:_extraArgs) _globalFlags = do - let verbosity = fromFlag (win32SelfUpgradeVerbosity selfUpgradeFlags) - Win32SelfUpgrade.deleteOldExeFile verbosity (fromMaybe (error $ "panic! read pid=" ++ show pid) $ readMaybe pid) path -- TODO: eradicateNoParse -win32SelfUpgradeAction _ _ _ = return () - -- | Used as an entry point when cabal-install needs to invoke itself -- as a setup script. This can happen e.g. when doing parallel builds. --