--auto fixes

* get/copy --auto: Transfer data even if it would exceed numcopies,
  when preferred content settings want it.
* drop --auto: Fix dropping content when there are no preferred content
  settings.

Annex/Wanted.hs

@@ -15,19 +15,19 @@ import Types.Remote
 import qualified Data.Set as S
 
 {- Check if a file is preferred content for the local repository. -}
-wantGet :: AssociatedFile -> Annex Bool
+wantGet :: Bool -> AssociatedFile -> Annex Bool
-wantGet Nothing = return True
+wantGet def Nothing = return def
-wantGet (Just file) = isPreferredContent Nothing S.empty file
+wantGet def (Just file) = isPreferredContent Nothing S.empty file def
 
 {- Check if a file is preferred content for a remote. -}
-wantSend :: AssociatedFile -> UUID -> Annex Bool
+wantSend :: Bool -> AssociatedFile -> UUID -> Annex Bool
-wantSend Nothing _ = return True
+wantSend def Nothing _ = return def
-wantSend (Just file) to = isPreferredContent (Just to) S.empty file
+wantSend def (Just file) to = isPreferredContent (Just to) S.empty file def
 
 {- Check if a file can be dropped, maybe from a remote.
  - Don't drop files that are preferred content. -}
-wantDrop :: Maybe UUID -> AssociatedFile -> Annex Bool
+wantDrop :: Bool -> Maybe UUID -> AssociatedFile -> Annex Bool
-wantDrop _ Nothing = return True
+wantDrop def _ Nothing = return $ not def
-wantDrop from (Just file) = do
+wantDrop def from (Just file) = do
 	u <- maybe getUUID (return . id) from
-	not <$> isPreferredContent (Just u) (S.singleton u) file
+	not <$> isPreferredContent (Just u) (S.singleton u) file def

Assistant/Drop.hs

@@ -58,7 +58,7 @@ handleDropsFrom locs rs fromhere key (Just f) knownpresentremote
 		| checkcopies n = dropr r n >>= go rest
 		| otherwise = noop
 
-	checkdrop n@(_, numcopies) u a = ifM (wantDrop u (Just f))
+	checkdrop n@(_, numcopies) u a = ifM (wantDrop True u (Just f))
 		( ifM (safely $ doCommand $ a (Just numcopies))
 			( return $ decrcopies n
 			, return n

Assistant/Threads/TransferScanner.hs

@@ -124,9 +124,9 @@ expensiveScan rs = unless onlyweb $ do
 			let slocs = S.fromList locs
 			let use a = return $ catMaybes $ map (a key slocs) syncrs
 			if present
-				then filterM (wantSend (Just f) . Remote.uuid . fst)
+				then filterM (wantSend True (Just f) . Remote.uuid . fst)
 					=<< use (genTransfer Upload False)
-				else ifM (wantGet $ Just f)
+				else ifM (wantGet True $ Just f)
 					( use (genTransfer Download True) , return [] )
 
 genTransfer :: Direction -> Bool -> Key -> S.Set UUID -> Remote -> Maybe (Remote, Transfer)

Assistant/TransferQueue.hs

@@ -52,7 +52,7 @@ queueTransfers = queueTransfersMatching (const True)
  - condition. Honors preferred content settings. -}
 queueTransfersMatching :: (UUID -> Bool) -> Schedule -> Key -> AssociatedFile -> Direction -> Assistant ()
 queueTransfersMatching matching schedule k f direction
-	| direction == Download = whenM (liftAnnex $ wantGet f) go
+	| direction == Download = whenM (liftAnnex $ wantGet True f) go
 	| otherwise = go
   where
 	go = do
@@ -72,7 +72,7 @@ queueTransfersMatching matching schedule k f direction
 			uuids <- Remote.keyLocations k
 			return $ filter (\r -> uuid r `elem` uuids) rs
 		{- Upload to all remotes that want the content. -}
-		| otherwise = filterM (wantSend f . Remote.uuid) $
+		| otherwise = filterM (wantSend True f . Remote.uuid) $
 			filter (not . Remote.readonly) rs
 	gentransfer r = Transfer
 		{ transferDirection = direction

Command.hs

@@ -20,7 +20,7 @@ module Command (
 	notBareRepo,
 	isBareRepo,
 	numCopies,
-	autoCopies,
+	numCopiesCheck,
 	autoCopiesWith,
 	checkAuto,
 	module ReExported
@@ -109,6 +109,13 @@ isBareRepo = fromRepo Git.repoIsLocalBare
 numCopies :: FilePath  -> Annex (Maybe Int)
 numCopies file = readish <$> checkAttr "annex.numcopies" file
 
+numCopiesCheck :: FilePath -> Key -> (Int -> Int -> Bool) -> Annex Bool
+numCopiesCheck file key vs = do
+	numcopiesattr <- numCopies file
+	needed <- getNumCopies numcopiesattr
+	have <- trustExclude UnTrusted =<< Remote.keyLocations key
+	return $ length have `vs` needed
+
 {- Used for commands that have an auto mode that checks the number of known
  - copies of a key.
  -
@@ -116,16 +123,6 @@ numCopies file = readish <$> checkAttr "annex.numcopies" file
  - copies of the key is > or < than the numcopies setting, before running
  - the action.
  -}
-autoCopies :: FilePath -> Key -> (Int -> Int -> Bool) -> CommandStart -> CommandStart
-autoCopies file key vs a = Annex.getState Annex.auto >>= go
-  where
-	go False = a
-	go True = do
-		numcopiesattr <- numCopies file
-		needed <- getNumCopies numcopiesattr
-		have <- trustExclude UnTrusted =<< Remote.keyLocations key
-		if length have `vs` needed then a else stop
-
 autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
 autoCopiesWith file key vs a = do
 	numcopiesattr <- numCopies file

Command/Copy.hs

@@ -26,10 +26,11 @@ seek = [withField Command.Move.toOption Remote.byName $ \to ->
  - However, --auto mode avoids unnecessary copies, and avoids getting or
  - sending non-preferred content. -}
 start :: Maybe Remote -> Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start to from file (key, backend) = autoCopies file key (<) $
+start to from file (key, backend) = stopUnless shouldCopy $ 
-	stopUnless shouldCopy $ 
+	Command.Move.start to from False file (key, backend)
-		Command.Move.start to from False file (key, backend)
   where
-	shouldCopy = case to of
+	shouldCopy = checkAuto (check <||> numCopiesCheck file key (<))
-		Nothing -> checkAuto $ wantGet (Just file)
+	check = case to of
-		Just r -> checkAuto $ wantSend (Just file) (Remote.uuid r)
+		Nothing -> wantGet False (Just file)
+		Just r -> wantSend False (Just file) (Remote.uuid r)
+		

Command/Drop.hs

@@ -32,7 +32,7 @@ seek = [withField fromOption Remote.byName $ \from ->
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
 start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
-	stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $
+	stopUnless (checkAuto $ wantDrop False (Remote.uuid <$> from) (Just file)) $
 		case from of
 			Nothing -> startLocal file numcopies key Nothing
 			Just remote -> do

Command/Get.hs

@@ -24,8 +24,8 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
 	withFilesInGit $ whenAnnexed $ start from]
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = stopUnless ((not <$> inAnnex key) <&&> checkAuto (wantGet $ Just file)) $
+start from file (key, _) = stopUnless (not <$> inAnnex key) $
-	autoCopies file key (<) $
+	stopUnless (checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))) $ do
 		case from of
 			Nothing -> go $ perform key file
 			Just src ->

Limit.hs

@@ -34,7 +34,7 @@ type AssumeNotPresent = S.Set UUID
 
 {- Checks if there are user-specified limits. -}
 limited :: Annex Bool
-limited = (not . Utility.Matcher.matchesAny) <$> getMatcher'
+limited = (not . Utility.Matcher.isEmpty) <$> getMatcher'
 
 {- Gets a matcher for the user-specified limits. The matcher is cached for
  - speed; once it's obtained the user-specified limits can't change. -}

Logs/PreferredContent.hs

@@ -48,8 +48,8 @@ preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
 
 {- Checks if a file is preferred content for the specified repository
  - (or the current repository if none is specified). -}
-isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Annex Bool
+isPreferredContent :: Maybe UUID -> AssumeNotPresent -> FilePath -> Bool -> Annex Bool
-isPreferredContent mu notpresent file = do
+isPreferredContent mu notpresent file def = do
 	matchfile <- getTopFilePath <$> inRepo (toTopFilePath file)
 	let fi = Annex.FileInfo
 		{ Annex.matchFile = matchfile
@@ -58,9 +58,11 @@ isPreferredContent mu notpresent file = do
 	u <- maybe getUUID return mu
 	m <- preferredContentMap
 	case M.lookup u m of
-		Nothing -> return True
+		Nothing -> return def
-		Just matcher -> Utility.Matcher.matchMrun matcher $ \a ->
+		Just matcher
-			a notpresent fi
+			| Utility.Matcher.isEmpty matcher -> return def
+			| otherwise -> Utility.Matcher.matchMrun matcher $ 
+				\a -> a notpresent fi
 
 {- The map is cached for speed. -}
 preferredContentMap :: Annex Annex.PreferredContentMap

Utility/Matcher.hs

@@ -26,7 +26,7 @@ module Utility.Matcher (
 	match,
 	matchM,
 	matchMrun,
-	matchesAny
+	isEmpty
 ) where
 
 import Common
@@ -105,9 +105,7 @@ matchMrun m run = go m
 		go (MNot m1) = liftM not (go m1)
 		go (MOp o) = run o
 
-{- Checks is a matcher contains no limits, and so (presumably) matches
+{- Checks if a matcher contains no limits. -}
- - anything. Note that this only checks the trivial case; it is possible
+isEmpty :: Matcher a -> Bool
- - to construct matchers that match anything but are more complicated. -}
+isEmpty MAny = True
-matchesAny :: Matcher a -> Bool
+isEmpty _ = False
-matchesAny MAny = True
-matchesAny _ = False

debian/changelog

@@ -22,6 +22,10 @@ git-annex (3.20121128) UNRELEASED; urgency=low
   * webapp: Encryption can be disabled when setting up remotes.
   * assistant: Avoid trying to drop content from remotes that don't have it.
   * assistant: Allow periods in ssh key comments.
+  * get/copy --auto: Transfer data even if it would exceed numcopies,
+    when preferred content settings want it.
+  * drop --auto: Fix dropping content when there are no preferred content
+    settings.
 
  -- Joey Hess <joeyh@debian.org>  Wed, 28 Nov 2012 13:31:07 -0400