avoid unnecessary reading of git-annex branch data when matching on annex.largefiles

This makes git annex clean not look at the git-annex branch at all,
and so speeds it up by 50% or more.
This commit is contained in:
Joey Hess 2015-12-04 14:57:28 -04:00
parent 99b2a524a0
commit 983c1894eb
Failed to extract signature
3 changed files with 28 additions and 26 deletions

View file

@ -14,7 +14,6 @@ import Limit
import Utility.Matcher import Utility.Matcher
import Types.Group import Types.Group
import Logs.Group import Logs.Group
import Logs.Remote
import Annex.UUID import Annex.UUID
import qualified Annex import qualified Annex
import Types.FileMatcher import Types.FileMatcher
@ -53,8 +52,8 @@ parsedToMatcher parsed = case partitionEithers parsed of
([], vs) -> Right $ generate vs ([], vs) -> Right $ generate vs
(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es (es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
exprParser :: FileMatcher Annex -> FileMatcher Annex -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))] exprParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))]
exprParser matchstandard matchgroupwanted groupmap configmap mu expr = exprParser matchstandard matchgroupwanted getgroupmap configmap mu expr =
map parse $ tokenizeMatcher expr map parse $ tokenizeMatcher expr
where where
parse = parseToken parse = parseToken
@ -62,12 +61,12 @@ exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
matchgroupwanted matchgroupwanted
(limitPresent mu) (limitPresent mu)
(limitInDir preferreddir) (limitInDir preferreddir)
groupmap getgroupmap
preferreddir = fromMaybe "public" $ preferreddir = fromMaybe "public" $
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> GroupMap -> String -> Either String (Token (MatchFiles Annex)) parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex))
parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t
| t `elem` tokens = Right $ token t | t `elem` tokens = Right $ token t
| t == "standard" = call matchstandard | t == "standard" = call matchstandard
| t == "groupwanted" = call matchgroupwanted | t == "groupwanted" = call matchgroupwanted
@ -86,7 +85,7 @@ parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupma
, ("largerthan", limitSize (>)) , ("largerthan", limitSize (>))
, ("smallerthan", limitSize (<)) , ("smallerthan", limitSize (<))
, ("metadata", limitMetaData) , ("metadata", limitMetaData)
, ("inallgroup", limitInAllGroup groupmap) , ("inallgroup", limitInAllGroup getgroupmap)
] ]
where where
(k, v) = separate (== '=') t (k, v) = separate (== '=') t
@ -109,9 +108,12 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
where where
go Nothing = return matchAll go Nothing = return matchAll
go (Just expr) = do go (Just expr) = do
gm <- groupMap
rc <- readRemoteLog
u <- getUUID u <- getUUID
-- No need to read remote configs, that's only needed for
-- inpreferreddir, which is used in preferred content
-- expressions but does not make sense in the
-- annex.largefiles expression.
let emptyconfig = M.empty
either badexpr return $ either badexpr return $
parsedToMatcher $ exprParser matchAll matchAll gm rc (Just u) expr parsedToMatcher $ exprParser matchAll matchAll groupMap emptyconfig (Just u) expr
badexpr e = error $ "bad annex.largefiles configuration: " ++ e badexpr e = error $ "bad annex.largefiles configuration: " ++ e

View file

@ -201,22 +201,22 @@ limitAnything _ _ = return True
{- Adds a limit to skip files not believed to be present in all {- Adds a limit to skip files not believed to be present in all
- repositories in the specified group. -} - repositories in the specified group. -}
addInAllGroup :: String -> Annex () addInAllGroup :: String -> Annex ()
addInAllGroup groupname = do addInAllGroup groupname = addLimit $ limitInAllGroup groupMap groupname
m <- groupMap
addLimit $ limitInAllGroup m groupname
limitInAllGroup :: GroupMap -> MkLimit Annex limitInAllGroup :: Annex GroupMap -> MkLimit Annex
limitInAllGroup m groupname limitInAllGroup getgroupmap groupname = Right $ \notpresent mi -> do
| S.null want = Right $ const $ const $ return True m <- getgroupmap
| otherwise = Right $ \notpresent -> checkKey $ check notpresent let want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
where if S.null want
want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m then return True
check notpresent key
-- optimisation: Check if a wanted uuid is notpresent. -- optimisation: Check if a wanted uuid is notpresent.
| not (S.null (S.intersection want notpresent)) = return False else if not (S.null (S.intersection want notpresent))
| otherwise = do then return False
present <- S.fromList <$> Remote.keyLocations key else checkKey (check want) mi
return $ S.null $ want `S.difference` present where
check want key = do
present <- S.fromList <$> Remote.keyLocations key
return $ S.null $ want `S.difference` present
{- Adds a limit to skip files not using a specified key-value backend. -} {- Adds a limit to skip files not using a specified key-value backend. -}
addInBackend :: String -> Annex () addInBackend :: String -> Annex ()

View file

@ -102,7 +102,7 @@ makeMatcher groupmap configmap groupwantedmap u = go True True
| null (lefts tokens) = generate $ rights tokens | null (lefts tokens) = generate $ rights tokens
| otherwise = unknownMatcher u | otherwise = unknownMatcher u
where where
tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr tokens = exprParser matchstandard matchgroupwanted (pure groupmap) configmap (Just u) expr
matchstandard matchstandard
| expandstandard = maybe (unknownMatcher u) (go False False) | expandstandard = maybe (unknownMatcher u) (go False False)
(standardPreferredContent <$> getStandardGroup mygroups) (standardPreferredContent <$> getStandardGroup mygroups)
@ -133,7 +133,7 @@ checkPreferredContentExpression expr = case parsedToMatcher tokens of
Left e -> Just e Left e -> Just e
Right _ -> Nothing Right _ -> Nothing
where where
tokens = exprParser matchAll matchAll emptyGroupMap M.empty Nothing expr tokens = exprParser matchAll matchAll (pure emptyGroupMap) M.empty Nothing expr
{- Puts a UUID in a standard group, and sets its preferred content to use {- Puts a UUID in a standard group, and sets its preferred content to use
- the standard expression for that group (unless preferred content is - the standard expression for that group (unless preferred content is