avoid counting size of keys that are in the journal twice

In calcRepoSizes and also git-annex info, when a key was in the journal,
it was passed to the callback twice, so the calculated size was wrong.

diff --git a/Annex/Branch.hs b/Annex/Branch.hs
index f70e46780a1ed81e86a59686e6a3bc10a96a86f4..9bf613fe714145c2fad0a6fd01550a5430eacdd0 100644 (file)
--- a/Annex/Branch.hs
+++ b/Annex/Branch.hs
@@ -994,29 +994,30 @@ data UnmergedBranches t
  - The action is passed a callback that it can repeatedly call to read
  - the next file and its contents. When there are no more files, the
  - callback will return Nothing.
- -
- - In some cases the callback may return the same file more than once,
- - with different content. This happens rarely, only when the journal
- - contains additional information, and the last version of the
- - file it returns is the most current one.
  -}
 overBranchFileContents
        :: (RawFilePath -> Maybe v)
+       -> Bool
+       -- ^ When there are new files in the journal that have not yet
+       -- been committed to the branch, should those files be omitted?
+       -- When this is False, the callback is run on each journalled file
+       -- at the end, and so may be run more than once on the same file.
        -> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex a)
        -> Annex (UnmergedBranches a)
-overBranchFileContents select go = do
+overBranchFileContents select omitnewjournalledfiles go = do
        st <- update
-       v <- overBranchFileContents' select go st
+       v <- overBranchFileContents' select omitnewjournalledfiles go st
        return $ if not (null (unmergedRefs st))
                then UnmergedBranches v
                else NoUnmergedBranches v
 
 overBranchFileContents'
        :: (RawFilePath -> Maybe v)
+       -> Bool
        -> (Annex (Maybe (v, RawFilePath, Maybe L.ByteString)) -> Annex a)
        -> BranchState
        -> Annex a
-overBranchFileContents' select go st = do
+overBranchFileContents' select omitnewjournalledfiles go st = do
        g <- Annex.gitRepo
        (l, cleanup) <- inRepo $ Git.LsTree.lsTree
                Git.LsTree.LsTreeRecursive
@@ -1029,9 +1030,10 @@ overBranchFileContents' select go st = do
                        content' <- checkjournal f content
                        return (Just (v, f, content'))
                Nothing
-                       | journalIgnorable st -> return Nothing
+                       | journalIgnorable st || omitnewjournalledfiles ->
+                               return Nothing
                        -- The journal did not get committed to the
-                       -- branch, and may contain files that
+                       -- branch, and may contain new files that
                        -- are not present in the branch, which 
                        -- need to be provided to the action still.
                        -- This can cause the action to be run a

diff --git a/Annex/RepoSize.hs b/Annex/RepoSize.hs
index 2eb058a766ebe401683809f8c498fdccbba52de4..584785cbb834cb7d8ecad9c2a7ac7b855927cb6a 100644 (file)
--- a/Annex/RepoSize.hs
+++ b/Annex/RepoSize.hs
@@ -16,7 +16,8 @@ import Logs.UUID
 import qualified Data.Map.Strict as M
 
 {- Sum up the sizes of all keys in all repositories, from the information
- - in the git-annex branch. Can be slow.
+ - in the git-annex branch. New keys that only appear in the journal are
+ - not included. Can be slow.
  -
  - The map includes the UUIDs of all known repositories, including
  - repositories that are empty.
@@ -25,7 +26,7 @@ calcRepoSizes :: Annex (M.Map UUID RepoSize)
 calcRepoSizes = do
        knownuuids <- M.keys <$> uuidDescMap
        let startmap = M.fromList $ map (\u -> (u, RepoSize 0)) knownuuids
-       overLocationLogs startmap accum >>= \case
+       overLocationLogs True startmap accum >>= \case
                UnmergedBranches m -> return m
                NoUnmergedBranches m -> return m
   where

diff --git a/CmdLine/Seek.hs b/CmdLine/Seek.hs
index 195425dc99d5250b677303a44bf80e94056aafd2..d9a6b81499607b9c5394eee436a2683fd8e14338 100644 (file)
--- a/CmdLine/Seek.hs
+++ b/CmdLine/Seek.hs
@@ -284,7 +284,7 @@ withKeyOptions' ko auto mkkeyaction fallbackaction worktreeitems = do
                let discard reader = reader >>= \case
                        Nothing -> noop
                        Just _ -> discard reader
-               overLocationLogs' () 
+               overLocationLogs' False ()
                        (\reader cont -> checktimelimit (discard reader) cont) 
                        (\k _ () -> keyaction Nothing (SeekInput [], k, mkActionItem k))
                        >>= \case

diff --git a/Command/Info.hs b/Command/Info.hs
index 39435dc5cf2e902ccd09e204d849eac92b318c8e..e35a646d39c8eef4c302e9634ae5994dc86cfb93 100644 (file)
--- a/Command/Info.hs
+++ b/Command/Info.hs
@@ -641,7 +641,7 @@ cachedAllRepoData = do
                Just _ -> return s
                Nothing -> do
                        matcher <- lift getKeyOnlyMatcher
-                       r <- lift $ overLocationLogs (emptyKeyInfo, mempty) $ \k locs (d, rd) -> do
+                       r <- lift $ overLocationLogs True (emptyKeyInfo, mempty) $ \k locs (d, rd) -> do
                                ifM (matchOnKey matcher k)
                                        ( do
                                                alivelocs <- snd

diff --git a/Database/ImportFeed.hs b/Database/ImportFeed.hs
index 5797e86e508bf5ba210abfc8e41e0d538002b545..c17eb0ca0478f60ab020355a9d7a22b7c868c7a3 100644 (file)
--- a/Database/ImportFeed.hs
+++ b/Database/ImportFeed.hs
@@ -187,7 +187,7 @@ updateFromLog db@(ImportFeedDbHandle h) (oldtree, currtree)
        -- When initially populating the database, this 
        -- is faster than diffing from the empty tree
        -- and looking up every log file.
-       scanbranch = Annex.Branch.overBranchFileContents toscan goscan >>= \case
+       scanbranch = Annex.Branch.overBranchFileContents toscan False goscan >>= \case
                Annex.Branch.NoUnmergedBranches () -> return ()
                Annex.Branch.UnmergedBranches () -> scandiff
        

diff --git a/Logs/Location.hs b/Logs/Location.hs
index 9ec6adc962d37ac9b08e6a4e38ef9ae749d432aa..c07b19cd2a4b049c9deedda26498091db60857d6 100644 (file)
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -219,15 +219,17 @@ loggedKeysFor' u = loggedKeys' isthere
                return there
 
 {- This is much faster than loggedKeys. -}
-overLocationLogs :: v -> (Key -> [UUID] -> v -> Annex v) -> Annex (Annex.Branch.UnmergedBranches v)
-overLocationLogs v = overLocationLogs' v (flip const)
+overLocationLogs :: Bool -> v -> (Key -> [UUID] -> v -> Annex v) -> Annex (Annex.Branch.UnmergedBranches v)
+overLocationLogs omitnewjournalledfiles v =
+       overLocationLogs' omitnewjournalledfiles v (flip const)
 
 overLocationLogs'
-        :: v 
+       :: Bool
+       -> v 
        -> (Annex (Maybe (Key, RawFilePath, Maybe L.ByteString)) -> Annex v -> Annex v)
         -> (Key -> [UUID] -> v -> Annex v)
         -> Annex (Annex.Branch.UnmergedBranches v)
-overLocationLogs' iv discarder keyaction = do
+overLocationLogs' omitnewjournalledfiles iv discarder keyaction = do
        config <- Annex.getGitConfig
        clusters <- getClusters
        
@@ -245,7 +247,7 @@ overLocationLogs' iv discarder keyaction = do
                                )
                Nothing -> return v
 
-       Annex.Branch.overBranchFileContents getk (go iv)
+       Annex.Branch.overBranchFileContents getk omitnewjournalledfiles (go iv)
 
 -- Cannot import Logs.Cluster due to a cycle.
 -- Annex.clusters gets populated when starting up git-annex.