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 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
|
||||||
|
|
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
|
{- 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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue