diff --git a/app/ghcup/GHCup/OptParse/Upgrade.hs b/app/ghcup/GHCup/OptParse/Upgrade.hs index 878b879..fd50061 100644 --- a/app/ghcup/GHCup/OptParse/Upgrade.hs +++ b/app/ghcup/GHCup/OptParse/Upgrade.hs @@ -113,17 +113,17 @@ runUpgrade runAppState = upgrade :: ( Monad m - , MonadMask m - , MonadUnliftIO m - , MonadFail m - ) + , MonadMask m + , MonadUnliftIO m + , MonadFail m + ) => UpgradeOpts -> Bool + -> Dirs -> (forall a. ReaderT AppState m (VEither UpgradeEffects a) -> m (VEither UpgradeEffects a)) -> (ReaderT LeanAppState m () -> m ()) -> m ExitCode -upgrade uOpts force' runAppState runLogger = do - VRight Dirs{ .. } <- runAppState (VRight <$> getDirs) +upgrade uOpts force' Dirs{..} runAppState runLogger = do target <- case uOpts of UpgradeInplace -> Just <$> liftIO getExecutablePath (UpgradeAt p) -> pure $ Just p diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index d8d05d6..5cfb30c 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -296,7 +296,7 @@ Report bugs at |] Config configCommand -> config configCommand settings keybindings runLogger Whereis whereisOptions 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 ChangeLog changelogOpts -> changelog changelogOpts runAppState runLogger Nuke -> nuke appState runLogger @@ -339,6 +339,7 @@ Report bugs at |] (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer over)) ver alreadyInstalling (Compile (CompileHLS HLSCompileOptions{ targetHLS = Left tver })) (HLS, ver) = cmp' HLS (Just $ ToolVersion (mkTVer tver)) ver + alreadyInstalling (Upgrade _ _) (GHCup, _) = pure True alreadyInstalling _ _ = pure False cmp' :: ( HasLog env