hasufell/ghcup-hs
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Some fixes

Browse Source
This commit is contained in:
Julian Ospald
2022-05-20 00:46:50 +02:00
parent d5efc86d85
commit c9e1261af2
3 changed files with 8 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
lib/GHCup/Utils/File.hs
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