finish wiring up groupwanted

This commit is contained in:
Joey Hess 2014-03-15 17:08:55 -04:00
parent 3a9a1b9f63
commit 6a4dd42328
4 changed files with 41 additions and 29 deletions

View file

@ -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

View file

@ -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

View file

@ -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. -}

View file

@ -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)"