diff --git a/app/ghcup/BrickMain.hs b/app/ghcup/BrickMain.hs index cb71e45..dbc963d 100644 --- a/app/ghcup/BrickMain.hs +++ b/app/ghcup/BrickMain.hs @@ -443,7 +443,7 @@ install' _ (_, ListResult {..}) = do liftE $ installGHCBin lVer Nothing $> vi Cabal -> do let vi = getVersionInfo lVer Cabal dls - liftE $ installCabalBin lVer Nothing $> vi + liftE $ installCabalBin lVer Nothing False $> vi GHCup -> do let vi = snd <$> getLatest dls GHCup liftE $ upgradeGHCup Nothing False $> vi diff --git a/app/ghcup/Main.hs b/app/ghcup/Main.hs index 343870c..80c5c95 100644 --- a/app/ghcup/Main.hs +++ b/app/ghcup/Main.hs @@ -1779,16 +1779,17 @@ Report bugs at |] (case instBindist of Nothing -> runInstTool instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBin (_tvVersion v) isolateDir + liftE $ installCabalBin (_tvVersion v) isolateDir forceInstall pure vi Just uri -> do s' <- appState runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do (v, vi) <- liftE $ fromVersion instVer Cabal - liftE $ installCabalBindist + liftE $ installCabalBindist (DownloadInfo uri Nothing "") (_tvVersion v) isolateDir + forceInstall pure vi ) >>= \case diff --git a/lib/GHCup.hs b/lib/GHCup.hs index 3a6f315..8813e2a 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -401,6 +401,7 @@ installCabalBindist :: ( MonadMask m => DownloadInfo -> Version -> Maybe FilePath -- ^ isolated install filepath, if user provides any. + -> Bool -- ^ Force install -> Excepts '[ AlreadyInstalled , CopyError @@ -415,25 +416,32 @@ installCabalBindist :: ( MonadMask m ] m () -installCabalBindist dlinfo ver isoFilepath = do - lift $ logDebug $ "Requested to install cabal version " <> prettyVer ver +installCabalBindist dlinfo ver isoFilepath forceInstall = do + lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver PlatformRequest {..} <- lift getPlatformReq Dirs {..} <- lift getDirs - case isoFilepath of - Nothing -> -- for regular install check if any previous versions installed - whenM - (lift (cabalInstalled ver) >>= \a -> liftIO $ - handleIO (\_ -> pure False) - $ fmap (\x -> a && x) - -- ignore when the installation is a legacy cabal (binary, not symlink) - $ pathIsLink (binDir "cabal" <> exeExt) - ) - (throwE $ AlreadyInstalled Cabal ver) - - _ -> pure () -- check isn't required in isolated installs + -- check if we already have a regular cabal already installed + regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt + + case forceInstall of + True -> case isoFilepath of + Nothing -> -- force install and a regular install + when (regularCabalInstalled) + (do + lift $ $(logInfo) $ "Removing the currently installed version first!" + liftE $ rmCabalVer ver) + + _ -> pure () -- force install and an isolated install (checks done later while unpacking) + False -> case isoFilepath of + Nothing -> + when (regularCabalInstalled) + (throwE $ AlreadyInstalled Cabal ver) + + _ -> pure () + -- download (or use cached version) dl <- liftE $ downloadCached dlinfo Nothing @@ -447,25 +455,36 @@ installCabalBindist dlinfo ver isoFilepath = do case isoFilepath of Just isoDir -> do -- isolated install - lift $ logInfo $ "isolated installing Cabal to " <> T.pack isoDir - liftE $ installCabalUnpacked workdir isoDir Nothing + lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir + liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall Nothing -> do -- regular install - liftE $ installCabalUnpacked workdir binDir (Just ver) + liftE $ installCabalUnpacked workdir binDir (Just ver) forceInstall -- create symlink if this is the latest version for regular installs cVers <- lift $ fmap rights getInstalledCabals let lInstCabal = headMay . reverse . sort $ cVers when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver + + where + + checkIfCabalInstalled ver binDir exeExt = (lift (cabalInstalled ver) >>= \a -> liftIO $ + handleIO (\_ -> pure False) + $ fmap (\x -> a && x) + -- ignore when the installation is a legacy cabal (binary, not symlink) + $ pathIsLink (binDir "cabal" <> exeExt) + ) + -- | Install an unpacked cabal distribution. installCabalUnpacked :: (MonadReader env m, HasLog env, MonadCatch m, MonadIO m) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) -> FilePath -- ^ Path to install to -> Maybe Version -- ^ Nothing for isolated install + -> Bool -- ^ Force Install -> Excepts '[CopyError, FileAlreadyExistsError] m () -installCabalUnpacked path inst mver' = do - lift $ logInfo "Installing cabal" +installCabalUnpacked path inst mver' forceInstall = do + lift $ $(logInfo) "Installing cabal" let cabalFile = "cabal" liftIO $ createDirRecursive' inst let destFileName = cabalFile @@ -473,7 +492,8 @@ installCabalUnpacked path inst mver' = do <> exeExt let destPath = inst destFileName - liftE $ throwIfFileAlreadyExists destPath + unless forceInstall -- Overwrite it when it IS a force install + (liftE $ throwIfFileAlreadyExists destPath) handleIO (throwE . CopyError . show) $ liftIO $ copyFile (path cabalFile <> exeExt) @@ -498,6 +518,7 @@ installCabalBin :: ( MonadMask m ) => Version -> Maybe FilePath -- isolated install Path, if user provided any + -> Bool -- force install -> Excepts '[ AlreadyInstalled , CopyError @@ -512,9 +533,9 @@ installCabalBin :: ( MonadMask m ] m () -installCabalBin ver isoFilepath = do +installCabalBin ver isoFilepath forceInstall = do dlinfo <- liftE $ getDownloadInfo Cabal ver - installCabalBindist dlinfo ver isoFilepath + installCabalBindist dlinfo ver isoFilepath forceInstall -- | Like 'installHLSBin, except takes the 'DownloadInfo' as