hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Update the running of "Nuke" command in Main.hs

Browse Source
This commit is contained in:
Arjun Kathuria 2021-06-29 08:47:44 +05:30
parent a3b11f21bb
commit f09f4bd1b7
1 changed files with 27 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
app/ghcup/Main.hs
View File

@ -1701,28 +1701,40 @@ Make sure to clean up #{tmpdir} afterwards.|])
>> pure (ExitFailure 13) >> pure (ExitFailure 13)
else putStrLn uri' >> pure ExitSuccess else putStrLn uri' >> pure ExitSuccess
Nuke -> do Nuke ->
runLogger $ $logWarn "WARNING: This will remove GHCup and all installed components from your system." runRm (do
runLogger $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time." lift $ runLogger $ $logWarn "WARNING: This will remove GHCup and all installed components from your system."
lift $ runLogger $ $logWarn "Waiting 10 seconds before commencing, if you want to cancel it, now would be the time."
liftIO $ threadDelay 10000000 -- wait 10s
threadDelay 10000000 -- wait 10s lift $ runLogger $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
lift $ runLogger $ $logInfo "Nuking in 3...2...1"
runLogger $ $logInfo "Initiating Nuclear Sequence 🚀🚀🚀"
runLogger $ $logInfo "Nuking in 3...2...1"
lInstalled <- runLogger . flip runReaderT appstate $ listVersions Nothing (Just ListInstalled) lInstalled <- lift $ runLogger . flip runReaderT appstate $ listVersions Nothing (Just ListInstalled)
forM_ lInstalled $ runRm . rmTool
leftOverFiles <- runLogger $ runReaderT rmGhcupDirs appstate forM_ lInstalled (liftE . rmTool)
leftOverFiles <- lift $ runLogger $ runReaderT rmGhcupDirs appstate
pure leftOverFiles
) >>= \case
VRight leftOverFiles -> do
case length leftOverFiles of case length leftOverFiles of
0 -> runLogger $ $logInfo "Nuclear Annihilation complete!" 0 -> do
runLogger $ $logInfo "Nuclear Annihilation complete!"
pure ExitSuccess
_ -> do _ -> do
runLogger $ $logWarn "These Directories/Files have survived Nuclear Annihilation, you may remove them manually." runLogger $ $logWarn "These Directories/Files have survived Nuclear Annihilation, you may remove them manually."
forM_ leftOverFiles (runLogger . $logWarn . T.pack) forM_ leftOverFiles (runLogger . $logDebug . T.pack)
pure ExitSuccess pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 15
case res of case res of
ExitSuccess -> pure () ExitSuccess -> pure ()
ef@(ExitFailure _) -> exitWith ef ef@(ExitFailure _) -> exitWith ef