Adds basic "nuke" command structure so that it reflects in ghcup cli

This commit is contained in:
Arjun Kathuria 2021-06-18 15:01:32 +05:30
parent d9d196439f
commit 877b55e21d
1 changed files with 16 additions and 2 deletions

View File

@ -103,6 +103,7 @@ data Command
| Upgrade UpgradeOpts Bool | Upgrade UpgradeOpts Bool
| ToolRequirements | ToolRequirements
| ChangeLog ChangeLogOptions | ChangeLog ChangeLogOptions
| Nuke
#if defined(BRICK) #if defined(BRICK)
| Interactive | Interactive
#endif #endif
@ -219,7 +220,7 @@ invertableSwitch'
-> Mod FlagFields Bool -- ^ option modifier for --no-foo -> Mod FlagFields Bool -- ^ option modifier for --no-foo
-> Parser (Maybe Bool) -> Parser (Maybe Bool)
invertableSwitch' longopt shortopt defv enmod dismod = optional invertableSwitch' longopt shortopt defv enmod dismod = optional
( flag' True (enmod <> long longopt <> if defv then mempty else short shortopt) ( flag' True ( enmod <> long longopt <> if defv then mempty else short shortopt)
<|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty) <|> flag' False (dismod <> long nolongopt <> if defv then short shortopt else mempty)
) )
where where
@ -368,6 +369,14 @@ com =
) )
<> internal <> internal
) )
<|> subparser
(command
"nuke"
(info (pure Nuke <**> helper)
(progDesc "Completely remove ghcup from your system"))
<> commandGroup "Nuclear Commands:"
)
where where
installToolFooter :: String installToolFooter :: String
installToolFooter = [s|Discussion: installToolFooter = [s|Discussion:
@ -393,7 +402,6 @@ com =
By default returns the URI of the ChangeLog of the latest GHC release. By default returns the URI of the ChangeLog of the latest GHC release.
Pass '-o' to automatically open via xdg-open.|] Pass '-o' to automatically open via xdg-open.|]
installCabalFooter :: String installCabalFooter :: String
installCabalFooter = [s|Discussion: installCabalFooter = [s|Discussion:
Installs the specified cabal-install version (or a recommended default one) Installs the specified cabal-install version (or a recommended default one)
@ -1654,6 +1662,10 @@ Make sure to clean up #{tmpdir} afterwards.|])
VLeft e -> do VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 12 pure $ ExitFailure 12
Nuke -> do
putStrLn "Nuking in 3...2....1"
putStrLn "BOOM!"
pure ExitSuccess
ChangeLog ChangeLogOptions{..} -> do ChangeLog ChangeLogOptions{..} -> do
let tool = fromMaybe GHC clTool let tool = fromMaybe GHC clTool
@ -1696,6 +1708,8 @@ Make sure to clean up #{tmpdir} afterwards.|])
case res of case res of
ExitSuccess -> pure () ExitSuccess -> pure ()
ef@(ExitFailure _) -> exitWith ef ef@(ExitFailure _) -> exitWith ef
pure () pure ()
fromVersion :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m) fromVersion :: (MonadLogger m, MonadFail m, MonadReader AppState m, MonadThrow m, MonadIO m, MonadCatch m)