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

Fix upgrade subcommand running appstate twice

Browse Source
This commit is contained in:
Julian Ospald 2021-07-27 20:57:51 +02:00
parent e4e52ebf6b
commit 0c666a6bbe
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
1 changed files with 19 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
app/ghcup/Main.hs
View File

@ -2026,22 +2026,25 @@ Make sure to clean up #{tmpdir} afterwards.|])
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p
UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt)) UpgradeGHCupDir -> pure (Just (binDir </> "ghcup" <> exeExt))
runUpgrade (liftE $ upgradeGHCup target force') >>= \case runUpgrade (do
VRight v' -> do v' <- liftE $ upgradeGHCup target force'
GHCupInfo { _ghcupDownloads = dls } <- runAppState getGHCupInfo GHCupInfo { _ghcupDownloads = dls } <- lift getGHCupInfo
let pretty_v = prettyVer v' pure (v', dls)
let vi = fromJust $ snd <$> getLatest dls GHCup ) >>= \case
runLogger $ $(logInfo) VRight (v', dls) -> do
[i|Successfully upgraded GHCup to version #{pretty_v}|] let pretty_v = prettyVer v'
forM_ (_viPostInstall vi) $ \msg -> let vi = fromJust $ snd <$> getLatest dls GHCup
runLogger $ $(logInfo) msg runLogger $ $(logInfo)
pure ExitSuccess [i|Successfully upgraded GHCup to version #{pretty_v}|]
VLeft (V NoUpdate) -> do forM_ (_viPostInstall vi) $ \msg ->
runLogger $ $(logWarn) [i|No GHCup update available|] runLogger $ $(logInfo) msg
pure ExitSuccess pure ExitSuccess
VLeft e -> do VLeft (V NoUpdate) -> do
runLogger $ $(logError) $ T.pack $ prettyShow e runLogger $ $(logWarn) [i|No GHCup update available|]
pure $ ExitFailure 11 pure ExitSuccess
VLeft e -> do
runLogger $ $(logError) $ T.pack $ prettyShow e
pure $ ExitFailure 11
ToolRequirements -> do ToolRequirements -> do
s' <- appState s' <- appState