From 99b2a524a063ec9ce374c8e7d864d2c0119c73bc Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 4 Dec 2015 14:20:32 -0400
Subject: [PATCH] clean filter should update location log when adding new
 content to annex

---
 Annex/Content.hs | 12 +++++++++---
 Command/Clean.hs | 10 +++++++---
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/Annex/Content.hs b/Annex/Content.hs
index 74fae381b7..73cb6ab012 100644
--- 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 1793ddedb7..15dcdfacbc 100644
--- 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