Fix bug where setting non-installed GHC unsets current one
This commit is contained in:
parent
4f09e3ff7e
commit
202f3ea3ba
12
lib/GHCup.hs
12
lib/GHCup.hs
@ -346,6 +346,8 @@ setGHC ver sghc = do
|
||||
let verBS = verToBS (_tvVersion ver)
|
||||
ghcdir <- lift $ ghcupGHCDir ver
|
||||
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
|
||||
|
||||
-- symlink destination
|
||||
Settings { dirs = Dirs {..} } <- lift ask
|
||||
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir
|
||||
@ -617,19 +619,16 @@ rmGHCVer :: ( MonadReader Settings m
|
||||
-> Excepts '[NotInstalled] m ()
|
||||
rmGHCVer ver = do
|
||||
isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
|
||||
|
||||
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
|
||||
dir <- lift $ ghcupGHCDir ver
|
||||
let d' = toFilePath dir
|
||||
exists <- liftIO $ doesDirectoryExist dir
|
||||
|
||||
|
||||
if exists
|
||||
then do
|
||||
-- this isn't atomic, order matters
|
||||
when isSetGHC $ do
|
||||
lift $ $(logInfo) [i|Removing ghc symlinks|]
|
||||
liftE $ rmPlain (_tvTarget ver)
|
||||
|
||||
lift $ $(logInfo) [i|Removing directory recursively: #{d'}|]
|
||||
lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
|
||||
liftIO $ deleteDirRecursive dir
|
||||
|
||||
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
|
||||
@ -653,7 +652,6 @@ rmGHCVer ver = do
|
||||
$ hideError doesNotExistErrorType
|
||||
$ deleteFile
|
||||
$ (baseDir </> [rel|share|])
|
||||
else throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer))
|
||||
|
||||
|
||||
-- | Delete a cabal version. Will try to fix the @cabal@ symlink
|
||||
|
Loading…
Reference in New Issue
Block a user