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

implements --force option for cabal installs.

This commit is contained in:
Arjun Kathuria 2021-08-27 13:06:18 +05:30
parent 15560a06b1
commit d7f82d643c
3 changed files with 44 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
app/ghcup/BrickMain.hs
View File

@ -448,7 +448,7 @@ install' _ (_, ListResult {..}) = do
liftE $ installGHCBin lVer Nothing $> vi liftE $ installGHCBin lVer Nothing $> vi
Cabal -> do Cabal -> do
let vi = getVersionInfo lVer Cabal dls let vi = getVersionInfo lVer Cabal dls
liftE $ installCabalBin lVer Nothing $> vi liftE $ installCabalBin lVer Nothing False $> vi
GHCup -> do GHCup -> do
let vi = snd <$> getLatest dls GHCup let vi = snd <$> getLatest dls GHCup
liftE $ upgradeGHCup Nothing False $> vi liftE $ upgradeGHCup Nothing False $> vi

5
app/ghcup/Main.hs
View File

@ -1742,16 +1742,17 @@ Report bugs at <https://gitlab.haskell.org/haskell/ghcup-hs/issues>|]
(case instBindist of (case instBindist of
Nothing -> runInstTool instPlatform $ do Nothing -> runInstTool instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBin (_tvVersion v) isolateDir liftE $ installCabalBin (_tvVersion v) isolateDir forceInstall
pure vi pure vi
Just uri -> do Just uri -> do
s' <- appState s' <- appState
runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do runInstTool' s'{ settings = settings { noVerify = True}} instPlatform $ do
(v, vi) <- liftE $ fromVersion instVer Cabal (v, vi) <- liftE $ fromVersion instVer Cabal
liftE $ installCabalBindist liftE $ installCabalBindist
(DownloadInfo uri Nothing "") (DownloadInfo uri Nothing "")
(_tvVersion v) (_tvVersion v)
isolateDir isolateDir
forceInstall
pure vi pure vi
) )
>>= \case >>= \case

59
lib/GHCup.hs
View File

@ -402,6 +402,7 @@ installCabalBindist :: ( MonadMask m
=> DownloadInfo => DownloadInfo
-> Version -> Version
-> Maybe FilePath -- ^ isolated install filepath, if user provides any. -> Maybe FilePath -- ^ isolated install filepath, if user provides any.
-> Bool -- ^ Force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@ -416,25 +417,32 @@ installCabalBindist :: ( MonadMask m
] ]
m m
() ()
installCabalBindist dlinfo ver isoFilepath = do installCabalBindist dlinfo ver isoFilepath forceInstall = do
lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver lift $ $(logDebug) $ "Requested to install cabal version " <> prettyVer ver
PlatformRequest {..} <- lift getPlatformReq PlatformRequest {..} <- lift getPlatformReq
Dirs {..} <- lift getDirs Dirs {..} <- lift getDirs
case isoFilepath of -- check if we already have a regular cabal already installed
Nothing -> -- for regular install check if any previous versions installed regularCabalInstalled <- checkIfCabalInstalled ver binDir exeExt
whenM
(lift (cabalInstalled ver) >>= \a -> liftIO $ case forceInstall of
handleIO (\_ -> pure False) True -> case isoFilepath of
$ fmap (\x -> a && x) Nothing -> -- force install and a regular install
-- ignore when the installation is a legacy cabal (binary, not symlink) when (regularCabalInstalled)
$ pathIsLink (binDir </> "cabal" <> exeExt) (do
) lift $ $(logInfo) $ "Removing the currently installed version first!"
(throwE $ AlreadyInstalled Cabal ver) liftE $ rmCabalVer ver)
_ -> pure () -- check isn't required in isolated installs _ -> 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) -- download (or use cached version)
dl <- liftE $ downloadCached dlinfo Nothing dl <- liftE $ downloadCached dlinfo Nothing
@ -449,23 +457,34 @@ installCabalBindist dlinfo ver isoFilepath = do
case isoFilepath of case isoFilepath of
Just isoDir -> do -- isolated install Just isoDir -> do -- isolated install
lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir lift $ $(logInfo) $ "isolated installing Cabal to " <> T.pack isoDir
liftE $ installCabalUnpacked workdir isoDir Nothing liftE $ installCabalUnpacked workdir isoDir Nothing forceInstall
Nothing -> do -- regular install 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 -- create symlink if this is the latest version for regular installs
cVers <- lift $ fmap rights getInstalledCabals cVers <- lift $ fmap rights getInstalledCabals
let lInstCabal = headMay . reverse . sort $ cVers let lInstCabal = headMay . reverse . sort $ cVers
when (maybe True (ver >=) lInstCabal) $ liftE $ setCabal ver 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. -- | Install an unpacked cabal distribution.
installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m) installCabalUnpacked :: (MonadLogger m, MonadCatch m, MonadIO m)
=> FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides) => FilePath -- ^ Path to the unpacked cabal bindist (where the executable resides)
-> FilePath -- ^ Path to install to -> FilePath -- ^ Path to install to
-> Maybe Version -- ^ Nothing for isolated install -> Maybe Version -- ^ Nothing for isolated install
-> Bool -- ^ Force Install
-> Excepts '[CopyError, FileAlreadyExistsError] m () -> Excepts '[CopyError, FileAlreadyExistsError] m ()
installCabalUnpacked path inst mver' = do installCabalUnpacked path inst mver' forceInstall = do
lift $ $(logInfo) "Installing cabal" lift $ $(logInfo) "Installing cabal"
let cabalFile = "cabal" let cabalFile = "cabal"
liftIO $ createDirRecursive' inst liftIO $ createDirRecursive' inst
@ -474,7 +493,8 @@ installCabalUnpacked path inst mver' = do
<> exeExt <> exeExt
let destPath = inst </> destFileName 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 handleIO (throwE . CopyError . show) $ liftIO $ copyFile
(path </> cabalFile <> exeExt) (path </> cabalFile <> exeExt)
@ -499,6 +519,7 @@ installCabalBin :: ( MonadMask m
) )
=> Version => Version
-> Maybe FilePath -- isolated install Path, if user provided any -> Maybe FilePath -- isolated install Path, if user provided any
-> Bool -- force install
-> Excepts -> Excepts
'[ AlreadyInstalled '[ AlreadyInstalled
, CopyError , CopyError
@ -513,9 +534,9 @@ installCabalBin :: ( MonadMask m
] ]
m m
() ()
installCabalBin ver isoFilepath = do installCabalBin ver isoFilepath forceInstall = do
dlinfo <- liftE $ getDownloadInfo Cabal ver dlinfo <- liftE $ getDownloadInfo Cabal ver
installCabalBindist dlinfo ver isoFilepath installCabalBindist dlinfo ver isoFilepath forceInstall
-- | Like 'installHLSBin, except takes the 'DownloadInfo' as -- | Like 'installHLSBin, except takes the 'DownloadInfo' as