more log file actions

Which will be needed soon.

And use more ByteStrings for speed.

This commit was sponsored by Graham Spencer on Patreon.

Logs/File.hs

@@ -1,11 +1,20 @@
 {- git-annex log files
  -
- - Copyright 2018 Joey Hess <id@joeyh.name>
+ - Copyright 2018-2020 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
-module Logs.File (writeLogFile, withLogHandle, appendLogFile, streamLogFile) where
+{-# LANGUAGE BangPatterns #-}
+
+module Logs.File (
+	writeLogFile,
+	withLogHandle,
+	appendLogFile,
+	modifyLogFile,
+	streamLogFile,
+	checkLogFile,
+) where
 
 import Annex.Common
 import Annex.Perms
@@ -14,6 +23,9 @@ import Annex.ReplaceFile
 import qualified Git
 import Utility.Tmp
 
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.Char8 as L8
+
 -- | Writes content to a file, replacing the file atomically, and
 -- making the new file have whatever permissions the git repository is
 -- configured to use. Creates the parent directory when necessary.
@@ -39,11 +51,63 @@ withLogHandle f a = do
 
 -- | Appends a line to a log file, first locking it to prevent
 -- concurrent writers.
-appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> String -> Annex ()
+appendLogFile :: FilePath -> (Git.Repo -> FilePath) -> L.ByteString -> Annex ()
 appendLogFile f lck c = createDirWhenNeeded f $ withExclusiveLock lck $ do
-	liftIO $ withFile f AppendMode $ \h -> hPutStrLn h c
+	liftIO $ withFile f AppendMode $ \h -> L8.hPutStrLn h c
 	setAnnexFilePerm f
 
+-- | Modifies a log file.
+--
+-- If the function does not make any changes, avoids rewriting the file
+-- for speed, but that does mean the whole file content has to be buffered
+-- in memory.
+--
+-- The file is locked to prevent concurrent writers, and it is written
+-- atomically.
+modifyLogFile :: FilePath -> (Git.Repo -> FilePath) -> ([L.ByteString] -> [L.ByteString]) -> Annex ()
+modifyLogFile f lck modf = withExclusiveLock lck $ do
+	ls <- liftIO $ fromMaybe []
+		<$> tryWhenExists (L8.lines <$> L.readFile f)
+	let ls' = modf ls
+	when (ls' /= ls) $
+		createDirWhenNeeded f $
+			viaTmp writelog f (L8.unlines ls')
+  where
+	writelog f' b = do
+		liftIO $ L.writeFile f' b
+		setAnnexFilePerm f'
+
+-- | Checks the content of a log file to see if any line matches.
+--
+-- This can safely be used while appendLogFile or any atomic
+-- action is concurrently modifying the file. It does not lock the file,
+-- for speed, but instead relies on the fact that a log file usually
+-- ends in a newline.
+checkLogFile :: FilePath -> (Git.Repo -> FilePath) -> (L.ByteString -> Bool) -> Annex Bool
+checkLogFile f lck matchf = withExclusiveLock lck $ bracket setup cleanup go
+  where
+	setup = liftIO $ tryWhenExists $ openFile f ReadMode
+	cleanup Nothing = noop
+	cleanup (Just h) = liftIO $ hClose h
+	go Nothing = return False
+	go (Just h) = do
+		!r <- liftIO (any matchf . fullLines <$> L.hGetContents h)
+		return r
+
+-- | Gets only the lines that end in a newline. If the last part of a file
+-- does not, it's assumed to be a new line being logged that is incomplete,
+-- and is omitted.
+--
+-- Unlike lines, this does not collapse repeated newlines etc.
+fullLines :: L.ByteString -> [L.ByteString]
+fullLines = go []
+  where
+	go c b = case L8.elemIndex '\n' b of
+		Nothing -> reverse c
+		Just n ->
+			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.
 --
 -- If the action is interrupted or throws an exception, the log file is

Logs/Smudge.hs

@@ -13,11 +13,13 @@ import Annex.Common
 import Git.FilePath
 import Logs.File
 
+import qualified Data.ByteString.Lazy as L
+
 -- | Log a smudged file.
 smudgeLog :: Key -> TopFilePath -> Annex ()
 smudgeLog k f = do
 	logf <- fromRepo gitAnnexSmudgeLog
-	appendLogFile logf gitAnnexSmudgeLock $ fromRawFilePath $
+	appendLogFile logf gitAnnexSmudgeLock $ L.fromStrict $
 		serializeKey' k <> " " <> getTopFilePath f
 
 -- | Streams all smudged files, and then empties the log at the end.