add --ingroup limit

GitAnnex.hs

@@ -147,9 +147,11 @@ options = Option.common ++
 		"skip files with fewer copies"
 	, Option ['B'] ["inbackend"] (ReqArg Limit.addInBackend paramName)
 		"skip files not using a key-value backend"
-	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramName)
+	, Option [] ["ingroup"] (ReqArg Limit.addInGroup paramGroup)
+		"skip files not present in all remotes in a group"
+	, Option [] ["largerthan"] (ReqArg Limit.addLargerThan paramSize)
 		"skip files larger than a size"
-	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramName)
+	, Option [] ["smallerthan"] (ReqArg Limit.addSmallerThan paramSize)
 		"skip files smaller than a size"
 	, Option ['T'] ["time-limit"] (ReqArg Limit.addTimeLimit paramTime)
 		"stop after the specified amount of time"

Limit.hs

@@ -11,6 +11,7 @@ import Text.Regex.PCRE.Light.Char8
 import System.Path.WildMatch
 import Data.Time.Clock.POSIX
 import qualified Data.Set as S
+import qualified Data.Map as M
 
 import Common.Annex
 import qualified Annex
@@ -22,6 +23,7 @@ import Annex.UUID
 import Logs.Trust
 import Types.TrustLevel
 import Types.Key
+import Types.Group
 import Logs.Group
 import Utility.HumanTime
 import Utility.DataUnits
@@ -135,6 +137,28 @@ limitCopies want = case split ":" want of
 		checktrust t u = (== t) <$> lookupTrust u
 		checkgroup g u = S.member g <$> lookupGroups u
 
+{- Adds a limit to skip files not believed to be present in all
+ - repositories in the specified group. -}
+addInGroup :: String -> Annex ()
+addInGroup groupname = do
+	m <- groupMap
+	addLimit $ limitInGroup m groupname
+
+limitInGroup :: GroupMap -> MkLimit
+limitInGroup m groupname
+	| S.null want = Right $ const $ const $ return True
+	| otherwise = Right $ \notpresent ->
+		Backend.lookupFile >=> check notpresent
+	where
+		want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
+		check _ Nothing = return False
+		check notpresent (Just (key, _))
+			-- optimisation: Check if a wanted uuid is notpresent.
+			| not (S.null (S.intersection want notpresent))	= return False
+			| otherwise = do
+				present <- S.fromList <$> Remote.keyLocations key
+				return $ S.null $ want `S.difference` present
+
 {- Adds a limit to skip files not using a specified key-value backend. -}
 addInBackend :: String -> Annex ()
 addInBackend = addLimit . limitInBackend

Logs/PreferredContent.hs

@@ -25,6 +25,8 @@ import Limit
 import qualified Utility.Matcher
 import Annex.UUID
 import Git.FilePath
+import Types.Group
+import Logs.Group
 
 {- Filename of preferred-content.log. -}
 preferredContentLog :: FilePath
@@ -54,11 +56,12 @@ isPreferredContent mu notpresent file = do
 {- Read the preferredContentLog into a map. The map is cached for speed. -}
 preferredContentMap :: Annex Annex.PreferredContentMap
 preferredContentMap = do
+	groupmap <- groupMap
 	cached <- Annex.getState Annex.preferredcontentmap
 	case cached of
 		Just m -> return m
 		Nothing -> do
-			m <- simpleMap . parseLog (Just . makeMatcher)
+			m <- simpleMap . parseLog (Just . makeMatcher groupmap)
 				<$> Annex.Branch.get preferredContentLog
 			Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 			return m
@@ -71,21 +74,22 @@ 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 MatchFiles
-makeMatcher s
+makeMatcher :: GroupMap -> String -> Utility.Matcher.Matcher MatchFiles
+makeMatcher groupmap s
 	| null (lefts tokens) =  Utility.Matcher.generate $ rights tokens
  	| otherwise = Utility.Matcher.generate []
 	where
-		tokens = map parseToken $ tokenizeMatcher s
+		tokens = map (parseToken groupmap) (tokenizeMatcher s)
 
 {- Checks if an expression can be parsed, if not returns Just error -}
 checkPreferredContentExpression :: String -> Maybe String
-checkPreferredContentExpression s = case lefts $ map parseToken $ tokenizeMatcher s of
-	[] -> Nothing
-	l -> Just $ unwords $ map ("Parse failure: " ++) l
+checkPreferredContentExpression s = 
+	case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
+		[] -> Nothing
+		l -> Just $ unwords $ map ("Parse failure: " ++) l
 
-parseToken :: String -> Either String (Utility.Matcher.Token MatchFiles)
-parseToken t
+parseToken :: GroupMap -> String -> Either String (Utility.Matcher.Token MatchFiles)
+parseToken groupmap t
 	| any (== t) Utility.Matcher.tokens = Right $ Utility.Matcher.token t
 	| otherwise = maybe (Left $ "near " ++ show t) use $ M.lookup k m
 	where
@@ -95,9 +99,10 @@ parseToken t
 			, ("exclude", limitExclude)
 			, ("in", limitIn)
 			, ("copies", limitCopies)
-			, ("backend", limitInBackend)
+			, ("inbackend", limitInBackend)
 			, ("largerthan", limitSize (>))
 			, ("smallerthan", limitSize (<))
+			, ("ingroup", limitInGroup groupmap)
 			]
 		use a = Utility.Matcher.Operation <$> a v
 

Types/Group.hs

@@ -7,7 +7,8 @@
 
 module Types.Group (
 	Group,
-	GroupMap(..)
+	GroupMap(..),
+	emptyGroupMap
 ) where
 
 import Types.UUID
@@ -21,3 +22,6 @@ data GroupMap = GroupMap
 	{ groupsByUUID :: M.Map UUID (S.Set Group)
 	, uuidsByGroup :: M.Map Group (S.Set UUID)
 	}
+
+emptyGroupMap :: GroupMap
+emptyGroupMap = GroupMap M.empty M.empty

Usage.hs

@@ -85,6 +85,8 @@ paramFile :: String
 paramFile = "FILE"
 paramGroup :: String
 paramGroup = "GROUP"
+paramSize :: String
+paramSize = "SIZE"
 paramKeyValue :: String
 paramKeyValue = "K=V"
 paramNothing :: String

debian/changelog

@@ -1,11 +1,10 @@
 git-annex (3.20121002) UNRELEASED; urgency=low
 
   * group, ungroup: New commands to indicate groups of repositories.
-  * --copies=group:number can now be used to match files that are present
-    in a specified number of repositories in a group.
   * watch, assistant: It's now safe to git annex unlock files while
     the watcher is running, as well as modify files checked into git
-    as normal files.
+    as normal files. Additionally, .gitignore settings are now honored.
+    Closes: #689979
   * vicfg: New command, allows editing (or simply viewing) most
     of the repository configuration settings stored in the git-annex branch.
   * Added preferred content expressions, configurable using vicfg.
@@ -13,7 +12,9 @@ git-annex (3.20121002) UNRELEASED; urgency=low
     configured, only get that content.
   * drop --auto: If the local repository has preferred content configured,
     drop content that is not preferred, when numcopies allows.
-  * Added --smallerthan and --largerthan limits.
+  * --copies=group:number can now be used to match files that are present
+    in a specified number of repositories in a group.
+  * Added --smallerthan, --largerthan, and --inall limits.
   * Only build-depend on libghc-clientsession-dev on arches that will have
     the webapp.
   * uninit: Unset annex.version. Closes: #689852

doc/design/assistant/transfer_control.mdwn

@@ -27,7 +27,7 @@ check if preferred content settings rejects the data, and if so, drop it
 from the repo. So once all three laptops have the data, it is
 pruned from the transfer drive.
 
-## repo groups
+## repo groups **done**
 
 Seems like git-annex needs a way to know the groups of repos. Some
 groups:
@@ -53,14 +53,14 @@ Some examples of using groups:
 
 * Make a cloud repo only hold data until all known clients have a copy:
 
-  `not inall(enduser)`
+  `not ingroup(enduser)`
 
 ## configuration
 
 The above is all well and good for those who enjoy boolean algebra, but
 how to configure these sorts of expressions in the webapp?
 
-## the state change problem
+## the state change problem **done**
 
 Imagine that a trusted repo has setting like `not copies=trusted:2`
 This means that `git annex get --auto` should get files not in 2 trusted
@@ -77,3 +77,5 @@ Or, perhaps simulation could be used to detect the problem. Before
 dropping, check the expression. Then simulate that the drop has happened.
 Does the expression now make it want to add it? Then don't drop it!
 How to implement this simulation?
+
+> Solved, fwiw..

doc/git-annex.mdwn

@@ -643,6 +643,11 @@ file contents are present at either of two repositories.
   Matches only files whose content is stored using the specified key-value
   backend.
 
+* --ingroup=groupname
+
+  Matches only files that git-annex believes are present in all repositories
+  in the specified group.
+
 * --smallerthan=size
 * --largerthan=size