add AssumeNotPresent parameter to limits

Solves the issue with preferred content expressions and dropping that
I mentioned yesterday. My solution was to add a parameter to specify a set
of repositories where content should be assumed not to be present. When
deciding whether to drop, it can put the current repository in, and then
if the expression fails to match, the content can be dropped.

Using yesterday's example "(not copies=trusted:2) and (not in=usbdrive)",
when the local repo is one of the 2 trusted copies, the drop check will
see only 1 trusted copy, so the expression matches, and so the content will
not be dropped.

3 files changed, 35 insertions, 21 deletions

diff --git a/Annex.hs b/Annex.hs
index 572823497..a4a56f5ff 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -52,6 +52,7 @@ import Types.UUID
 import Utility.State
 import qualified Utility.Matcher
 import qualified Data.Map as M
+import qualified Data.Set as S
 
 -- git-annex's monad
 newtype Annex a = Annex { runAnnex :: StateT AnnexState IO a }
@@ -76,7 +77,7 @@ instance MonadBaseControl IO Annex where
 
 type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
 
-type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (FilePath -> Annex Bool))
+type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> FilePath -> Annex Bool))
 
 -- internal state storage
 data AnnexState = AnnexState
diff --git a/Limit.hs b/Limit.hs
index 89156a783..de241ba60 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -18,13 +18,15 @@ import qualified Utility.Matcher
 import qualified Remote
 import qualified Backend
 import Annex.Content
+import Annex.UUID
 import Logs.Trust
 import Types.TrustLevel
 import Logs.Group
 import Utility.HumanTime
 
-type Limit = Utility.Matcher.Token (FilePath -> Annex Bool)
-type MkLimit = String -> Either String (FilePath -> Annex Bool)
+type MatchFiles = AssumeNotPresent -> FilePath -> Annex Bool
+type MkLimit = String -> Either String MatchFiles
+type AssumeNotPresent = S.Set UUID
 
 {- Checks if there are user-specified limits. -}
 limited :: Annex Bool
@@ -46,7 +48,7 @@ getMatcher' = do
 			return matcher
 
 {- Adds something to the limit list, which is built up reversed. -}
-add :: Limit -> Annex ()
+add :: Utility.Matcher.Token (FilePath -> Annex Bool) -> Annex ()
 add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
 	where
 		prepend (Left ls) = Left $ l:ls
@@ -57,22 +59,22 @@ addToken :: String -> Annex ()
 addToken = add . Utility.Matcher.token
 
 {- Adds a new limit. -}
-addLimit :: Either String (FilePath -> Annex Bool) -> Annex ()
-addLimit = either error (add . Utility.Matcher.Operation)
+addLimit :: Either String MatchFiles -> Annex ()
+addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty)
 
 {- Add a limit to skip files that do not match the glob. -}
 addInclude :: String -> Annex ()
 addInclude = addLimit . limitInclude
 
 limitInclude :: MkLimit
-limitInclude glob = Right $ return . matchglob glob
+limitInclude glob = Right $ const $ return . matchglob glob
 
 {- Add a limit to skip files that match the glob. -}
 addExclude :: String -> Annex ()
 addExclude = addLimit . limitExclude
 
 limitExclude :: MkLimit
-limitExclude glob = Right $ return . not . matchglob glob
+limitExclude glob = Right $ const $ return . not . matchglob glob
 
 matchglob :: String -> FilePath -> Bool
 matchglob glob f = isJust $ match cregex f []
@@ -86,15 +88,25 @@ addIn :: String -> Annex ()
 addIn = addLimit . limitIn
 
 limitIn :: MkLimit
-limitIn name = Right $ check $ if name == "." then inAnnex else inremote
+limitIn name = Right $ \notpresent -> check $
+	if name == "."
+		then inhere notpresent
+		else inremote notpresent
 	where
 		check a = Backend.lookupFile >=> handle a
 		handle _ Nothing = return False
 		handle a (Just (key, _)) = a key
-		inremote key = do
+		inremote notpresent key = do
 			u <- Remote.nameToUUID name
 			us <- Remote.keyLocations key
-			return $ u `elem` us
+			return $ u `elem` us && u `S.notMember` notpresent
+		inhere notpresent key
+			| S.null notpresent = inAnnex key
+			| otherwise = do
+				u <- getUUID
+				if u `S.member` notpresent
+					then return False
+					else inAnnex key
 
 {- Adds a limit to skip files not believed to have the specified number
  - of copies. -}
@@ -111,11 +123,12 @@ limitCopies want = case split ":" want of
 	where
 		go num good = case readish num of
 			Nothing -> Left "bad number for copies"
-			Just n -> Right $ check n good
-		check n good = Backend.lookupFile >=> handle n good
-		handle _ _ Nothing = return False
-		handle n good (Just (key, _)) = do
-			us <- filterM good =<< Remote.keyLocations key
+			Just n -> Right $ \notpresent ->
+				Backend.lookupFile >=> handle n good notpresent
+		handle _ _ _ Nothing = return False
+		handle n good notpresent (Just (key, _)) = do
+			us <- filter (`S.notMember` notpresent)
+				<$> (filterM good =<< Remote.keyLocations key)
 			return $ length us >= n
 		checktrust t u = (== t) <$> lookupTrust u
 		checkgroup g u = S.member g <$> lookupGroups u
@@ -125,7 +138,7 @@ addInBackend :: String -> Annex ()
 addInBackend = addLimit . limitInBackend
 
 limitInBackend :: MkLimit
-limitInBackend name = Right $ Backend.lookupFile >=> check
+limitInBackend name = Right $ const $ Backend.lookupFile >=> check
 	where
 		wanted = Backend.lookupBackendName name
 		check = return . maybe False ((==) wanted . snd)
@@ -135,7 +148,7 @@ addTimeLimit s = do
 	let seconds = fromMaybe (error "bad time-limit") $ parseDuration s
 	start <- liftIO getPOSIXTime
 	let cutoff = start + seconds
-	addLimit $ Right $ const $ do
+	addLimit $ Right $ const $ const $ do
 		now <- liftIO getPOSIXTime
 		if now > cutoff
 			then do
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index f482ac57b..77e4f2705 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -20,7 +20,7 @@ import Common.Annex
 import qualified Annex.Branch
 import qualified Annex
 import Logs.UUIDBased
-import Limit (limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
+import Limit (MatchFiles, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
 import qualified Utility.Matcher
 
 {- Filename of preferred-content.log. -}
@@ -56,7 +56,7 @@ preferredContentMapRaw = simpleMap . parseLog Just
  - because the configuration is shared amoung repositories and newer
  - versions of git-annex may add new features. Instead, parse errors
  - result in a Matcher that will always succeed. -}
-makeMatcher :: String -> Utility.Matcher.Matcher (FilePath -> Annex Bool)
+makeMatcher :: String -> Utility.Matcher.Matcher MatchFiles
 makeMatcher s
 	| null (lefts tokens) =  Utility.Matcher.generate $ rights tokens
  	| otherwise = Utility.Matcher.generate []
@@ -69,7 +69,7 @@ checkPreferredContentExpression s = case lefts $ map parseToken $ tokenizeMatche
 	[] -> Nothing
 	l -> Just $ unwords $ map ("Parse failure: " ++) l
 
-parseToken :: String -> Either String (Utility.Matcher.Token (FilePath -> Annex Bool))
+parseToken :: String -> Either String (Utility.Matcher.Token MatchFiles)
 parseToken t
 	| any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
 	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m