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

simpler approach

Browse source
This commit is contained in:
Joey Hess 2011-02-09 01:01:06 -04:00
parent 2bd16f84ae
commit 62ebeb00d9
1 changed files with 5 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
test.hs
View file

@ -11,7 +11,7 @@ import System.Directory
import System.Posix.Directory (changeWorkingDirectory) import System.Posix.Directory (changeWorkingDirectory)
import System.Posix.Files import System.Posix.Files
import IO (bracket_, bracket) import IO (bracket_, bracket)
import Control.Monad (unless, when) import Control.Monad (unless, when, filterM)
import Data.List import Data.List
import System.IO.Error import System.IO.Error
import System.Posix.Env import System.Posix.Env
@ -537,13 +537,11 @@ cleanup dir = do
e <- doesDirectoryExist dir e <- doesDirectoryExist dir
when e $ do when e $ do
-- git-annex prevents annexed file content from being -- git-annex prevents annexed file content from being
-- removed via permissions bits; undo -- removed via directory permissions; undo
recurseDir SystemFS dir >>= mapM_ fixmodes recurseDir SystemFS dir >>=
filterM doesDirectoryExist >>=
mapM_ Content.allowWrite
removeDirectoryRecursive dir removeDirectoryRecursive dir
where
fixmodes f = do
s <- getSymbolicLinkStatus f
unless (isSymbolicLink s) $ Content.allowWrite f
checklink :: FilePath -> Assertion checklink :: FilePath -> Assertion
checklink f = do checklink f = do