summaryrefslogtreecommitdiff
path: root/Logs/PreferredContent.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-10-10 13:52:24 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-10-10 13:54:40 -0400
commita5c3a2fbf523a22fbfcc7b7d419a56b88e6d8d12 (patch)
treef6e8474444dca5938ab991136932ba71d6873561 /Logs/PreferredContent.hs
parentcf30e43a0d5d0c3c76d25daca678ec8cc80dc814 (diff)
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.
Diffstat (limited to 'Logs/PreferredContent.hs')
-rw-r--r--Logs/PreferredContent.hs39
1 files changed, 32 insertions, 7 deletions
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 1f0c6a6fe..37a1d79e0 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -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