Skip to content
Snippets Groups Projects
Verified Commit 202f3ea3 authored by Julian Ospald's avatar Julian Ospald :tea:
Browse files

Fix bug where setting non-installed GHC unsets current one

parent 4f09e3ff
No related branches found
No related tags found
No related merge requests found
Pipeline #23378 passed
...@@ -346,6 +346,8 @@ setGHC ver sghc = do ...@@ -346,6 +346,8 @@ setGHC ver sghc = do
let verBS = verToBS (_tvVersion ver) let verBS = verToBS (_tvVersion ver)
ghcdir <- lift $ ghcupGHCDir ver ghcdir <- lift $ ghcupGHCDir ver
whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
-- symlink destination -- symlink destination
Settings { dirs = Dirs {..} } <- lift ask Settings { dirs = Dirs {..} } <- lift ask
liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir liftIO $ hideError AlreadyExists $ createDirRecursive newDirPerms binDir
...@@ -617,43 +619,39 @@ rmGHCVer :: ( MonadReader Settings m ...@@ -617,43 +619,39 @@ rmGHCVer :: ( MonadReader Settings m
-> Excepts '[NotInstalled] m () -> Excepts '[NotInstalled] m ()
rmGHCVer ver = do rmGHCVer ver = do
isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver) isSetGHC <- lift $ fmap (maybe False (== ver)) $ ghcSet (_tvTarget ver)
dir <- lift $ ghcupGHCDir ver
let d' = toFilePath dir whenM (lift $ fmap not $ ghcInstalled ver) (throwE (NotInstalled GHC (ver ^. tvVersion % to prettyVer)))
exists <- liftIO $ doesDirectoryExist dir dir <- lift $ ghcupGHCDir ver
-- this isn't atomic, order matters
if exists when isSetGHC $ do
then do lift $ $(logInfo) [i|Removing ghc symlinks|]
-- this isn't atomic, order matters liftE $ rmPlain (_tvTarget ver)
when isSetGHC $ do
lift $ $(logInfo) [i|Removing ghc symlinks|] lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|]
liftE $ rmPlain (_tvTarget ver) liftIO $ deleteDirRecursive dir
lift $ $(logInfo) [i|Removing directory recursively: #{d'}|] lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|]
liftIO $ deleteDirRecursive dir lift $ rmMinorSymlinks ver
lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|]
lift $ rmMinorSymlinks ver -- first remove
handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver
lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] -- then fix them (e.g. with an earlier version)
-- first remove v' <-
handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver handle
-- then fix them (e.g. with an earlier version) (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing)
v' <- $ fmap Just
handle $ getMajorMinorV (_tvVersion ver)
(\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver))
$ fmap Just >>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
$ getMajorMinorV (_tvVersion ver)
forM_ v' $ \(mj, mi) -> lift (getGHCForMajor mj mi (_tvTarget ver)) Settings { dirs = Dirs {..} } <- lift ask
>>= mapM_ (\v -> liftE $ setGHC v SetGHC_XY)
liftIO
Settings { dirs = Dirs {..} } <- lift ask $ hideError doesNotExistErrorType
$ deleteFile
liftIO $ (baseDir </> [rel|share|])
$ 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 -- | Delete a cabal version. Will try to fix the @cabal@ symlink
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment