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.

diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index 8b0db60ad09e0719adbf9d435c6ec112d09d5119..a008198f312b7b56d0ce9d7ae4413cfa2c56e7e4 100644 (file)
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -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

diff --git a/Limit.hs b/Limit.hs
index 6930ab06d99339b0dc704977f7e7e596abda393a..321c1122b3997a34c484615440eb49daf27097d6 100644 (file)
--- a/Limit.hs
+++ b/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
-
-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
+addInAllGroup groupname = addLimit $ limitInAllGroup groupMap groupname
+
+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 ()

diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index c21d67010fb569c60e421ea603cadec3421d83ae..035c098f629202cbd2311e0bdafc9c45b9d56673 100644 (file)
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -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