use file-io for readFile/writeFile/appendFile on ByteStrings

These are all straightforward, and easy small performance wins.

Sponsored-by: Nicholas Golder-Manning

Annex/AdjustedBranch.hs

@@ -268,7 +268,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 			-- origbranch.
 			_ <- propigateAdjustedCommits' True origbranch adj commitlck
 			
-			origheadfile <- inRepo $ readFileStrict . Git.Ref.headFile
+			origheadfile <- inRepo $ readFileStrict . fromRawFilePath . Git.Ref.headFile
 			origheadsha <- inRepo (Git.Ref.sha currbranch)
 			
 			b <- adjustBranch adj origbranch
@@ -281,7 +281,7 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 				Just s -> do
 					inRepo $ \r -> do
 						let newheadfile = fromRef s
-						writeFile (Git.Ref.headFile r) newheadfile
+						writeFile (fromRawFilePath (Git.Ref.headFile r)) newheadfile
 						return (Just newheadfile)
 				_ -> return Nothing
 	
@@ -295,9 +295,9 @@ updateAdjustedBranch adj (AdjBranch currbranch) origbranch
 		unless ok $ case newheadfile of
 			Nothing -> noop
 			Just v -> preventCommits $ \_commitlck -> inRepo $ \r -> do
-				v' <- readFileStrict (Git.Ref.headFile r)
+				v' <- readFileStrict (fromRawFilePath (Git.Ref.headFile r))
 				when (v == v') $
-					writeFile (Git.Ref.headFile r) origheadfile
+					writeFile (fromRawFilePath (Git.Ref.headFile r)) origheadfile
 
 		return ok
 	| otherwise = preventCommits $ \commitlck -> do

Annex/AdjustedBranch/Merge.hs

@@ -30,8 +30,8 @@ import Utility.Tmp.Dir
 import Utility.CopyFile
 import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
-import qualified Data.ByteString as S
 import qualified System.FilePath.ByteString as P
 
 canMergeToAdjustedBranch :: Branch -> (OrigBranch, Adjustment) -> Annex Bool
@@ -76,6 +76,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 		tmpwt <- fromRepo gitAnnexMergeDir
 		withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath "git") $ \tmpgit -> withWorkTreeRelated tmpgit $
 			withemptydir git_dir tmpwt $ withWorkTree tmpwt $ do
+				let tmpgit' = toRawFilePath tmpgit
 				liftIO $ writeFile (tmpgit </> "HEAD") (fromRef updatedorig)
 				-- Copy in refs and packed-refs, to work
 				-- around bug in git 2.13.0, which
@@ -87,7 +88,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 				liftIO $ forM_ refs' $ \src -> do
 					whenM (R.doesPathExist src) $ do
 						dest <- relPathDirToFile git_dir src
-						let dest' = toRawFilePath tmpgit P.</> dest
+						let dest' = tmpgit' P.</> dest
 						createDirectoryUnder [git_dir]
 							(P.takeDirectory dest')
 						void $ createLinkOrCopy src dest'
@@ -106,7 +107,7 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
 				if merged
 					then do
 						!mergecommit <- liftIO $ extractSha
-							<$> S.readFile (tmpgit </> "HEAD")
+							<$> F.readFile' (toOsPath (tmpgit' P.</> "HEAD"))
 						-- This is run after the commit lock is dropped.
 						return $ postmerge mergecommit
 					else return $ return False

Annex/AutoMerge.hs

@@ -35,10 +35,10 @@ import Annex.InodeSentinal
 import Utility.InodeCache
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 import qualified Data.Set as S
 import qualified Data.Map as M
-import qualified Data.ByteString.Lazy as L
 import System.PosixCompat.Files (isSymbolicLink)
 
 {- Merges from a branch into the current branch (which may not exist yet),
@@ -268,7 +268,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
 			Nothing -> noop
 			Just sha -> replaceWorkTreeFile (toRawFilePath item) $ \tmp -> do
 				c <- catObject sha
-				liftIO $ L.writeFile (decodeBS tmp) c
+				liftIO $ F.writeFile (toOsPath tmp) c
 				when isexecutable $
 					liftIO $ void $ tryIO $ 
 						modifyFileMode tmp $

Annex/Branch.hs

@@ -96,6 +96,7 @@ import Annex.Hook
 import Utility.Directory.Stream
 import Utility.Tmp
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 {- Name of the branch that is used to store git-annex's information. -}
 name :: Git.Ref
@@ -711,9 +712,9 @@ forceUpdateIndex jl branchref = do
 {- Checks if the index needs to be updated. -}
 needUpdateIndex :: Git.Ref -> Annex Bool
 needUpdateIndex branchref = do
-	f <- fromRawFilePath <$> fromRepo gitAnnexIndexStatus
+	f <- toOsPath <$> fromRepo gitAnnexIndexStatus
 	committedref <- Git.Ref . firstLine' <$>
-		liftIO (catchDefaultIO mempty $ B.readFile f)
+		liftIO (catchDefaultIO mempty $ F.readFile' f)
 	return (committedref /= branchref)
 
 {- Record that the branch's index has been updated to correspond to a
@@ -931,8 +932,8 @@ getIgnoredRefs =
 	S.fromList . mapMaybe Git.Sha.extractSha . fileLines' <$> content
   where
 	content = do
-		f <- fromRawFilePath <$> fromRepo gitAnnexIgnoredRefs
+		f <- toOsPath <$> fromRepo gitAnnexIgnoredRefs
-		liftIO $ catchDefaultIO mempty $ B.readFile f
+		liftIO $ catchDefaultIO mempty $ F.readFile' f
 
 addMergedRefs :: [(Git.Sha, Git.Branch)] -> Annex ()
 addMergedRefs [] = return ()
@@ -949,8 +950,8 @@ getMergedRefs = S.fromList . map fst <$> getMergedRefs'
 
 getMergedRefs' :: Annex [(Git.Sha, Git.Branch)]
 getMergedRefs' = do
-	f <- fromRawFilePath <$> fromRepo gitAnnexMergedRefs
+	f <- toOsPath <$> fromRepo gitAnnexMergedRefs
-	s <- liftIO $ catchDefaultIO mempty $ B.readFile f
+	s <- liftIO $ catchDefaultIO mempty $ F.readFile' f
 	return $ map parse $ fileLines' s
   where
 	parse l = 

Annex/ChangedRefs.hs

@@ -23,11 +23,11 @@ import Utility.Directory.Create
 import qualified Git
 import Git.Sha
 import qualified Utility.SimpleProtocol as Proto
+import qualified Utility.FileIO as F
 
 import Control.Concurrent
 import Control.Concurrent.STM
 import Control.Concurrent.STM.TBMChan
-import qualified Data.ByteString as S
 import qualified System.FilePath.ByteString as P
 
 newtype ChangedRefs = ChangedRefs [Git.Ref]
@@ -104,7 +104,7 @@ notifyHook chan reffile _
 	| ".lock" `isSuffixOf` reffile = noop
 	| otherwise = void $ do
 		sha <- catchDefaultIO Nothing $
-			extractSha <$> S.readFile reffile
+			extractSha <$> F.readFile' (toOsPath (toRawFilePath reffile))
 		-- When the channel is full, there is probably no reader
 		-- running, or ref changes have been occurring very fast,
 		-- so it's ok to not write the change to it.

Annex/Journal.hs

@@ -205,7 +205,7 @@ getJournalFileStale (GetPrivate getprivate) file = do
 	jfile = journalFile file
 	getfrom d = catchMaybeIO $
 		discardIncompleteAppend . L.fromStrict
-			<$> B.readFile (fromRawFilePath (d P.</> jfile))
+			<$> F.readFile' (toOsPath (d P.</> jfile))
 
 -- Note that this forces read of the whole lazy bytestring.
 discardIncompleteAppend :: L.ByteString -> L.ByteString

Annex/Link.hs

@@ -118,7 +118,7 @@ makeGitLink linktarget file = ifM (coreSymlinks <$> Annex.getGitConfig)
 	( liftIO $ do
 		void $ tryIO $ R.removeLink file
 		R.createSymbolicLink linktarget file
-	, liftIO $ S.writeFile (fromRawFilePath file) linktarget
+	, liftIO $ F.writeFile' (toOsPath file) linktarget
 	)
 
 {- Creates a link on disk, and additionally stages it in git. -}
@@ -153,7 +153,7 @@ stagePointerFile file mode sha =
 
 writePointerFile :: RawFilePath -> Key -> Maybe FileMode -> IO ()
 writePointerFile file k mode = do
-	S.writeFile (fromRawFilePath file) (formatPointer k)
+	F.writeFile' (toOsPath file) (formatPointer k)
 	maybe noop (R.setFileMode file) mode
 
 newtype Restage = Restage Bool

CmdLine/GitRemoteAnnex.hs

@@ -859,7 +859,7 @@ startPush' rmt manifest = do
 	f <- fromRepo (lastPushedManifestFile (Remote.uuid rmt))
 	oldmanifest <- liftIO $ 
 		fromRight mempty . parseManifest
-			<$> B.readFile (fromRawFilePath f)
+			<$> F.readFile' (toOsPath f)
 				`catchNonAsync` (const (pure mempty))
 	let oldmanifest' = mkManifest [] $
 		S.fromList (inManifest oldmanifest)

Command/ResolveMerge.hs

@@ -5,6 +5,8 @@
  - Licensed under the GNU AGPL version 3 or higher.
  -}
 
+{-# LANGUAGE OverloadedStrings #-}
+
 module Command.ResolveMerge where
 
 import Command
@@ -12,8 +14,9 @@ import qualified Git
 import Git.Sha
 import qualified Git.Branch
 import Annex.AutoMerge
+import qualified Utility.FileIO as F
 
-import qualified Data.ByteString as S
+import qualified System.FilePath.ByteString as P
 
 cmd :: Command
 cmd = command "resolvemerge" SectionPlumbing
@@ -26,10 +29,10 @@ seek = withNothing (commandAction start)
 start :: CommandStart
 start = starting "resolvemerge" (ActionItemOther Nothing) (SeekInput []) $ do
 	us <- fromMaybe nobranch <$> inRepo Git.Branch.current
-	d <- fromRawFilePath <$> fromRepo Git.localGitDir
+	d <- fromRepo Git.localGitDir
-	let merge_head = d </> "MERGE_HEAD"
+	let merge_head = toOsPath $ d P.</> "MERGE_HEAD"
 	them <- fromMaybe (giveup nomergehead) . extractSha
-		<$> liftIO (S.readFile merge_head)
+		<$> liftIO (F.readFile' merge_head)
 	ifM (resolveMerge (Just us) them False)
 		( do
 			void $ commitResolvedMerge Git.Branch.ManualCommit

Command/TestRemote.hs

@@ -32,6 +32,7 @@ import Annex.SpecialRemote.Config (exportTreeField)
 import Remote.Helper.Chunked
 import Remote.Helper.Encryptable (encryptionField, highRandomQualityField)
 import Git.Types
+import qualified Utility.FileIO as F
 
 import Test.Tasty
 import Test.Tasty.Runners
@@ -255,18 +256,18 @@ test runannex mkr mkk =
 		get r k
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 0" $ \r k -> do
-		tmp <- fromRawFilePath <$> prepTmp k
+		tmp <- toOsPath <$> prepTmp k
-		liftIO $ writeFile tmp ""
+		liftIO $ F.writeFile' tmp mempty
 		lockContentForRemoval k noop removeAnnex
 		get r k
 	, check "fsck downloaded object" fsck
 	, check "retrieveKeyFile resume from 33%" $ \r k -> do
 		loc <- fromRawFilePath <$> Annex.calcRepo (gitAnnexLocation k)
-		tmp <- fromRawFilePath <$> prepTmp k
+		tmp <- toOsPath <$> prepTmp k
 		partial <- liftIO $ bracket (openBinaryFile loc ReadMode) hClose $ \h -> do
 			sz <- hFileSize h
 			L.hGet h $ fromInteger $ sz `div` 3
-		liftIO $ L.writeFile tmp partial
+		liftIO $ F.writeFile tmp partial
 		lockContentForRemoval k noop removeAnnex
 		get r k
 	, check "fsck downloaded object" fsck

Git/Ref.hs

@@ -15,19 +15,22 @@ import Git.Command
 import Git.Sha
 import Git.Types
 import Git.FilePath
+import qualified Utility.FileIO as F
 
 import Data.Char (chr, ord)
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Char8 as S8
+import qualified System.FilePath.ByteString as P
 
 headRef :: Ref
 headRef = Ref "HEAD"
 
-headFile :: Repo -> FilePath
+headFile :: Repo -> RawFilePath
-headFile r = fromRawFilePath (localGitDir r) </> "HEAD"
+headFile r = localGitDir r P.</> "HEAD"
 
 setHeadRef :: Ref -> Repo -> IO ()
-setHeadRef ref r = S.writeFile (headFile r) ("ref: " <> fromRef' ref)
+setHeadRef ref r = 
+	F.writeFile' (toOsPath (headFile r)) ("ref: " <> fromRef' ref)
 
 {- Converts a fully qualified git ref into a user-visible string. -}
 describe :: Ref -> String

Git/Repair.hs

@@ -44,6 +44,7 @@ import Utility.Tmp.Dir
 import Utility.Rsync
 import Utility.FileMode
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 import qualified Data.Set as S
 import qualified Data.ByteString.Lazy as L
@@ -87,7 +88,7 @@ explodePacks r = go =<< listPackFiles r
 			-- May fail, if pack file is corrupt.
 			void $ tryIO $
 				pipeWrite [Param "unpack-objects", Param "-r"] r' $ \h ->
-				L.hPut h =<< L.readFile (fromRawFilePath packfile)
+				L.hPut h =<< F.readFile (toOsPath packfile)
 		objs <- emptyWhenDoesNotExist (dirContentsRecursive (toRawFilePath tmpdir))
 		forM_ objs $ \objfile -> do
 			f <- relPathDirToFile
@@ -116,9 +117,9 @@ retrieveMissingObjects missing referencerepo r
 		unlessM (boolSystem "git" [Param "init", File tmpdir]) $
 			giveup $ "failed to create temp repository in " ++ tmpdir
 		tmpr <- Config.read =<< Construct.fromPath (toRawFilePath tmpdir)
-		let repoconfig r' = fromRawFilePath (localGitDir r' P.</> "config")
+		let repoconfig r' = toOsPath (localGitDir r' P.</> "config")
-		whenM (doesFileExist (repoconfig r)) $
+		whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $
-			L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)
+			F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr)
 		rs <- Construct.fromRemotes r
 		stillmissing <- pullremotes tmpr rs fetchrefstags missing
 		if S.null (knownMissing stillmissing)

Logs/Export.hs

@@ -34,6 +34,7 @@ import Logs.File
 import qualified Git.LsTree
 import qualified Git.Tree
 import Annex.UUID
+import qualified Utility.FileIO as F
 
 import qualified Data.Map as M
 import qualified Data.ByteString as B
@@ -129,7 +130,7 @@ getExportExcluded :: UUID -> Annex [Git.Tree.TreeItem]
 getExportExcluded u = do
 	logf <- fromRepo $ gitAnnexExportExcludeLog u
 	liftIO $ catchDefaultIO [] $ exportExcludedParser
-		<$> L.readFile (fromRawFilePath logf)
+		<$> F.readFile (toOsPath logf)
   where
 
 exportExcludedParser :: L.ByteString -> [Git.Tree.TreeItem]

Remote/BitTorrent.hs

@@ -39,7 +39,7 @@ import qualified Data.ByteString as S
 
 #ifdef WITH_TORRENTPARSER
 import Data.Torrent
-import qualified Data.ByteString.Lazy as B
+import qualified Utility.FileIO as F
 #endif
 
 remote :: RemoteType
@@ -366,7 +366,7 @@ torrentFileSizes :: RawFilePath -> IO [(FilePath, Integer)]
 torrentFileSizes torrent = do
 #ifdef WITH_TORRENTPARSER
 	let mkfile = joinPath . map (scrub . decodeBL)
-	b <- B.readFile (fromRawFilePath torrent)
+	b <- F.readFile (toOsPath torrent)
 	return $ case readTorrent b of
 		Left e -> giveup $ "failed to parse torrent: " ++ e
 		Right t -> case tInfo t of

Remote/Directory.hs

@@ -15,7 +15,6 @@ module Remote.Directory (
 	removeDirGeneric,
 ) where
 
-import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as M
 import qualified Data.List.NonEmpty as NE
 import qualified System.FilePath.ByteString as P
@@ -52,6 +51,7 @@ import Utility.InodeCache
 import Utility.FileMode
 import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 #ifndef mingw32_HOST_OS
 import Utility.OpenFd
 #endif
@@ -257,7 +257,7 @@ retrieveKeyFileM d NoChunks cow = fileRetriever' $ \dest k p iv -> do
 	src <- liftIO $ fromRawFilePath <$> getLocation d k
 	void $ liftIO $ fileCopier cow src (fromRawFilePath dest) p iv
 retrieveKeyFileM d _ _ = byteRetriever $ \k sink ->
-	sink =<< liftIO (L.readFile . fromRawFilePath =<< getLocation d k)
+	sink =<< liftIO (F.readFile . toOsPath =<< getLocation d k)
 
 retrieveKeyFileCheapM :: RawFilePath -> ChunkConfig -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
 -- no cheap retrieval possible for chunks

Remote/Directory/LegacyChunked.hs

@@ -24,6 +24,7 @@ import Annex.Tmp
 import Utility.Metered
 import Utility.Directory.Create
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 withCheckedFiles :: (FilePath -> IO Bool) -> FilePath -> (FilePath -> Key -> [FilePath]) -> Key -> ([FilePath] -> IO Bool) -> IO Bool
 withCheckedFiles _ [] _locations _ _ = return False
@@ -101,13 +102,13 @@ retrieve :: (RawFilePath -> Key -> [RawFilePath]) -> RawFilePath -> Retriever
 retrieve locations d basek p _dest miv c = withOtherTmp $ \tmpdir -> do
 	showLongNote "This remote uses the deprecated chunksize setting. So this will be quite slow."
 	let tmp = tmpdir P.</> keyFile basek <> ".directorylegacy.tmp"
-	let tmp' = fromRawFilePath tmp
+	let tmp' = toOsPath tmp
 	let go = \k sink -> do
 		liftIO $ void $ withStoredFiles (fromRawFilePath d) (legacyLocations locations) k $ \fs -> do
 			forM_ fs $
-				S.appendFile tmp' <=< S.readFile
+				F.appendFile' tmp' <=< S.readFile
 			return True
-		b <- liftIO $ L.readFile tmp'
+		b <- liftIO $ F.readFile tmp'
 		liftIO $ removeWhenExistsWith R.removeLink tmp
 		sink b
 	byteRetriever go basek p tmp miv c

Upgrade/V1.hs

@@ -15,7 +15,6 @@ import Data.Default
 import Data.ByteString.Builder
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Short as S (toShort, fromShort)
-import qualified Data.ByteString.Lazy as L
 import qualified System.FilePath.ByteString as P
 import System.PosixCompat.Files (isRegularFile)
 import Text.Read
@@ -35,6 +34,7 @@ import Utility.FileMode
 import Utility.Tmp
 import qualified Upgrade.V2
 import qualified Utility.RawFilePath as R
+import qualified Utility.FileIO as F
 
 -- v2 adds hashing of filenames of content and location log files.
 -- Key information is encoded in filenames differently, so
@@ -198,7 +198,7 @@ fileKey1 file = readKey1 $
 	replace "&a" "&" $ replace "&s" "%" $ replace "%" "/" file
 
 writeLog1 :: FilePath -> [LogLine] -> IO ()
-writeLog1 file ls = viaTmp (L.writeFile . fromRawFilePath . fromOsPath)
+writeLog1 file ls = viaTmp F.writeFile
 	(toOsPath (toRawFilePath file))
 	(toLazyByteString $ buildLog ls)
 

Upgrade/V5.hs

@@ -34,8 +34,7 @@ import Utility.InodeCache
 import Utility.DottedVersion
 import Annex.AdjustedBranch
 import qualified Utility.RawFilePath as R
-
+import qualified Utility.FileIO as F
-import qualified Data.ByteString as S
 
 upgrade :: Bool -> Annex UpgradeResult
 upgrade automatic = flip catchNonAsync onexception $ do
@@ -130,7 +129,7 @@ upgradeDirectWorkTree = do
 			Just k -> do
 				stagePointerFile f Nothing =<< hashPointerFile k
 				ifM (isJust <$> getAnnexLinkTarget f)
-					( writepointer (fromRawFilePath f) k
+					( writepointer f k
 					, fromdirect (fromRawFilePath f) k
 					)
 				Database.Keys.addAssociatedFile k
@@ -158,8 +157,8 @@ upgradeDirectWorkTree = do
 		)
 	
 	writepointer f k = liftIO $ do
-		removeWhenExistsWith R.removeLink (toRawFilePath f)
+		removeWhenExistsWith R.removeLink f
-		S.writeFile f (formatPointer k)
+		F.writeFile' (toOsPath f) (formatPointer k)
 
 {- Remove all direct mode bookkeeping files. -}
 removeDirectCruft :: Annex ()

doc/todo/RawFilePath_conversion.mdwn

@@ -18,7 +18,7 @@ status.
   mechanical, with only some wrapper functions in Utility.FileIO and
   Utility.RawFilePath needing to be changed.
 * Utility.FileIO is used for most withFile and openFile, but not yet for
-  readFile, writeFile, and appendFile. Including versions of those from
+  readFile, writeFile, and appendFile (except most ones on bytestrings)
   bytestring. Also readFileStrict should be replaced with 
   Utility.FileIO.readFile'
   Note that the String versions can do newline translation, which has to be