Some fixes

This commit is contained in:
Julian Ospald 2022-05-20 00:46:50 +02:00
parent d5efc86d85
commit c9e1261af2
Signed by: hasufell
GPG Key ID: 3786C5262ECB4A3F
3 changed files with 8 additions and 7 deletions

View File

@ -289,6 +289,7 @@ fi
eghcup upgrade
eghcup upgrade -f
# test that doing fishy symlinks into GHCup dir doesn't cause weird stuff on 'ghcup nuke'
mkdir no_nuke/
mkdir no_nuke/bar
echo 'foo' > no_nuke/file

View File

@ -1809,7 +1809,7 @@ rmGHCVer ver = do
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack dir
forM_ files (lift . recycleFile . (\f -> dir </> dropDrive f))
removeEmptyDirsRecursive (liftIO . removeEmptyDirectory) dir
removeEmptyDirsRecursive dir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory dir
f <- recordedInstallationFile GHC ver
lift $ recycleFile f
@ -1893,7 +1893,7 @@ rmHLSVer ver = do
Just files -> do
lift $ logInfo $ "Removing files safely from: " <> T.pack hlsDir
forM_ files (lift . recycleFile . (\f -> hlsDir </> dropDrive f))
removeEmptyDirsRecursive (liftIO . removeEmptyDirectory) hlsDir
removeEmptyDirsRecursive hlsDir
survivors <- liftIO $ hideErrorDef [doesNotExistErrorType] [] $ listDirectory hlsDir
f <- recordedInstallationFile HLS (mkTVer ver)
lift $ recycleFile f
@ -2049,7 +2049,7 @@ rmGhcupDirs = do
logInfo $ "removing " <> T.pack (fromGHCupPath baseDir </> "msys64")
handleRm $ rmPathForcibly (baseDir `appendGHCupPath` "msys64")
handleRm $ removeEmptyDirsRecursive removeDirIfEmptyOrIsSymlink (fromGHCupPath baseDir)
handleRm $ removeEmptyDirsRecursive (fromGHCupPath baseDir)
-- report files in baseDir that are left-over after
-- the standard location deletions above

View File

@ -133,7 +133,7 @@ mergeFileTree sourceBase destBase tool v' copyOp = do
hideError NoSuchThing $ rmFile recFile
logDebug $ "rm -f " <> T.pack (fromInstallDir destBase)
hideError UnsatisfiedConstraints $ hideError NoSuchThing $
removeEmptyDirsRecursive (hideError UnsatisfiedConstraints . liftIO . removeEmptyDirectory) (fromInstallDir destBase)
removeEmptyDirsRecursive (fromInstallDir destBase)
recordInstalledFile f recFile = when (isSafeDir destBase) $
@ -223,13 +223,13 @@ removeDirIfEmptyOrIsSymlink filepath =
then rmFileForce fp
else liftIO $ ioError e
removeEmptyDirsRecursive :: (MonadMask m, MonadIO m, MonadCatch m) => (FilePath -> m ()) -> FilePath -> m ()
removeEmptyDirsRecursive rmOpt = go
removeEmptyDirsRecursive :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
removeEmptyDirsRecursive = go
where
go fp = do
cs <- liftIO $ listDirectory fp >>= filterM doesDirectoryExist . fmap (fp </>)
forM_ cs go
hideError InappropriateType $ rmOpt fp
liftIO $ removeEmptyDirectory fp
rmFileForce :: (MonadMask m, MonadIO m) => FilePath -> m ()
rmFileForce filepath = do