didn't quite get removeDirect right before, this passes test suite

This commit is contained in:
Joey Hess 2013-05-20 16:28:33 -04:00
parent 46eb1ea1e7
commit d88be65495
2 changed files with 19 additions and 8 deletions

View file

@ -8,6 +8,7 @@
module Annex.Content.Direct (
associatedFiles,
removeAssociatedFile,
removeAssociatedFileUnchecked,
addAssociatedFile,
goodContent,
recordedInodeCache,
@ -73,15 +74,22 @@ changeAssociatedFiles key transform = do
hPutStr h content
hClose h
{- Removes an associated file. Returns new associatedFiles value. -}
{- Removes an associated file. Returns new associatedFiles value.
- Checks if this was the last copy of the object, and updates location
- log. -}
removeAssociatedFile :: Key -> FilePath -> Annex [FilePath]
removeAssociatedFile key file = do
file' <- normaliseAssociatedFile file
fs <- changeAssociatedFiles key $ filter (/= file')
fs <- removeAssociatedFileUnchecked key file
when (null fs) $
logStatus key InfoMissing
return fs
{- Removes an associated file. Returns new associatedFiles value. -}
removeAssociatedFileUnchecked :: Key -> FilePath -> Annex [FilePath]
removeAssociatedFileUnchecked key file = do
file' <- normaliseAssociatedFile file
changeAssociatedFiles key $ filter (/= file')
{- Adds an associated file. Returns new associatedFiles value. -}
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
addAssociatedFile key file = do

View file

@ -203,13 +203,16 @@ toDirectGen k f = do
liftIO . void . copyFileExternal loc
_ -> return Nothing
{- Removes a direct mode file, while retaining its content in the annex. -}
{- Removes a direct mode file, while retaining its content in the annex
- (unless its content has already been changed). -}
removeDirect :: Key -> FilePath -> Annex ()
removeDirect k f = do
otherlocs <- removeAssociatedFile k f
unless (null otherlocs) $
unlessM (inAnnex k) $
moveAnnex k f
void $ removeAssociatedFileUnchecked k f
unlessM (inAnnex k) $
ifM (goodContent k f)
( moveAnnex k f
, logStatus k InfoMissing
)
liftIO $ do
nukeFile f
void $ tryIO $ removeDirectory $ parentDir f