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 (
|
module Annex.Content.Direct (
|
||||||
associatedFiles,
|
associatedFiles,
|
||||||
removeAssociatedFile,
|
removeAssociatedFile,
|
||||||
|
removeAssociatedFileUnchecked,
|
||||||
addAssociatedFile,
|
addAssociatedFile,
|
||||||
goodContent,
|
goodContent,
|
||||||
recordedInodeCache,
|
recordedInodeCache,
|
||||||
|
@ -73,15 +74,22 @@ changeAssociatedFiles key transform = do
|
||||||
hPutStr h content
|
hPutStr h content
|
||||||
hClose h
|
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 -> FilePath -> Annex [FilePath]
|
||||||
removeAssociatedFile key file = do
|
removeAssociatedFile key file = do
|
||||||
file' <- normaliseAssociatedFile file
|
fs <- removeAssociatedFileUnchecked key file
|
||||||
fs <- changeAssociatedFiles key $ filter (/= file')
|
|
||||||
when (null fs) $
|
when (null fs) $
|
||||||
logStatus key InfoMissing
|
logStatus key InfoMissing
|
||||||
return fs
|
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. -}
|
{- Adds an associated file. Returns new associatedFiles value. -}
|
||||||
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
addAssociatedFile :: Key -> FilePath -> Annex [FilePath]
|
||||||
addAssociatedFile key file = do
|
addAssociatedFile key file = do
|
||||||
|
|
|
@ -203,13 +203,16 @@ toDirectGen k f = do
|
||||||
liftIO . void . copyFileExternal loc
|
liftIO . void . copyFileExternal loc
|
||||||
_ -> return Nothing
|
_ -> 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 :: Key -> FilePath -> Annex ()
|
||||||
removeDirect k f = do
|
removeDirect k f = do
|
||||||
otherlocs <- removeAssociatedFile k f
|
void $ removeAssociatedFileUnchecked k f
|
||||||
unless (null otherlocs) $
|
unlessM (inAnnex k) $
|
||||||
unlessM (inAnnex k) $
|
ifM (goodContent k f)
|
||||||
moveAnnex k f
|
( moveAnnex k f
|
||||||
|
, logStatus k InfoMissing
|
||||||
|
)
|
||||||
liftIO $ do
|
liftIO $ do
|
||||||
nukeFile f
|
nukeFile f
|
||||||
void $ tryIO $ removeDirectory $ parentDir f
|
void $ tryIO $ removeDirectory $ parentDir f
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue