diff --git a/CHANGELOG.md b/CHANGELOG.md index 9f17977..a1e86c4 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,7 @@ ## 0.1.12 -- ????-??-?? +* Fix disappearing HLS symlinks wrt #91 * improve TUI: - separators between tools sections - reverse list order so latest is on top diff --git a/lib/GHCup.hs b/lib/GHCup.hs index b7c436b..0ac6e25 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -535,8 +535,8 @@ setGHC ver sghc = do -- with old ghcup) case sghc of SetGHCOnly -> liftE $ rmPlain (_tvTarget ver) - SetGHC_XY -> lift $ rmMajorSymlinks ver - SetGHC_XYZ -> lift $ rmMinorSymlinks ver + SetGHC_XY -> liftE $ rmMajorSymlinks ver + SetGHC_XYZ -> liftE $ rmMinorSymlinks ver -- for ghc tools (ghc, ghci, haddock, ...) verfiles <- ghcToolFiles ver @@ -937,16 +937,17 @@ rmGHCVer ver = do lift $ $(logInfo) [i|Removing ghc symlinks|] liftE $ rmPlain (_tvTarget ver) - lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|] - liftIO $ deleteDirRecursive dir - lift $ $(logInfo) [i|Removing ghc-x.y.z symlinks|] - lift $ rmMinorSymlinks ver + liftE $ rmMinorSymlinks ver lift $ $(logInfo) [i|Removing/rewiring ghc-x.y symlinks|] -- first remove - handle (\(_ :: ParseError) -> pure ()) $ lift $ rmMajorSymlinks ver + handle (\(_ :: ParseError) -> pure ()) $ liftE $ rmMajorSymlinks ver -- then fix them (e.g. with an earlier version) + + lift $ $(logInfo) [i|Removing directory recursively: #{toFilePath dir}|] + liftIO $ deleteDirRecursive dir + v' <- handle (\(e :: ParseError) -> lift $ $(logWarn) [i|#{e}|] >> pure Nothing) diff --git a/lib/GHCup/Utils.hs b/lib/GHCup/Utils.hs index 95e65d2..3c21ae0 100644 --- a/lib/GHCup/Utils.hs +++ b/lib/GHCup/Utils.hs @@ -112,33 +112,40 @@ ghcLinkDestination tool ver = do -- | Removes the minor GHC symlinks, e.g. ghc-8.6.5. -rmMinorSymlinks :: (MonadReader AppState m, MonadIO m, MonadLogger m) => GHCTargetVersion -> m () -rmMinorSymlinks GHCTargetVersion {..} = do - AppState { dirs = Dirs {..} } <- ask - - files <- liftIO $ findFiles' - binDir - ( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget - *> parseUntil1 (MP.chunk $ prettyVer _tvVersion) - *> (MP.chunk $ prettyVer _tvVersion) - *> MP.eof - ) +rmMinorSymlinks :: ( MonadReader AppState m + , MonadIO m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadReader AppState m + ) + => GHCTargetVersion + -> Excepts '[NotInstalled] m () +rmMinorSymlinks tv@(GHCTargetVersion {..}) = do + AppState { dirs = Dirs {..} } <- lift ask + files <- liftE $ ghcToolFiles tv forM_ files $ \f -> do - let fullF = (binDir f) - $(logDebug) [i|rm -f #{toFilePath fullF}|] + f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> verToBS _tvVersion) + let fullF = (binDir f_xyz) + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] liftIO $ hideError doesNotExistErrorType $ deleteFile fullF -- | Removes the set ghc version for the given target, if any. -rmPlain :: (MonadReader AppState m, MonadLogger m, MonadThrow m, MonadFail m, MonadIO m) - => Maybe Text -- ^ target +rmPlain :: ( MonadReader AppState m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadIO m + ) + => Maybe Text -- ^ target -> Excepts '[NotInstalled] m () rmPlain target = do AppState { dirs = Dirs {..} } <- lift ask - mtv <- lift $ ghcSet target + mtv <- lift $ ghcSet target forM_ mtv $ \tv -> do - files <- liftE $ ghcToolFiles tv + files <- liftE $ ghcToolFiles tv forM_ files $ \f -> do let fullF = (binDir f) lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] @@ -150,25 +157,25 @@ rmPlain target = do -- | Remove the major GHC symlink, e.g. ghc-8.6. -rmMajorSymlinks :: (MonadReader AppState m, MonadThrow m, MonadLogger m, MonadIO m) +rmMajorSymlinks :: ( MonadReader AppState m + , MonadIO m + , MonadLogger m + , MonadThrow m + , MonadFail m + , MonadReader AppState m + ) => GHCTargetVersion - -> m () -rmMajorSymlinks GHCTargetVersion {..} = do - AppState { dirs = Dirs {..} } <- ask + -> Excepts '[NotInstalled] m () +rmMajorSymlinks tv@(GHCTargetVersion {..}) = do + AppState { dirs = Dirs {..} } <- lift ask (mj, mi) <- getMajorMinorV _tvVersion let v' = intToText mj <> "." <> intToText mi - files <- liftIO $ findFiles' - binDir - ( maybe mempty (\x -> MP.chunk (x <> "-")) _tvTarget - *> parseUntil1 (MP.chunk v') - *> MP.chunk v' - *> MP.eof - ) - + files <- liftE $ ghcToolFiles tv forM_ files $ \f -> do - let fullF = (binDir f) - $(logDebug) [i|rm -f #{toFilePath fullF}|] + f_xyz <- liftIO $ parseRel (toFilePath f <> B.singleton _hyphen <> E.encodeUtf8 v') + let fullF = (binDir f_xyz) + lift $ $(logDebug) [i|rm -f #{toFilePath fullF}|] liftIO $ hideError doesNotExistErrorType $ deleteFile fullF