Also fix redundant upgrade warnings for 'ghcup upgrade'
This commit is contained in:
parent
8a6badca1d
commit
43ea85b495
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user