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

tweaks

Browse source
This commit is contained in:
Joey Hess 2011-07-01 01:11:41 -04:00
parent b9721fffac
commit ceb887d826
1 changed files with 10 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

19
Content.hs
View file

@ -235,10 +235,11 @@ moveBad key = do
g <- Annex.gitRepo g <- Annex.gitRepo
let src = gitAnnexLocation g key let src = gitAnnexLocation g key
let dest = gitAnnexBadDir g </> takeFileName src let dest = gitAnnexBadDir g </> takeFileName src
liftIO $ createDirectoryIfMissing True (parentDir dest) liftIO $ do
liftIO $ allowWrite (parentDir src) createDirectoryIfMissing True (parentDir dest)
liftIO $ renameFile src dest allowWrite (parentDir src)
liftIO $ removeDirectory (parentDir src) renameFile src dest
removeDirectory (parentDir src)
logStatus key ValueMissing logStatus key ValueMissing
return dest return dest
@ -252,12 +253,12 @@ getKeysPresent' dir = do
exists <- liftIO $ doesDirectoryExist dir exists <- liftIO $ doesDirectoryExist dir
if (not exists) if (not exists)
then return [] then return []
else do else liftIO $ do
-- 2 levels of hashing -- 2 levels of hashing
levela <- liftIO $ dirContents dir levela <- dirContents dir
levelb <- liftIO $ mapM dirContents levela levelb <- mapM dirContents levela
contents <- liftIO $ mapM dirContents (concat levelb) contents <- mapM dirContents (concat levelb)
files <- liftIO $ filterM present (concat contents) files <- filterM present (concat contents)
return $ catMaybes $ map (fileKey . takeFileName) files return $ catMaybes $ map (fileKey . takeFileName) files
where where
present d = do present d = do