Some fixes
This commit is contained in:
parent
d5efc86d85
commit
c9e1261af2
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user