summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/FileMatcher.hs17
-rw-r--r--Command/Vicfg.hs2
-rw-r--r--Logs/PreferredContent.hs25
-rw-r--r--Types/StandardGroups.hs26
4 files changed, 41 insertions, 29 deletions
diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index 524ae3c7e..ae1bbb77b 100644
--- a/Annex/FileMatcher.hs
+++ b/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
diff --git a/Command/Vicfg.hs b/Command/Vicfg.hs
index 94fc36184..c62769c95 100644
--- a/Command/Vicfg.hs
+++ b/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
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 93609da5e..a0bb4ffda 100644
--- a/Logs/PreferredContent.hs
+++ b/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. -}
diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs
index 63182d2a1..37ba6e9c6 100644
--- a/Types/StandardGroups.hs
+++ b/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)"