diff options
| -rw-r--r-- | Annex/FileMatcher.hs | 17 | ||||
| -rw-r--r-- | Command/Vicfg.hs | 2 | ||||
| -rw-r--r-- | Logs/PreferredContent.hs | 25 | ||||
| -rw-r--r-- | Types/StandardGroups.hs | 26 |
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)" |