aboutsummaryrefslogtreecommitdiff
path: root/Logs/PreferredContent.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-04-25 23:44:55 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-04-25 23:44:55 -0400
commit9831bc36f7981da230c9dbf3704377b3bf74f50f (patch)
tree021e13e365a1ad56e4b621a571f52e111b8b45b3 /Logs/PreferredContent.hs
parent62a272b330550a5db4836fd8104ca4b6a2032e39 (diff)
per-IA-item content directories
Diffstat (limited to 'Logs/PreferredContent.hs')
-rw-r--r--Logs/PreferredContent.hs29
1 files changed, 16 insertions, 13 deletions
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index d980cd373..8005fc0d3 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -30,7 +30,9 @@ import qualified Utility.Matcher
import Annex.FileMatcher
import Annex.UUID
import Types.Group
+import Types.Remote (RemoteConfig)
import Logs.Group
+import Logs.Remote
import Types.StandardGroups
{- Filename of preferred-content.log. -}
@@ -65,8 +67,9 @@ preferredContentMap = maybe preferredContentMapLoad return
preferredContentMapLoad :: Annex Annex.PreferredContentMap
preferredContentMapLoad = do
groupmap <- groupMap
+ configmap <- readRemoteLog
m <- simpleMap
- . parseLogWithUUID ((Just .) . makeMatcher groupmap)
+ . parseLogWithUUID ((Just .) . makeMatcher groupmap configmap)
<$> Annex.Branch.get preferredContentLog
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
return m
@@ -79,30 +82,30 @@ 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 -> UUID -> String -> FileMatcher
-makeMatcher groupmap u s
- | s == "standard" = standardMatcher groupmap u
+makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> String -> FileMatcher
+makeMatcher groupmap configmap u expr
+ | expr == "standard" = standardMatcher groupmap configmap u
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
| otherwise = matchAll
where
- tokens = map (parseToken (limitPresent $ Just u) groupmap) (tokenizeMatcher s)
+ tokens = exprParser groupmap configmap (Just u) expr
{- 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 -> FileMatcher
-standardMatcher m u = maybe matchAll (makeMatcher m u . preferredContent) $
- getStandardGroup =<< u `M.lookup` groupsByUUID m
+standardMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> FileMatcher
+standardMatcher groupmap configmap u =
+ maybe matchAll (makeMatcher groupmap configmap u . preferredContent) $
+ getStandardGroup =<< u `M.lookup` groupsByUUID groupmap
{- Checks if an expression can be parsed, if not returns Just error -}
checkPreferredContentExpression :: String -> Maybe String
-checkPreferredContentExpression s
- | s == "standard" = Nothing
- | otherwise = case parsedToMatcher vs of
+checkPreferredContentExpression expr
+ | expr == "standard" = Nothing
+ | otherwise = case parsedToMatcher tokens of
Left e -> Just e
Right _ -> Nothing
where
- vs = map (parseToken (limitPresent Nothing) emptyGroupMap)
- (tokenizeMatcher s)
+ tokens = exprParser 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. -}