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

These are all straightforward, and easy small performance wins.

Sponsored-by: Nicholas Golder-Manning
This commit is contained in:
Joey Hess 2025-01-22 14:30:25 -04:00
parent 90cd3aad37
commit 9b79f0f43d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
19 changed files with 63 additions and 52 deletions

View file

@ -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

View file

@ -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

View file

@ -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 $

View file

@ -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
liftIO $ catchDefaultIO mempty $ B.readFile f
f <- toOsPath <$> fromRepo gitAnnexIgnoredRefs
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
s <- liftIO $ catchDefaultIO mempty $ B.readFile f
f <- toOsPath <$> fromRepo gitAnnexMergedRefs
s <- liftIO $ catchDefaultIO mempty $ F.readFile' f
return $ map parse $ fileLines' s
where
parse l =

View file

@ -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.

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -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
let merge_head = d </> "MERGE_HEAD"
d <- fromRepo Git.localGitDir
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

View file

@ -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
liftIO $ writeFile tmp ""
tmp <- toOsPath <$> prepTmp k
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

View file

@ -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 r = fromRawFilePath (localGitDir r) </> "HEAD"
headFile :: Repo -> RawFilePath
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

View file

@ -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")
whenM (doesFileExist (repoconfig r)) $
L.readFile (repoconfig r) >>= L.writeFile (repoconfig tmpr)
let repoconfig r' = toOsPath (localGitDir r' P.</> "config")
whenM (doesFileExist (fromRawFilePath (fromOsPath (repoconfig r)))) $
F.readFile (repoconfig r) >>= F.writeFile (repoconfig tmpr)
rs <- Construct.fromRemotes r
stillmissing <- pullremotes tmpr rs fetchrefstags missing
if S.null (knownMissing stillmissing)

View file

@ -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]

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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)

View file

@ -34,8 +34,7 @@ import Utility.InodeCache
import Utility.DottedVersion
import Annex.AdjustedBranch
import qualified Utility.RawFilePath as R
import qualified Data.ByteString as S
import qualified Utility.FileIO as F
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)
S.writeFile f (formatPointer k)
removeWhenExistsWith R.removeLink f
F.writeFile' (toOsPath f) (formatPointer k)
{- Remove all direct mode bookkeeping files. -}
removeDirectCruft :: Annex ()

View file

@ -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