From ed8afacc399ea73b078ce14173ab31c37576fa79 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Fri, 23 Sep 2022 13:49:01 -0400
Subject: [PATCH] add a finalizer to streamLogFile

Sponsored-by: Dartmouth College's DANDI project
---
 Logs/File.hs   | 19 ++++++++++++-------
 Logs/Smudge.hs |  2 +-
 2 files changed, 13 insertions(+), 8 deletions(-)

diff --git a/Logs/File.hs b/Logs/File.hs
index be6aa72d15..87e479ae7c 100644
--- a/Logs/File.hs
+++ b/Logs/File.hs
@@ -113,25 +113,30 @@ fullLines = go []
 			let (l, b') = L.splitAt n b
 			in go (l:c) (L.drop 1 b')
 
--- | Streams lines from a log file, and then empties the file at the end.
+-- | Streams lines from a log file, passing each line to the processor,
+-- and then empties the file at the end.
 --
--- If the action is interrupted or throws an exception, the log file is
+-- If the processor is interrupted or throws an exception, the log file is
 -- left unchanged.
 --
--- Does nothing if the log file does not exist.
+-- There is also a finalizer, that is run once all lines have been
+-- streamed. It is run even if the log file does not exist. If the
+-- finalizer throws an exception, the log file is left unchanged.
 -- 
 -- Locking is used to prevent writes to to the log file while this
 -- is running.
-streamLogFile :: FilePath -> RawFilePath -> (String -> Annex ()) -> Annex ()
-streamLogFile f lck a = withExclusiveLock lck $ bracketOnError setup cleanup go
+streamLogFile :: FilePath -> RawFilePath -> Annex () -> (String -> Annex ()) -> Annex ()
+streamLogFile f lck finalizer processor = 
+	withExclusiveLock lck $ bracketOnError setup cleanup go
   where
 	setup = liftIO $ tryWhenExists $ openFile f ReadMode 
 	cleanup Nothing = noop
 	cleanup (Just h) = liftIO $ hClose h
-	go Nothing = noop
+	go Nothing = finalizer
 	go (Just h) = do
-		mapM_ a =<< liftIO (lines <$> hGetContents h)
+		mapM_ processor =<< liftIO (lines <$> hGetContents h)
 		liftIO $ hClose h
+		finalizer
 		liftIO $ writeFile f ""
 		setAnnexFilePerm (toRawFilePath f)
 
diff --git a/Logs/Smudge.hs b/Logs/Smudge.hs
index 9cde95a1d9..7b0f5ff5f6 100644
--- a/Logs/Smudge.hs
+++ b/Logs/Smudge.hs
@@ -34,7 +34,7 @@ streamSmudged :: (Key -> TopFilePath -> Annex ()) -> Annex ()
 streamSmudged a = do
 	logf <- fromRepo gitAnnexSmudgeLog
 	lckf <- fromRepo gitAnnexSmudgeLock
-	streamLogFile (fromRawFilePath logf) lckf $ \l -> 
+	streamLogFile (fromRawFilePath logf) lckf noop $ \l -> 
 		case parse l of
 			Nothing -> noop
 			Just (k, f) -> a k f