implement journalledRepoSizes

Plan is to run this when populating Annex.reposizes on demand.
So Annex.reposizes will be up-to-date with the journal, including
crucially journal entries for private repositories. But also
anything that has been written to the journal by another process,
especially if the process was ran with annex.alwayscommit=false.

From there, Annex.reposizes can be kept up to date with changes made
by the running process.

Logs/Location.hs

@@ -24,7 +24,6 @@ module Logs.Location (
 	loggedPreviousLocations,
 	loggedLocationsHistorical,
 	loggedLocationsRef,
-	parseLoggedLocations,
 	isKnownKey,
 	checkDead,
 	setDead,
@@ -35,6 +34,7 @@ module Logs.Location (
 	loggedKeysFor',
 	overLocationLogs,
 	overLocationLogs',
+	overLocationLogsJournal,
 ) where
 
 import Annex.Common
@@ -222,38 +222,96 @@ loggedKeysFor' u = loggedKeys' isthere
 overLocationLogs
 	:: Bool
 	-> v
-	-> (Key -> [UUID]
-	-> v
-	-> Annex v)
+	-> (Key -> [UUID] -> v -> Annex v)
 	-> Annex (Annex.Branch.UnmergedBranches (v, Sha))
 overLocationLogs ignorejournal v =
 	overLocationLogs' ignorejournal v (flip const)
 
 overLocationLogs'
 	:: Bool
-	-> v 
-	-> (Annex (Maybe (Key, RawFilePath, Maybe L.ByteString)) -> Annex v -> Annex v)
+	-> v
+	-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe Bool))) -> Annex v -> Annex v)
         -> (Key -> [UUID] -> v -> Annex v)
         -> Annex (Annex.Branch.UnmergedBranches (v, Sha))
-overLocationLogs' ignorejournal iv discarder keyaction = do
+overLocationLogs' ignorejournal =
+	overLocationLogsHelper
+		(Annex.Branch.overBranchFileContents ignorejournal)
+		(\locparser _ _ content -> pure (locparser (fst <$> content)))
+		True
+
+type LocChanges = 
+	( S.Set UUID
+	-- ^ locations that are in the journal, but not in the
+	-- git-annex branch
+	, S.Set UUID
+	-- ^ locations that are in the git-annex branch,
+	-- but have been removed in the journal
+	)
+
+{- Like overLocationLogs, but only adds changes in journalled files
+ - compared with what was logged in the git-annex branch at the specified
+ - commit sha. -}
+overLocationLogsJournal
+	:: v
+	-> Sha
+	-> (Key -> LocChanges -> v -> Annex v)
+	-> Annex v
+overLocationLogsJournal v branchsha keyaction = 
+	overLocationLogsHelper
+		(Annex.Branch.overJournalFileContents handlestale)
+		changedlocs
+		False
+		-- ^ do not precache journalled content, which may be stale
+		v (flip const) keyaction 
+  where
+	handlestale _ journalcontent = return (journalcontent, Just True)
+
+	changedlocs locparser _key logf (Just (journalcontent, isstale)) = do
+		branchcontent <- Annex.Branch.getRef branchsha logf
+		let branchlocs = S.fromList $ locparser $ Just branchcontent
+		let journallocs = S.fromList $ locparser $ Just $ case isstale of
+			Just True -> Annex.Branch.combineStaleJournalWithBranch
+				branchcontent journalcontent
+			_ -> journalcontent
+		return
+			( S.difference journallocs branchlocs
+			, S.difference branchlocs journallocs
+			)
+	changedlocs _ _ _ Nothing = pure (S.empty, S.empty)
+
+overLocationLogsHelper
+	:: ( (RawFilePath -> Maybe Key)
+		-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe b))) -> Annex v) 
+		-> Annex a
+	   )
+	-> ((Maybe L.ByteString -> [UUID]) -> Key -> RawFilePath -> Maybe (L.ByteString, Maybe b) -> Annex u)
+	-> Bool
+	-> v
+	-> (Annex (Maybe (Key, RawFilePath, Maybe (L.ByteString, Maybe b))) -> Annex v -> Annex v)
+        -> (Key -> u -> v -> Annex v)
+        -> Annex a
+overLocationLogsHelper runner locparserrunner canprecache iv discarder keyaction = do
 	config <- Annex.getGitConfig
 	clusters <- getClusters
-	
+
+	let locparser = maybe [] (parseLoggedLocations clusters)
 	let getk = locationLogFileKey config
 	let go v reader = reader >>= \case
 		Just (k, f, content) -> discarder reader $ do
 			-- precache to make checkDead fast, and also to
 			-- make any accesses done in keyaction fast.
-			maybe noop (Annex.Branch.precache f) content
+			when canprecache $
+				maybe noop (Annex.Branch.precache f . fst) content
 			ifM (checkDead k)
 				( go v reader
 				, do
-					!v' <- keyaction k (maybe [] (parseLoggedLocations clusters) content) v
+					!locs <- locparserrunner locparser k f content
+					!v' <- keyaction k locs v
 					go v' reader
 				)
 		Nothing -> return v
 
-	Annex.Branch.overBranchFileContents ignorejournal getk (go iv)
+	runner getk (go iv)
 
 -- Cannot import Logs.Cluster due to a cycle.
 -- Annex.clusters gets populated when starting up git-annex.

Logs/Presence.hs

@@ -6,7 +6,7 @@
  - A line of the log will look like: "date N INFO"
  - Where N=1 when the INFO is present, 0 otherwise.
  - 
- - Copyright 2010-2022 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2024 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -20,6 +20,7 @@ module Logs.Presence (
 	presentLogInfo,
 	notPresentLogInfo,
 	historicalLogInfo,
+	parseLogInfo,
 ) where
 
 import Logs.Presence.Pure as X
@@ -28,6 +29,8 @@ import Annex.VectorClock
 import qualified Annex.Branch
 import Git.Types (RefDate)
 
+import qualified Data.ByteString.Lazy as L
+
 {- Adds to the log, removing any LogLines that are obsoleted. -}
 addLog :: Annex.Branch.RegardingUUID -> RawFilePath -> LogStatus -> LogInfo -> Annex ()
 addLog ru file logstatus loginfo = 
@@ -82,5 +85,8 @@ notPresentLogInfo file = map info . filterNotPresent <$> readLog file
  - The date is formatted as shown in gitrevisions man page.
  -}
 historicalLogInfo :: RefDate -> RawFilePath -> Annex [LogInfo]
-historicalLogInfo refdate file = map info . filterPresent . parseLog
+historicalLogInfo refdate file = parseLogInfo
 	<$> Annex.Branch.getHistorical refdate file
+
+parseLogInfo :: L.ByteString -> [LogInfo]
+parseLogInfo = map info . filterPresent . parseLog