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:
parent
99b2a524a0
commit
983c1894eb
3 changed files with 28 additions and 26 deletions
|
@ -14,7 +14,6 @@ import Limit
|
|||
import Utility.Matcher
|
||||
import Types.Group
|
||||
import Logs.Group
|
||||
import Logs.Remote
|
||||
import Annex.UUID
|
||||
import qualified Annex
|
||||
import Types.FileMatcher
|
||||
|
@ -53,8 +52,8 @@ parsedToMatcher parsed = case partitionEithers parsed of
|
|||
([], vs) -> Right $ generate vs
|
||||
(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 matchstandard matchgroupwanted groupmap configmap mu expr =
|
||||
exprParser :: FileMatcher Annex -> FileMatcher Annex -> Annex GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))]
|
||||
exprParser matchstandard matchgroupwanted getgroupmap configmap mu expr =
|
||||
map parse $ tokenizeMatcher expr
|
||||
where
|
||||
parse = parseToken
|
||||
|
@ -62,12 +61,12 @@ exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
|
|||
matchgroupwanted
|
||||
(limitPresent mu)
|
||||
(limitInDir preferreddir)
|
||||
groupmap
|
||||
getgroupmap
|
||||
preferreddir = fromMaybe "public" $
|
||||
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
|
||||
|
||||
parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> GroupMap -> String -> Either String (Token (MatchFiles Annex))
|
||||
parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t
|
||||
parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> Annex GroupMap -> String -> Either String (Token (MatchFiles Annex))
|
||||
parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir getgroupmap t
|
||||
| t `elem` tokens = Right $ token t
|
||||
| t == "standard" = call matchstandard
|
||||
| t == "groupwanted" = call matchgroupwanted
|
||||
|
@ -86,7 +85,7 @@ parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupma
|
|||
, ("largerthan", limitSize (>))
|
||||
, ("smallerthan", limitSize (<))
|
||||
, ("metadata", limitMetaData)
|
||||
, ("inallgroup", limitInAllGroup groupmap)
|
||||
, ("inallgroup", limitInAllGroup getgroupmap)
|
||||
]
|
||||
where
|
||||
(k, v) = separate (== '=') t
|
||||
|
@ -109,9 +108,12 @@ largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
|
|||
where
|
||||
go Nothing = return matchAll
|
||||
go (Just expr) = do
|
||||
gm <- groupMap
|
||||
rc <- readRemoteLog
|
||||
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 $
|
||||
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
|
||||
|
|
28
Limit.hs
28
Limit.hs
|
@ -201,22 +201,22 @@ limitAnything _ _ = return True
|
|||
{- Adds a limit to skip files not believed to be present in all
|
||||
- repositories in the specified group. -}
|
||||
addInAllGroup :: String -> Annex ()
|
||||
addInAllGroup groupname = do
|
||||
m <- groupMap
|
||||
addLimit $ limitInAllGroup m groupname
|
||||
addInAllGroup groupname = addLimit $ limitInAllGroup groupMap groupname
|
||||
|
||||
limitInAllGroup :: GroupMap -> MkLimit Annex
|
||||
limitInAllGroup m groupname
|
||||
| S.null want = Right $ const $ const $ return True
|
||||
| otherwise = Right $ \notpresent -> checkKey $ check notpresent
|
||||
where
|
||||
want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
|
||||
check notpresent key
|
||||
limitInAllGroup :: Annex GroupMap -> MkLimit Annex
|
||||
limitInAllGroup getgroupmap groupname = Right $ \notpresent mi -> do
|
||||
m <- getgroupmap
|
||||
let want = fromMaybe S.empty $ M.lookup groupname $ uuidsByGroup m
|
||||
if S.null want
|
||||
then return True
|
||||
-- optimisation: Check if a wanted uuid is notpresent.
|
||||
| not (S.null (S.intersection want notpresent)) = return False
|
||||
| otherwise = do
|
||||
present <- S.fromList <$> Remote.keyLocations key
|
||||
return $ S.null $ want `S.difference` present
|
||||
else if not (S.null (S.intersection want notpresent))
|
||||
then return False
|
||||
else checkKey (check want) mi
|
||||
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. -}
|
||||
addInBackend :: String -> Annex ()
|
||||
|
|
|
@ -102,7 +102,7 @@ makeMatcher groupmap configmap groupwantedmap u = go True True
|
|||
| null (lefts tokens) = generate $ rights tokens
|
||||
| otherwise = unknownMatcher u
|
||||
where
|
||||
tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
|
||||
tokens = exprParser matchstandard matchgroupwanted (pure groupmap) configmap (Just u) expr
|
||||
matchstandard
|
||||
| expandstandard = maybe (unknownMatcher u) (go False False)
|
||||
(standardPreferredContent <$> getStandardGroup mygroups)
|
||||
|
@ -133,7 +133,7 @@ checkPreferredContentExpression expr = case parsedToMatcher tokens of
|
|||
Left e -> Just e
|
||||
Right _ -> Nothing
|
||||
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
|
||||
- the standard expression for that group (unless preferred content is
|
||||
|
|
Loading…
Reference in a new issue