Also fix redundant upgrade warnings for 'ghcup upgrade'

This commit is contained in:
Julian Ospald 2021-11-14 16:24:13 +01:00
parent 8a6badca1d
commit 43ea85b495
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
2 changed files with 8 additions and 7 deletions

View File

@ -113,17 +113,17 @@ runUpgrade runAppState =
upgrade :: ( Monad m upgrade :: ( Monad m
, MonadMask m , MonadMask m
, MonadUnliftIO m , MonadUnliftIO m
, MonadFail m , MonadFail m
) )
=> UpgradeOpts => UpgradeOpts
-> Bool -> Bool
-> Dirs
-> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a))
-> (ReaderT LeanAppState m () -> m ()) -> (ReaderT LeanAppState m () -> m ())
-> m ExitCode -> m ExitCode
upgrade uOpts force' runAppState runLogger = do upgrade uOpts force' Dirs{..} runAppState runLogger = do
VRight Dirs{ .. } <- runAppState (VRight <$> getDirs)
target <- case uOpts of target <- case uOpts of
UpgradeInplace -> Just <$> liftIO getExecutablePath UpgradeInplace -> Just <$> liftIO getExecutablePath
(UpgradeAt p) -> pure $ Just p (UpgradeAt p) -> pure $ Just p

View File

@ -296,7 +296,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
Config configCommand -> config configCommand settings keybindings runLogger Config configCommand -> config configCommand settings keybindings runLogger
Whereis whereisOptions Whereis whereisOptions
whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger whereisCommand -> whereis whereisCommand whereisOptions runAppState leanAppstate runLogger
Upgrade uOpts force' -> upgrade uOpts force' runAppState runLogger Upgrade uOpts force' -> upgrade uOpts force' dirs runAppState runLogger
ToolRequirements -> toolRequirements runAppState runLogger ToolRequirements -> toolRequirements runAppState runLogger
ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger
Nuke -> nuke appState runLogger Nuke -> nuke appState runLogger
@ -339,6 +339,7 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver
alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver })) alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver }))
(HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver
alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True
alreadyInstalling _ _ = pure False alreadyInstalling _ _ = pure False
cmp' :: ( HasLog env cmp' :: ( HasLog env