diff --git a/Annex/Branch.hs b/Annex/Branch.hs index ab4b43df3c..dce16667d7 100644 --- a/Annex/Branch.hs +++ b/Annex/Branch.hs @@ -183,23 +183,24 @@ updateTo' pairs = do branchref <- getBranch ignoredrefs <- getIgnoredRefs let unignoredrefs = excludeset ignoredrefs pairs - tomerge <- if null unignoredrefs - then return [] + (tomerge, notnewer) <- if null unignoredrefs + then return ([], []) else do mergedrefs <- getMergedRefs - filterM isnewer (excludeset mergedrefs unignoredrefs) + partitionM isnewer $ + excludeset mergedrefs unignoredrefs {- In a read-only repository, catching permission denied lets - query operations still work, although they will need to do - additional work since the refs are not merged. -} catchPermissionDenied (const (updatefailedperms tomerge)) - (go branchref tomerge) + (go branchref tomerge notnewer) where excludeset s = filter (\(r, _) -> S.notMember r s) isnewer (r, _) = inRepo $ Git.Branch.changed fullname r - go branchref tomerge = do + go branchref tomerge notnewer = do dirty <- journalDirty gitAnnexJournalDir journalcleaned <- if null tomerge {- Even when no refs need to be merged, the index @@ -229,6 +230,7 @@ updateTo' pairs = do journalclean <- if journalcleaned then not <$> privateUUIDsKnown else pure False + addMergedRefs notnewer return $ UpdateMade { refsWereMerged = not (null tomerge) , journalClean = journalclean diff --git a/CHANGELOG b/CHANGELOG index 9dccfb1730..d1e28a8fb0 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -2,6 +2,8 @@ git-annex (10.20230803) UNRELEASED; urgency=medium * Fix behavior of onlyingroup. * info: Added --dead-repositories option. + * Significant startup speed increase by avoiding repeatedly checking + if some remote git-annex branch refs need to be merged. -- Joey Hess Mon, 07 Aug 2023 13:04:13 -0400 diff --git a/Utility/Monad.hs b/Utility/Monad.hs index abe06f335c..6cd2c5e657 100644 --- a/Utility/Monad.hs +++ b/Utility/Monad.hs @@ -12,6 +12,7 @@ module Utility.Monad ( getM, anyM, allM, + partitionM, untilTrue, ifM, (<||>), @@ -45,6 +46,13 @@ allM :: Monad m => (a -> m Bool) -> [a] -> m Bool allM _ [] = return True allM p (x:xs) = p x <&&> allM p xs +partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a]) +partitionM _ [] = return ([], []) +partitionM p (x:xs) = do + r <- p x + (as, bs) <- partitionM p xs + return $ if r then (x:as, bs) else (as, x:bs) + {- Runs an action on values from a list until it succeeds. -} untilTrue :: Monad m => [a] -> (a -> m Bool) -> m Bool untilTrue = flip anyM