didn't quite get removeDirect right before, this passes test suite
This commit is contained in:
parent
46eb1ea1e7
commit
d88be65495
2 changed files with 19 additions and 8 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue