avoid git annex info remote buffering list of keys

This leaves git annex unused --from remote still using loggedKeysFor
and buffering more than ought to be necessary, but I can't see a way to
improve that.
This commit is contained in:
Joey Hess 2018-04-26 16:13:05 -04:00
parent bea0ad220a
commit 2fc768ce72
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 15 additions and 4 deletions

View file

@ -23,7 +23,8 @@ git-annex (6.20180410) UNRELEASED; urgency=medium
* Assistant: Fix installation of menus, icons, etc when run * Assistant: Fix installation of menus, icons, etc when run
from within runshell. from within runshell.
* import: Avoid buffering all filenames to be imported in memory. * import: Avoid buffering all filenames to be imported in memory.
* Improve memory use and speed of --all, by not buffering list of all keys. * Improve memory use and speed of --all and git-annex info remote,
by not buffering list of all keys.
-- Joey Hess <id@joeyh.name> Mon, 09 Apr 2018 14:03:28 -0400 -- Joey Hess <id@joeyh.name> Mon, 09 Apr 2018 14:03:28 -0400

View file

@ -525,7 +525,11 @@ cachedRemoteData u = do
case M.lookup u (repoData s) of case M.lookup u (repoData s) of
Just v -> return v Just v -> return v
Nothing -> do Nothing -> do
v <- foldKeys <$> lift (loggedKeysFor u) let combinedata d uk = finishCheck uk >>= \case
Nothing -> return d
Just k -> return $ addKey k d
v <- lift $ foldM combinedata emptyKeyData
=<< loggedKeysFor' u
put s { repoData = M.insert u v (repoData s) } put s { repoData = M.insert u v (repoData s) }
return v return v

View file

@ -27,6 +27,7 @@ module Logs.Location (
finishCheck, finishCheck,
loggedKeys, loggedKeys,
loggedKeysFor, loggedKeysFor,
loggedKeysFor',
) where ) where
import Annex.Common import Annex.Common
@ -139,10 +140,15 @@ loggedKeys' check = mapMaybe (defercheck <$$> locationLogFileKey)
) )
{- Finds all keys that have location log information indicating {- Finds all keys that have location log information indicating
- they are present for the specified repository. - they are present in the specified repository.
-
- This does not stream well; use loggedKeysFor' for lazy streaming.
-} -}
loggedKeysFor :: UUID -> Annex [Key] loggedKeysFor :: UUID -> Annex [Key]
loggedKeysFor u = catMaybes <$> (mapM finishCheck =<< loggedKeys' isthere) loggedKeysFor u = catMaybes <$> (mapM finishCheck =<< loggedKeysFor' u)
loggedKeysFor' :: UUID -> Annex [Unchecked Key]
loggedKeysFor' u = loggedKeys' isthere
where where
isthere k = do isthere k = do
us <- loggedLocations k us <- loggedLocations k