standard preferred content settings for client, transfer, backup, and archive repositories

I've designed these to work well together, I hope. If I get it wrong,
I can just change the code in one place, since these expressions
won't be stored in the git-annex branch.
This commit is contained in:
Joey Hess 2012-10-10 13:52:24 -04:00
parent b6ce003843
commit 0c88d9395d
3 changed files with 84 additions and 13 deletions

View file

@ -14,8 +14,10 @@ module Logs.PreferredContent (
) where
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Either
import Data.Time.Clock.POSIX
import Data.Monoid
import Common.Annex
import qualified Annex.Branch
@ -61,7 +63,8 @@ preferredContentMap = do
case cached of
Just m -> return m
Nothing -> do
m <- simpleMap . parseLog (Just . makeMatcher groupmap)
m <- simpleMap
. parseLogWithUUID ((Just .) . makeMatcher groupmap)
<$> Annex.Branch.get preferredContentLog
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
return m
@ -74,17 +77,39 @@ preferredContentMapRaw = simpleMap . parseLog Just
- because the configuration is shared amoung repositories and newer
- versions of git-annex may add new features. Instead, parse errors
- result in a Matcher that will always succeed. -}
makeMatcher :: GroupMap -> String -> Utility.Matcher.Matcher MatchFiles
makeMatcher groupmap s
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
| otherwise = Utility.Matcher.generate []
makeMatcher :: GroupMap -> UUID -> String -> Utility.Matcher.Matcher MatchFiles
makeMatcher groupmap u s
| s == "standard" = standardMatcher groupmap u
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
| otherwise = matchAll
where
tokens = map (parseToken groupmap) (tokenizeMatcher s)
matchAll :: Utility.Matcher.Matcher MatchFiles
matchAll = Utility.Matcher.generate []
{- Standard matchers are pre-defined for some groups. If none is defined,
- or a repository is in multiple groups with standard matchers, match all. -}
standardMatcher :: GroupMap -> UUID -> Utility.Matcher.Matcher MatchFiles
standardMatcher groupmap u =
maybe matchAll findmatcher $ u `M.lookup` groupsByUUID groupmap
where
findmatcher s = case catMaybes $ map standard $ S.toList s of
[m] -> makeMatcher groupmap u m
_ -> matchAll
{- See doc/preferred_content.mdwn for explanations
- of these expressions. -}
standard "client" = Just "exclude=*/archive/*"
standard "transfer" = Just "not inallgroup=client and " <> standard "client"
standard "archive" = Just "not copies=archive:1"
-- backup preferrs all content
standard _ = Nothing
{- Checks if an expression can be parsed, if not returns Just error -}
checkPreferredContentExpression :: String -> Maybe String
checkPreferredContentExpression s =
case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
checkPreferredContentExpression s
| s == "standard" = Nothing
| otherwise = case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
[] -> Nothing
l -> Just $ unwords $ map ("Parse failure: " ++) l