mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

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

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

9
Git/Ref.hs
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

9
Git/Repair.hs
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)