clean filter should update location log when adding new content to annex

This commit is contained in:
Joey Hess 2015-12-04 14:20:32 -04:00
parent ad06f8ceed
commit 99b2a524a0
Failed to extract signature
2 changed files with 16 additions and 6 deletions

View file

@ -25,6 +25,7 @@ module Annex.Content (
checkDiskSpace, checkDiskSpace,
moveAnnex, moveAnnex,
linkAnnex, linkAnnex,
LinkAnnexResult(..),
sendAnnex, sendAnnex,
prepSendAnnex, prepSendAnnex,
removeAnnex, removeAnnex,
@ -479,15 +480,20 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
- prevent losing the content if the source file is deleted, but does not - prevent losing the content if the source file is deleted, but does not
- guard against modifications. - guard against modifications.
-} -}
linkAnnex :: Key -> FilePath -> Annex Bool linkAnnex :: Key -> FilePath -> Annex LinkAnnexResult
linkAnnex key src = do linkAnnex key src = do
dest <- calcRepo (gitAnnexLocation key) dest <- calcRepo (gitAnnexLocation key)
ifM (liftIO $ doesFileExist dest) ifM (liftIO $ doesFileExist dest)
( return True ( return LinkAnnexNoop
, modifyContent dest $ , modifyContent dest $
liftIO $ createLinkOrCopy src dest ifM (liftIO $ createLinkOrCopy src dest)
( return LinkAnnexOk
, return LinkAnnexFailed
)
) )
data LinkAnnexResult = LinkAnnexOk | LinkAnnexFailed | LinkAnnexNoop
{- Runs an action to transfer an object's content. {- Runs an action to transfer an object's content.
- -
- In direct mode, it's possible for the file to change as it's being sent. - In direct mode, it's possible for the file to change as it's being sent.

View file

@ -15,11 +15,12 @@ import Annex.FileMatcher
import Types.KeySource import Types.KeySource
import Types.Key import Types.Key
import Backend import Backend
import Logs.Location
import qualified Data.ByteString.Lazy as B import qualified Data.ByteString.Lazy as B
cmd :: Command cmd :: Command
cmd = dontCheck repoExists $ cmd = noMessages $ dontCheck repoExists $
command "clean" SectionPlumbing command "clean" SectionPlumbing
"git clean filter" "git clean filter"
paramFile (withParams seek) paramFile (withParams seek)
@ -57,8 +58,11 @@ ingest file = do
-- Hard link (or copy) file content to annex -- Hard link (or copy) file content to annex
-- to prevent it from being lost when git checks out -- to prevent it from being lost when git checks out
-- a branch not containing this file. -- a branch not containing this file.
unlessM (linkAnnex k file) $ r <- linkAnnex k file
error "Problem adding file to the annex" case r of
LinkAnnexFailed -> error "Problem adding file to the annex"
LinkAnnexOk -> logStatus k InfoPresent
LinkAnnexNoop -> noop
genMetaData k file genMetaData k file
=<< liftIO (getFileStatus file) =<< liftIO (getFileStatus file)
return k return k