finish wiring up groupwanted

Annex/FileMatcher.hs

@@ -56,23 +56,24 @@ parsedToMatcher parsed = case partitionEithers parsed of
 	([], vs) -> Right $ generate vs
 	(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
 
-exprParser :: FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
-exprParser matchstandard groupmap configmap mu expr =
+exprParser :: FileMatcher -> FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
+exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
 	map parse $ tokenizeMatcher expr
   where
 	parse = parseToken
 		matchstandard
+		matchgroupwanted
 		(limitPresent mu)
 		(limitInDir preferreddir)
 		groupmap
 	preferreddir = fromMaybe "public" $
 		M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
 
-parseToken :: FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
-parseToken matchstandard checkpresent checkpreferreddir groupmap t
+parseToken :: FileMatcher -> FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
+parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t
 	| t `elem` tokens = Right $ token t
-	| t == "standard" = Right $ Operation $ \notpresent mi ->
-		matchMrun matchstandard $ \a -> a notpresent mi
+	| t == "standard" = call matchstandard
+	| t == "groupwanted" = call matchgroupwanted
 	| t == "present" = use checkpresent
 	| t == "inpreferreddir" = use checkpreferreddir
 	| t == "unused" = Right $ Operation limitUnused
@@ -92,6 +93,8 @@ parseToken matchstandard checkpresent checkpreferreddir groupmap t
   where
 	(k, v) = separate (== '=') t
 	use a = Operation <$> a v
+	call sub = Right $ Operation $ \notpresent mi ->
+		matchMrun sub $ \a -> a notpresent mi
 
 {- This is really dumb tokenization; there's no support for quoted values.
  - Open and close parens are always treated as standalone tokens;
@@ -112,5 +115,5 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
 		rc <- readRemoteLog
 		u <- getUUID
 		either badexpr return $
-			parsedToMatcher $ exprParser matchAll gm rc (Just u) expr
+			parsedToMatcher $ exprParser matchAll matchAll gm rc (Just u) expr
 	badexpr e = error $ "bad annex.largefiles configuration: " ++ e

Command/Vicfg.hs

@@ -158,7 +158,7 @@ genCfg cfg descs = unlines $ intercalate [""]
 	  where
 		gline g = com $ unwords
 			[ "standard"
-			, fromStandardGroup g, "=", preferredContent g
+			, fromStandardGroup g, "=", standardPreferredContent g
 			]
 	
 	schedule = settings cfg descs cfgScheduleMap

Logs/PreferredContent.hs

@@ -58,8 +58,9 @@ preferredContentMapLoad :: Annex Annex.PreferredContentMap
 preferredContentMapLoad = do
 	groupmap <- groupMap
 	configmap <- readRemoteLog
+	groupwantedmap <- groupPreferredContentMapRaw
 	m <- simpleMap
-		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap)
+		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap groupwantedmap)
 		<$> Annex.Branch.get preferredContentLog
 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 	return m
@@ -68,18 +69,26 @@ preferredContentMapLoad = do
  - because the configuration is shared among repositories and newer
  - versions of git-annex may add new features. Instead, parse errors
  - result in a Matcher that will always succeed. -}
-makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> PreferredContentExpression -> FileMatcher
-makeMatcher groupmap configmap u = go True
+makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> M.Map Group PreferredContentExpression -> UUID -> PreferredContentExpression -> FileMatcher
+makeMatcher groupmap configmap groupwantedmap u = go True True
   where
-	go expandstandard expr
+	go expandstandard expandgroupwanted expr
 		| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
 		| otherwise = matchAll
 	  where
-		tokens = exprParser matchstandard groupmap configmap (Just u) expr
+		tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
 		matchstandard
-			| expandstandard = maybe matchAll (go False . preferredContent) $
-				getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
+			| expandstandard = maybe matchAll (go False False)
+				(standardPreferredContent <$> getStandardGroup mygroups)
 			| otherwise = matchAll
+		matchgroupwanted
+			| expandgroupwanted = maybe matchAll (go True False)
+				(groupwanted mygroups)
+			| otherwise = matchAll
+		mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)
+		groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of
+			[pc] -> Just pc
+			_ -> Nothing
 
 {- Checks if an expression can be parsed, if not returns Just error -}
 checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
@@ -87,7 +96,7 @@ checkPreferredContentExpression expr = case parsedToMatcher tokens of
 	Left e -> Just e
 	Right _ -> Nothing
   where
-	tokens = exprParser matchAll emptyGroupMap M.empty Nothing expr
+	tokens = exprParser matchAll matchAll emptyGroupMap M.empty Nothing expr
 
 {- Puts a UUID in a standard group, and sets its preferred content to use
  - the standard expression for that group, unless something is already set. -}

Types/StandardGroups.hs

@@ -78,21 +78,21 @@ specialRemoteOnly PublicGroup = True
 specialRemoteOnly _ = False
 
 {- See doc/preferred_content.mdwn for explanations of these expressions. -}
-preferredContent :: StandardGroup -> PreferredContentExpression
-preferredContent ClientGroup = lastResort $
+standardPreferredContent :: StandardGroup -> PreferredContentExpression
+standardPreferredContent ClientGroup = lastResort $
 	"((exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")) and not unused"
-preferredContent TransferGroup = lastResort $
-	"not (inallgroup=client and copies=client:2) and (" ++ preferredContent ClientGroup ++ ")"
-preferredContent BackupGroup = "include=* or unused"
-preferredContent IncrementalBackupGroup = lastResort
+standardPreferredContent TransferGroup = lastResort $
+	"not (inallgroup=client and copies=client:2) and (" ++ standardPreferredContent ClientGroup ++ ")"
+standardPreferredContent BackupGroup = "include=* or unused"
+standardPreferredContent IncrementalBackupGroup = lastResort
 	"(include=* or unused) and (not copies=incrementalbackup:1)"
-preferredContent SmallArchiveGroup = lastResort $
-	"(include=*/archive/* or include=archive/*) and (" ++ preferredContent FullArchiveGroup ++ ")"
-preferredContent FullArchiveGroup = lastResort notArchived
-preferredContent SourceGroup = "not (copies=1)"
-preferredContent ManualGroup = "present and (" ++ preferredContent ClientGroup ++ ")"
-preferredContent PublicGroup = "inpreferreddir"
-preferredContent UnwantedGroup = "exclude=*"
+standardPreferredContent SmallArchiveGroup = lastResort $
+	"(include=*/archive/* or include=archive/*) and (" ++ standardPreferredContent FullArchiveGroup ++ ")"
+standardPreferredContent FullArchiveGroup = lastResort notArchived
+standardPreferredContent SourceGroup = "not (copies=1)"
+standardPreferredContent ManualGroup = "present and (" ++ standardPreferredContent ClientGroup ++ ")"
+standardPreferredContent PublicGroup = "inpreferreddir"
+standardPreferredContent UnwantedGroup = "exclude=*"
 
 notArchived :: String
 notArchived = "not (copies=archive:1 or copies=smallarchive:1)"