refactor the restage runner

Sponsored-by: Dartmouth College's DANDI project

Annex/Link.hs

@@ -177,7 +177,7 @@ newtype Restage = Restage Bool
  - gets to look at it.
  -}
 restagePointerFile :: Restage -> RawFilePath -> InodeCache -> Annex ()
-restagePointerFile (Restage False) f _ =
+restagePointerFile (Restage False) f orig = do
 	toplevelWarning True $ unableToRestage $ Just $ fromRawFilePath f
 restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
 	-- Avoid refreshing the index if run by the
@@ -190,20 +190,21 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
 		-- fails on "../../repo/path/file" when cwd is not in the repo 
 		-- being acted on. Avoid these problems with an absolute path.
 		absf <- liftIO $ absPath f
-		Annex.Queue.addFlushAction runner [(absf, isunmodified tsd, inodeCacheFileSize orig)]
+		Annex.Queue.addFlushAction restagePointerFileRunner
+			[(absf, isunmodified tsd, inodeCacheFileSize orig)]
   where
 	isunmodified tsd = genInodeCache f tsd >>= return . \case
 		Nothing -> False
 		Just new -> compareStrong orig new
 
-	-- Other changes to the files may have been staged before this
-	-- gets a chance to run. To avoid a race with any staging of
-	-- changes, first lock the index file. Then run git update-index
-	-- on all still-unmodified files, using a copy of the index file,
-	-- to bypass the lock. Then replace the old index file with the new
-	-- updated index file.
-	runner :: Git.Queue.FlushActionRunner Annex
-	runner = Git.Queue.FlushActionRunner "restagePointerFile" $ \r l -> do
+-- Other changes to the files may have been staged before this
+-- gets a chance to run. To avoid a race with any staging of
+-- changes, first lock the index file. Then run git update-index
+-- on all still-unmodified files, using a copy of the index file,
+-- to bypass the lock. Then replace the old index file with the new
+-- updated index file.
+restagePointerFileRunner :: Git.Queue.FlushActionRunner Annex
+restagePointerFileRunner = Git.Queue.FlushActionRunner "restagePointerFile" $ \r l -> do
 	-- Flush any queued changes to the keys database, so they
 	-- are visible to child processes.
 	-- The database is closed because that may improve behavior
@@ -240,7 +241,7 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
 			<&&> liftIO replaceindex
 		unless ok showwarning
 	bracket lockindex unlockindex go
-	
+  where
 	{- filter.annex.process configured to use git-annex filter-process
 	 - is sometimes faster and sometimes slower than using
 	 - git-annex smudge. The latter is run once per file, while

Logs/Restage.hs

@@ -0,0 +1,51 @@
+{- git-annex restage log file
+ -
+ - Copyright 2022 Joey Hess <id@joeyh.name>
+ -
+ - Licensed under the GNU AGPL version 3 or higher.
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module Logs.Restage where
+
+import Annex.Common
+import Git.FilePath
+import Logs.File
+
+import qualified Data.ByteString.Lazy as L
+
+-- | Log a file whose pointer needs to be restaged in git.
+-- The content of the file may not be a pointer, if it is populated with
+-- the annex content. The InodeCache is used to verify that the file
+-- still contains the content, and it's still safe to restage its pointer.
+writeRestageLog :: TopFilePath -> InodeCache -> Annex ()
+writeRestageLog f ic = do
+	logf <- fromRepo gitAnnexRestageLog
+	lckf <- fromRepo gitAnnexRestageLock
+	appendLogFile logf lckf $ L.fromStrict $
+		encodeBS (showInodeCache ic) <> ":" <> getTopFilePath f
+
+-- | Streams the content of the restage log, and then empties the log at
+-- the end.
+--
+-- If the action is interrupted or throws an exception, the log file is
+-- left unchanged.
+--
+-- Locking is used to prevent new items being added to the log while this
+-- is running.
+streamSmudged :: (TopFilePath -> InodeCache -> Annex ()) -> Annex ()
+streamSmudged a = do
+	logf <- fromRepo gitAnnexRestageLog
+	lckf <- fromRepo gitAnnexRestageLock
+	streamLogFile (fromRawFilePath logf) lckf $ \l -> 
+		case parse l of
+			Nothing -> noop
+			Just (k, f) -> a f ic
+  where
+	parse l = 
+		let (ics, f) = separate (== ':') l
+		in do
+			ic <- readInodeCache ics
+			return (asTopFilePath (toRawFilePath f), ic)
+