diff --git a/.gitlab/script/ghcup_version.sh b/.gitlab/script/ghcup_version.sh index 137388f..5dc547a 100755 --- a/.gitlab/script/ghcup_version.sh +++ b/.gitlab/script/ghcup_version.sh @@ -289,7 +289,19 @@ fi eghcup upgrade eghcup upgrade -f +mkdir no_nuke/ +mkdir no_nuke/bar +echo 'foo' > no_nuke/file +echo 'bar' > no_nuke/bar/file +ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/cache/no_nuke +ln -s "$CI_PROJECT_DIR"/no_nuke/ "${GHCUP_DIR}"/logs/no_nuke # nuke eghcup nuke [ ! -e "${GHCUP_DIR}" ] + +# make sure nuke doesn't resolve symlinks +[ -e "$CI_PROJECT_DIR"/no_nuke/file ] +[ -e "$CI_PROJECT_DIR"/no_nuke/bar/file ] + + diff --git a/lib/GHCup.hs b/lib/GHCup.hs index dddf78f..359bce7 100644 --- a/lib/GHCup.hs +++ b/lib/GHCup.hs @@ -2017,6 +2017,7 @@ rmGhcupDirs = do , logsDir , cacheDir , recycleDir + , dbDir } <- getDirs let envFilePath = fromGHCupPath baseDir "env" @@ -2027,11 +2028,12 @@ rmGhcupDirs = do handleRm $ rmConfFile confFilePath -- for xdg dirs, the order matters here - handleRm $ rmDir logsDir - handleRm $ rmDir cacheDir + handleRm $ rmPathForcibly logsDir + handleRm $ rmPathForcibly cacheDir handleRm $ rmBinDir binDir - handleRm $ rmDir recycleDir + handleRm $ rmPathForcibly recycleDir + handleRm $ rmPathForcibly dbDir when isWindows $ do logInfo $ "removing " <> T.pack (fromGHCupPath baseDir "msys64") handleRm $ rmPathForcibly (baseDir `appendGHCupPath` "msys64") @@ -2057,15 +2059,6 @@ rmGhcupDirs = do logInfo "removing Ghcup Config File" hideErrorDef [permissionErrorType] () $ deleteFile' confFilePath - rmDir :: (HasLog env, MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => GHCupPath -> m () - rmDir dir = - -- 'getDirectoryContentsRecursive' is lazy IO. In case - -- an error leaks through, we catch it here as well, - -- althought 'deleteFile' should already handle it. - hideErrorDef [doesNotExistErrorType] () $ do - logInfo $ "removing " <> T.pack (fromGHCupPath dir) - liftIO $ flip S.mapM_ (getDirectoryContentsRecursive dir) $ deleteFile' . (fromGHCupPath dir ) - rmBinDir :: (MonadReader env m, HasDirs env, MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () rmBinDir binDir | isWindows = removeDirIfEmptyOrIsSymlink binDir