use RawFilePath version of rename
Some small wins, almost certianly swamped by the system calls, but still worthwhile progress on the RawFilePath conversion. Sponsored-by: Erik Bjäreholt on Patreon
This commit is contained in:
parent
d00e23cac9
commit
debcf86029
16 changed files with 58 additions and 54 deletions
|
@ -82,15 +82,14 @@ mergeToAdjustedBranch tomerge (origbranch, adj) mergeconfig canresolvemerge comm
|
|||
refs <- liftIO $ dirContentsRecursive $
|
||||
git_dir' </> "refs"
|
||||
let refs' = (git_dir' </> "packed-refs") : refs
|
||||
liftIO $ forM_ refs' $ \src ->
|
||||
liftIO $ forM_ refs' $ \src -> do
|
||||
let src' = toRawFilePath src
|
||||
whenM (doesFileExist src) $ do
|
||||
dest <- relPathDirToFile git_dir
|
||||
(toRawFilePath src)
|
||||
dest <- relPathDirToFile git_dir src'
|
||||
let dest' = toRawFilePath tmpgit P.</> dest
|
||||
createDirectoryUnder git_dir
|
||||
(P.takeDirectory dest')
|
||||
void $ createLinkOrCopy src
|
||||
(fromRawFilePath dest')
|
||||
void $ createLinkOrCopy src' dest'
|
||||
-- This reset makes git merge not care
|
||||
-- that the work tree is empty; otherwise
|
||||
-- it will think that all the files have
|
||||
|
|
|
@ -410,9 +410,7 @@ moveAnnex key af src = ifM (checkSecureHashes' key)
|
|||
storeobject dest = ifM (liftIO $ R.doesPathExist dest)
|
||||
( alreadyhave
|
||||
, adjustedBranchRefresh af $ modifyContentDir dest $ do
|
||||
liftIO $ moveFile
|
||||
(fromRawFilePath src)
|
||||
(fromRawFilePath dest)
|
||||
liftIO $ moveFile src dest
|
||||
-- Freeze the object file now that it is in place.
|
||||
-- Waiting until now to freeze it allows for freeze
|
||||
-- hooks that prevent moving the file.
|
||||
|
@ -654,17 +652,16 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key $ \file ->
|
|||
|
||||
{- Moves a key out of .git/annex/objects/ into .git/annex/bad, and
|
||||
- returns the file it was moved to. -}
|
||||
moveBad :: Key -> Annex FilePath
|
||||
moveBad :: Key -> Annex RawFilePath
|
||||
moveBad key = do
|
||||
src <- calcRepo (gitAnnexLocation key)
|
||||
bad <- fromRepo gitAnnexBadDir
|
||||
let dest = bad P.</> P.takeFileName src
|
||||
let dest' = fromRawFilePath dest
|
||||
createAnnexDirectory (parentDir dest)
|
||||
cleanObjectLoc key $
|
||||
liftIO $ moveFile (fromRawFilePath src) dest'
|
||||
liftIO $ moveFile src dest
|
||||
logStatus key InfoMissing
|
||||
return dest'
|
||||
return dest
|
||||
|
||||
data KeyLocation = InAnnex | InAnywhere
|
||||
|
||||
|
|
|
@ -84,10 +84,11 @@ setJournalFile _jl ru file content = withOtherTmp $ \tmp -> do
|
|||
createAnnexDirectory jd
|
||||
-- journal file is written atomically
|
||||
let jfile = journalFile file
|
||||
let tmpfile = fromRawFilePath (tmp P.</> jfile)
|
||||
let tmpfile = tmp P.</> jfile
|
||||
liftIO $ do
|
||||
withFile tmpfile WriteMode $ \h -> writeJournalHandle h content
|
||||
moveFile tmpfile (fromRawFilePath (jd P.</> jfile))
|
||||
withFile (fromRawFilePath tmpfile) WriteMode $ \h ->
|
||||
writeJournalHandle h content
|
||||
moveFile tmpfile (jd P.</> jfile)
|
||||
|
||||
data JournalledContent
|
||||
= NoJournalledContent
|
||||
|
|
|
@ -218,10 +218,10 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
|
|||
showwarning = warning $ unableToRestage Nothing
|
||||
go Nothing = showwarning
|
||||
go (Just _) = withTmpDirIn (fromRawFilePath $ Git.localGitDir r) "annexindex" $ \tmpdir -> do
|
||||
let tmpindex = tmpdir </> "index"
|
||||
let tmpindex = toRawFilePath (tmpdir </> "index")
|
||||
let updatetmpindex = do
|
||||
r' <- liftIO $ Git.Env.addGitEnv r Git.Index.indexEnv
|
||||
=<< Git.Index.indexEnvVal (toRawFilePath tmpindex)
|
||||
=<< Git.Index.indexEnvVal tmpindex
|
||||
-- Avoid git warning about CRLF munging.
|
||||
let r'' = r' { gitGlobalOpts = gitGlobalOpts r' ++
|
||||
[ Param "-c"
|
||||
|
@ -233,9 +233,9 @@ restagePointerFile (Restage True) f orig = withTSDelta $ \tsd ->
|
|||
whenM checkunmodified $
|
||||
feed f'
|
||||
let replaceindex = catchBoolIO $ do
|
||||
moveFile tmpindex (fromRawFilePath realindex)
|
||||
moveFile tmpindex realindex
|
||||
return True
|
||||
ok <- liftIO (createLinkOrCopy (fromRawFilePath realindex) tmpindex)
|
||||
ok <- liftIO (createLinkOrCopy realindex tmpindex)
|
||||
<&&> updatetmpindex
|
||||
<&&> liftIO replaceindex
|
||||
unless ok showwarning
|
||||
|
|
|
@ -75,13 +75,13 @@ replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir
|
|||
let tmpfile = tmpdir </> basetmp
|
||||
r <- action tmpfile
|
||||
when (checkres r) $
|
||||
replaceFileFrom tmpfile file createdirectory
|
||||
replaceFileFrom (toRawFilePath tmpfile) (toRawFilePath file) createdirectory
|
||||
return r
|
||||
|
||||
replaceFileFrom :: FilePath -> FilePath -> (RawFilePath -> Annex ()) -> Annex ()
|
||||
replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()
|
||||
replaceFileFrom src dest createdirectory = go `catchIO` fallback
|
||||
where
|
||||
go = liftIO $ moveFile src dest
|
||||
fallback _ = do
|
||||
createdirectory (parentDir (toRawFilePath dest))
|
||||
createdirectory (parentDir dest)
|
||||
go
|
||||
|
|
|
@ -28,6 +28,7 @@ import Utility.InodeCache
|
|||
import Annex.InodeSentinal
|
||||
import Annex.CheckIgnore
|
||||
import qualified Utility.RawFilePath as R
|
||||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
import System.PosixCompat.Files
|
||||
|
||||
|
@ -208,15 +209,15 @@ start si file addunlockedmatcher =
|
|||
starting "add" (ActionItemTreeFile file) si $
|
||||
addingExistingLink file key $
|
||||
withOtherTmp $ \tmp -> do
|
||||
let tmpf = fromRawFilePath tmp </> fromRawFilePath file
|
||||
liftIO $ moveFile (fromRawFilePath file) tmpf
|
||||
ifM (isSymbolicLink <$> liftIO (getSymbolicLinkStatus tmpf))
|
||||
let tmpf = tmp P.</> file
|
||||
liftIO $ moveFile file tmpf
|
||||
ifM (isSymbolicLink <$> liftIO (R.getSymbolicLinkStatus tmpf))
|
||||
( do
|
||||
liftIO $ removeFile tmpf
|
||||
liftIO $ R.removeLink tmpf
|
||||
addSymlink file key Nothing
|
||||
next $ cleanup key =<< inAnnex key
|
||||
, do
|
||||
liftIO $ moveFile tmpf (fromRawFilePath file)
|
||||
liftIO $ moveFile tmpf file
|
||||
next $ return True
|
||||
)
|
||||
fixuppointer s key =
|
||||
|
|
|
@ -613,7 +613,7 @@ honorDead dead
|
|||
badContent :: Key -> Annex String
|
||||
badContent key = do
|
||||
dest <- moveBad key
|
||||
return $ "moved to " ++ dest
|
||||
return $ "moved to " ++ fromRawFilePath dest
|
||||
|
||||
{- Bad content is dropped from the remote. We have downloaded a copy
|
||||
- from the remote to a temp file already (in some cases, it's just a
|
||||
|
@ -633,7 +633,7 @@ badContentRemote remote localcopy key = do
|
|||
ifM (isSymbolicLink <$> R.getSymbolicLinkStatus localcopy)
|
||||
( copyFileExternal CopyTimeStamps (fromRawFilePath localcopy) destbad'
|
||||
, do
|
||||
moveFile (fromRawFilePath localcopy) destbad'
|
||||
moveFile localcopy destbad
|
||||
return True
|
||||
)
|
||||
)
|
||||
|
|
|
@ -207,12 +207,8 @@ startLocal o addunlockedmatcher largematcher mode (srcfile, destfile) =
|
|||
(fromRawFilePath destfile)
|
||||
return $ removeWhenExistsWith R.removeLink destfile
|
||||
else do
|
||||
moveFile
|
||||
(fromRawFilePath srcfile)
|
||||
(fromRawFilePath destfile)
|
||||
return $ moveFile
|
||||
(fromRawFilePath destfile)
|
||||
(fromRawFilePath srcfile)
|
||||
moveFile srcfile destfile
|
||||
return $ moveFile destfile srcfile
|
||||
-- Make sure that the dest file has its write permissions
|
||||
-- removed; the src file normally already did, but may
|
||||
-- have imported it from a filesystem that does not allow
|
||||
|
|
|
@ -38,7 +38,7 @@ perform file key = do
|
|||
ok <- getViaTmp RetrievalAllKeysSecure DefaultVerify key (AssociatedFile Nothing) $ \dest -> unVerified $
|
||||
if dest /= file
|
||||
then liftIO $ catchBoolIO $ do
|
||||
moveFile (fromRawFilePath file) (fromRawFilePath dest)
|
||||
moveFile file dest
|
||||
return True
|
||||
else return True
|
||||
if ok
|
||||
|
|
|
@ -95,7 +95,7 @@ explodePacks r = go =<< listPackFiles r
|
|||
let dest = objectsDir r P.</> f
|
||||
createDirectoryIfMissing True
|
||||
(fromRawFilePath (parentDir dest))
|
||||
moveFile objfile (fromRawFilePath dest)
|
||||
moveFile (toRawFilePath objfile) dest
|
||||
forM_ packs $ \packfile -> do
|
||||
let f = toRawFilePath packfile
|
||||
removeWhenExistsWith R.removeLink f
|
||||
|
|
|
@ -407,7 +407,7 @@ retrieveExportWithContentIdentifierM borgrepo loc _ dest gk _ = do
|
|||
forceSuccessProcess p pid
|
||||
-- Filepaths in borg archives are relative, so it's ok to
|
||||
-- combine with </>
|
||||
moveFile (fromRawFilePath othertmp </> fromRawFilePath archivefile) dest
|
||||
moveFile (othertmp P.</> archivefile) (toRawFilePath dest)
|
||||
removeDirectoryRecursive (fromRawFilePath othertmp)
|
||||
|
||||
(archivename, archivefile) = extractImportLocation loc
|
||||
|
|
|
@ -403,7 +403,7 @@ writeRetrievedContent
|
|||
writeRetrievedContent dest enc encc mh mp content miv = case (enc, mh, content) of
|
||||
(Nothing, Nothing, FileContent f)
|
||||
| f == dest -> noop
|
||||
| otherwise -> liftIO $ moveFile f dest
|
||||
| otherwise -> liftIO $ moveFile (toRawFilePath f) (toRawFilePath dest)
|
||||
(Just (cipher, _), _, ByteContent b) -> do
|
||||
cmd <- gpgCmd <$> Annex.getGitConfig
|
||||
decrypt cmd encc cipher (feedBytes b) $
|
||||
|
|
|
@ -226,7 +226,7 @@ store o k src meterupdate = storeGeneric o meterupdate basedest populatedest
|
|||
then do
|
||||
rename src dest
|
||||
return True
|
||||
else createLinkOrCopy src dest
|
||||
else createLinkOrCopy (toRawFilePath src) (toRawFilePath dest)
|
||||
{- If the key being sent is encrypted or chunked, the file
|
||||
- containing its content is a temp file, and so can be
|
||||
- renamed into place. Otherwise, the file is the annexed
|
||||
|
@ -315,7 +315,7 @@ storeExportM o src _k loc meterupdate =
|
|||
storeGeneric o meterupdate basedest populatedest
|
||||
where
|
||||
basedest = fromRawFilePath (fromExportLocation loc)
|
||||
populatedest = liftIO . createLinkOrCopy src
|
||||
populatedest = liftIO . createLinkOrCopy (toRawFilePath src) . toRawFilePath
|
||||
|
||||
retrieveExportM :: RsyncOpts -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Verification
|
||||
retrieveExportM o k loc dest p =
|
||||
|
|
|
@ -14,6 +14,7 @@ module Utility.CopyFile (
|
|||
|
||||
import Common
|
||||
import qualified BuildInfo
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
data CopyMetaData
|
||||
-- Copy timestamps when possible, but no other metadata, and
|
||||
|
@ -86,10 +87,10 @@ copyCoW meta src dest
|
|||
|
||||
{- Create a hard link if the filesystem allows it, and fall back to copying
|
||||
- the file. -}
|
||||
createLinkOrCopy :: FilePath -> FilePath -> IO Bool
|
||||
createLinkOrCopy :: RawFilePath -> RawFilePath -> IO Bool
|
||||
createLinkOrCopy src dest = go `catchIO` const fallback
|
||||
where
|
||||
go = do
|
||||
createLink src dest
|
||||
R.createLink src dest
|
||||
return True
|
||||
fallback = copyFileExternal CopyAllMetaData src dest
|
||||
fallback = copyFileExternal CopyAllMetaData (fromRawFilePath src) (fromRawFilePath dest)
|
||||
|
|
|
@ -14,8 +14,7 @@ module Utility.MoveFile (
|
|||
) where
|
||||
|
||||
import Control.Monad
|
||||
import System.FilePath
|
||||
import System.PosixCompat.Files hiding (removeLink)
|
||||
import System.PosixCompat.Files (isDirectory)
|
||||
import System.IO.Error
|
||||
import Prelude
|
||||
|
||||
|
@ -28,17 +27,19 @@ import Utility.SystemDirectory
|
|||
import Utility.Tmp
|
||||
import Utility.Exception
|
||||
import Utility.Monad
|
||||
import Utility.FileSystemEncoding
|
||||
import qualified Utility.RawFilePath as R
|
||||
|
||||
{- Moves one filename to another.
|
||||
- First tries a rename, but falls back to moving across devices if needed. -}
|
||||
moveFile :: FilePath -> FilePath -> IO ()
|
||||
moveFile src dest = tryIO (rename src dest) >>= onrename
|
||||
moveFile :: RawFilePath -> RawFilePath -> IO ()
|
||||
moveFile src dest = tryIO (R.rename src dest) >>= onrename
|
||||
where
|
||||
onrename (Right _) = noop
|
||||
onrename (Left e)
|
||||
| isPermissionError e = rethrow
|
||||
| isDoesNotExistError e = rethrow
|
||||
| otherwise = viaTmp mv dest ()
|
||||
| otherwise = viaTmp mv (fromRawFilePath dest) ()
|
||||
where
|
||||
rethrow = throwM e
|
||||
|
||||
|
@ -46,16 +47,20 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
|
|||
-- copyFile is likely not as optimised as
|
||||
-- the mv command, so we'll use the command.
|
||||
--
|
||||
-- But, while Windows has a "mv", it does not seem very
|
||||
-- reliable, so use copyFile there.
|
||||
-- But, while Windows has a "mv", it does not
|
||||
-- seem very reliable, so use copyFile there.
|
||||
#ifndef mingw32_HOST_OS
|
||||
-- If dest is a directory, mv would move the file
|
||||
-- into it, which is not desired.
|
||||
whenM (isdir dest) rethrow
|
||||
ok <- boolSystem "mv" [Param "-f", Param src, Param tmp]
|
||||
ok <- boolSystem "mv"
|
||||
[ Param "-f"
|
||||
, Param (fromRawFilePath src)
|
||||
, Param tmp
|
||||
]
|
||||
let e' = e
|
||||
#else
|
||||
r <- tryIO $ copyFile src tmp
|
||||
r <- tryIO $ copyFile (fromRawFilePath src) tmp
|
||||
let (ok, e') = case r of
|
||||
Left err -> (False, err)
|
||||
Right _ -> (True, e)
|
||||
|
@ -67,7 +72,7 @@ moveFile src dest = tryIO (rename src dest) >>= onrename
|
|||
|
||||
#ifndef mingw32_HOST_OS
|
||||
isdir f = do
|
||||
r <- tryIO $ getFileStatus f
|
||||
r <- tryIO $ R.getFileStatus f
|
||||
case r of
|
||||
(Left _) -> return False
|
||||
(Right s) -> return $ isDirectory s
|
||||
|
|
|
@ -27,6 +27,7 @@ module Utility.RawFilePath (
|
|||
getCurrentDirectory,
|
||||
createDirectory,
|
||||
setFileMode,
|
||||
rename,
|
||||
) where
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
|
@ -87,4 +88,7 @@ createDirectory = D.createDirectory . fromRawFilePath
|
|||
|
||||
setFileMode :: RawFilePath -> FileMode -> IO ()
|
||||
setFileMode = F.setFileMode . fromRawFilePath
|
||||
|
||||
rename :: RawFilePath -> RawFilePath -> IO ()
|
||||
rename a b = F.rename (fromRawFilePath a) (fromRawFilePath b)
|
||||
#endif
|
||||
|
|
Loading…
Reference in a new issue