handle symlink case when deleting directories in rmGhcupDirs

This commit is contained in:
Arjun Kathuria 2021-06-26 19:52:32 +05:30
parent 46fcdd356c
commit 59519febbc
1 changed files with 14 additions and 5 deletions

View File

@ -1381,19 +1381,19 @@ rmGhcupDirs = do
$logInfo "removing ghcup cache Dir" $logInfo "removing ghcup cache Dir"
contents <- liftIO $ listDirectory cacheDir contents <- liftIO $ listDirectory cacheDir
forM_ contents deleteFile forM_ contents deleteFile
removeDirIfEmpty cacheDir removeDirIfEmptyOrIsSymlink cacheDir
rmLogsDir logsDir = do rmLogsDir logsDir = do
$logInfo "removing ghcup logs Dir" $logInfo "removing ghcup logs Dir"
contents <- liftIO $ listDirectory logsDir contents <- liftIO $ listDirectory logsDir
forM_ contents deleteFile forM_ contents deleteFile
removeDirIfEmpty logsDir removeDirIfEmptyOrIsSymlink logsDir
rmBinDir binDir = do rmBinDir binDir = do
#if !defined(IS_WINDOWS) #if !defined(IS_WINDOWS)
isXDGStyle <- liftIO $ useXDG isXDGStyle <- liftIO $ useXDG
if not isXDGStyle if not isXDGStyle
then removeDirIfEmpty binDir then removeDirIfEmptyOrIsSymlink binDir
else pure () else pure ()
#else #else
removeDirIfEmpty binDir removeDirIfEmpty binDir
@ -1402,8 +1402,17 @@ rmGhcupDirs = do
deleteFile filepath = do deleteFile filepath = do
hideError InappropriateType $ rmFile filepath hideError InappropriateType $ rmFile filepath
removeDirIfEmpty filepath = removeDirIfEmptyOrIsSymlink filepath =
hideError UnsatisfiedConstraints $ liftIO $ removeDirectory filepath hideError UnsatisfiedConstraints $
handleIO' InappropriateType
(handleIfSym filepath)
(liftIO $ removeDirectory filepath)
where
handleIfSym fp e = do
isSym <- liftIO $ pathIsSymbolicLink fp
if isSym
then liftIO $ deleteFile fp
else liftIO $ ioError e
------------------ ------------------
--[ Debug info ]-- --[ Debug info ]--