mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

recusive rmdir

Browse source
This commit is contained in:
Joey Hess 2013-11-24 12:56:49 -04:00
parent b59998f73d
commit f04786f984
1 changed files with 7 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

11
Assistant/Upgrade.hs
View file

@ -35,7 +35,6 @@ import qualified Utility.Lsof as Lsof
import qualified Data.Map as M import qualified Data.Map as M
import Data.Tuple.Utils import Data.Tuple.Utils
import Data.Ord
{- Upgrade without interaction in the webapp. -} {- Upgrade without interaction in the webapp. -}
unattendedUpgrade :: Assistant () unattendedUpgrade :: Assistant ()
@ -201,11 +200,15 @@ deleteFromManifest dir = do
fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest) fs <- map (dir </>) . lines <$> catchDefaultIO "" (readFile manifest)
mapM_ nukeFile fs mapM_ nukeFile fs
nukeFile manifest nukeFile manifest
mapM_ nukedir =<< sortBy (comparing length) <$> dirContentsRecursive dir removeEmptyRecursive dir
nukedir dir
where where
manifest = dir </> "git-annex.MANIFEST" manifest = dir </> "git-annex.MANIFEST"
nukedir = void . tryIO . removeDirectory
removeEmptyRecursive :: FilePath -> IO ()
removeEmptyRecursive dir = do
print ("remove", dir)
mapM_ removeEmptyRecursive =<< dirContents dir
void $ tryIO $ removeDirectory dir
{- This is a file that the UpgradeWatcher can watch for modifications to {- This is a file that the UpgradeWatcher can watch for modifications to
- detect when git-annex has been upgraded. - detect when git-annex has been upgraded.