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

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 74fae381b742e5d413d27f28d8baa1ab147346cf..73cb6ab012dc50745366691fd067bac5d621eb14 100644 (file)
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -25,6 +25,7 @@ module Annex.Content (
        checkDiskSpace,
        moveAnnex,
        linkAnnex,
+       LinkAnnexResult(..),
        sendAnnex,
        prepSendAnnex,
        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
  - guard against modifications.
  -}
-linkAnnex :: Key -> FilePath -> Annex Bool
+linkAnnex :: Key -> FilePath -> Annex LinkAnnexResult
 linkAnnex key src = do
        dest <- calcRepo (gitAnnexLocation key)
        ifM (liftIO $ doesFileExist dest)
-               ( return True
+               ( return LinkAnnexNoop
                , 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.
  -
  - In direct mode, it's possible for the file to change as it's being sent.

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