finish wiring up groupwanted
This commit is contained in:
parent
3a9a1b9f63
commit
6a4dd42328
4 changed files with 41 additions and 29 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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. -}
|
||||
|
|
|
@ -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)"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue