RawFilePath conversion for replaceFile
Sponsored-by: Joshua Antonishen
This commit is contained in:
parent
af3b9cbd36
commit
90cd3aad37
13 changed files with 28 additions and 29 deletions
|
@ -236,8 +236,9 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
| otherwise = pure f
|
||||
|
||||
makesymlink key dest = do
|
||||
l <- calcRepo $ gitAnnexLink (toRawFilePath dest) key
|
||||
unless inoverlay $ replacewithsymlink dest l
|
||||
let rdest = toRawFilePath dest
|
||||
l <- calcRepo $ gitAnnexLink rdest key
|
||||
unless inoverlay $ replacewithsymlink rdest l
|
||||
dest' <- toRawFilePath <$> stagefile dest
|
||||
stageSymlink dest' =<< hashSymlink l
|
||||
|
||||
|
@ -265,7 +266,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
|
||||
let replacefile isexecutable = case selectwant' (LsFiles.unmergedSha u) of
|
||||
Nothing -> noop
|
||||
Just sha -> replaceWorkTreeFile item $ \tmp -> do
|
||||
Just sha -> replaceWorkTreeFile (toRawFilePath item) $ \tmp -> do
|
||||
c <- catObject sha
|
||||
liftIO $ L.writeFile (decodeBS tmp) c
|
||||
when isexecutable $
|
||||
|
@ -280,7 +281,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do
|
|||
Nothing -> noop
|
||||
Just sha -> do
|
||||
link <- catSymLinkTarget sha
|
||||
replacewithsymlink item link
|
||||
replacewithsymlink (toRawFilePath item) link
|
||||
(Just TreeFile, Just TreeSymlink) -> replacefile False
|
||||
(Just TreeExecutable, Just TreeSymlink) -> replacefile True
|
||||
_ -> ifM (liftIO $ doesDirectoryExist item)
|
||||
|
|
|
@ -581,7 +581,7 @@ linkToAnnex key src srcic = ifM (checkSecureHashes' key)
|
|||
-}
|
||||
linkFromAnnex :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult
|
||||
linkFromAnnex key dest destmode =
|
||||
replaceFile' (const noop) (fromRawFilePath dest) (== LinkAnnexOk) $ \tmp ->
|
||||
replaceFile' (const noop) dest (== LinkAnnexOk) $ \tmp ->
|
||||
linkFromAnnex' key tmp destmode
|
||||
|
||||
{- This is only safe to use when dest is not a worktree file. -}
|
||||
|
@ -1076,7 +1076,7 @@ writeContentRetentionTimestamp key rt t = do
|
|||
modifyContentDirWhenExists lckfile $ bracket (lock lckfile) unlock $ \_ ->
|
||||
readContentRetentionTimestamp rt >>= \case
|
||||
Just ts | ts >= t -> return ()
|
||||
_ -> replaceFile (const noop) (fromRawFilePath rt) $ \tmp ->
|
||||
_ -> replaceFile (const noop) rt $ \tmp ->
|
||||
liftIO $ writeFile (fromRawFilePath tmp) $ show t
|
||||
where
|
||||
lock = takeExclusiveLock
|
||||
|
|
|
@ -34,10 +34,9 @@ populatePointerFile :: Restage -> Key -> RawFilePath -> RawFilePath -> Annex (Ma
|
|||
populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f)
|
||||
where
|
||||
go (Just k') | k == k' = do
|
||||
let f' = fromRawFilePath f
|
||||
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f
|
||||
liftIO $ removeWhenExistsWith R.removeLink f
|
||||
(ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do
|
||||
(ic, populated) <- replaceWorkTreeFile f $ \tmp -> do
|
||||
ok <- linkOrCopy k obj tmp destmode >>= \case
|
||||
Just _ -> thawContent tmp >> return True
|
||||
Nothing -> liftIO (writePointerFile tmp k destmode) >> return False
|
||||
|
@ -58,7 +57,7 @@ depopulatePointerFile key file = do
|
|||
let mode = fmap fileMode st
|
||||
secureErase file
|
||||
liftIO $ removeWhenExistsWith R.removeLink file
|
||||
ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
ic <- replaceWorkTreeFile file $ \tmp -> do
|
||||
liftIO $ writePointerFile tmp key mode
|
||||
#if ! defined(mingw32_HOST_OS)
|
||||
-- Don't advance mtime; this avoids unnecessary re-smudging
|
||||
|
|
|
@ -309,7 +309,7 @@ restoreFile file key e = do
|
|||
makeLink :: RawFilePath -> Key -> Maybe InodeCache -> Annex LinkTarget
|
||||
makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
|
||||
l <- calcRepo $ gitAnnexLink file key
|
||||
replaceWorkTreeFile file' $ makeAnnexLink l
|
||||
replaceWorkTreeFile file $ makeAnnexLink l
|
||||
|
||||
-- touch symlink to have same time as the original file,
|
||||
-- as provided in the InodeCache
|
||||
|
@ -318,8 +318,6 @@ makeLink file key mcache = flip catchNonAsync (restoreFile file key) $ do
|
|||
Nothing -> noop
|
||||
|
||||
return l
|
||||
where
|
||||
file' = fromRawFilePath file
|
||||
|
||||
{- Creates the symlink to the annexed content, and stages it in git. -}
|
||||
addSymlink :: RawFilePath -> Key -> Maybe InodeCache -> Annex ()
|
||||
|
|
|
@ -24,17 +24,17 @@ import Utility.Directory.Create
|
|||
import qualified System.FilePath.ByteString as P
|
||||
|
||||
{- replaceFile on a file located inside the gitAnnexDir. -}
|
||||
replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceGitAnnexDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceGitAnnexDirFile = replaceFile createAnnexDirectory
|
||||
|
||||
{- replaceFile on a file located inside the .git directory. -}
|
||||
replaceGitDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceGitDirFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceGitDirFile = replaceFile $ \dir -> do
|
||||
top <- fromRepo localGitDir
|
||||
liftIO $ createDirectoryUnder [top] dir
|
||||
|
||||
{- replaceFile on a worktree file. -}
|
||||
replaceWorkTreeFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceWorkTreeFile :: RawFilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceWorkTreeFile = replaceFile createWorkTreeDirectory
|
||||
|
||||
{- Replaces a possibly already existing file with a new version,
|
||||
|
@ -52,17 +52,17 @@ replaceWorkTreeFile = replaceFile createWorkTreeDirectory
|
|||
- The createdirectory action is only run when moving the file into place
|
||||
- fails, and can create any parent directory structure needed.
|
||||
-}
|
||||
replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceFile :: (RawFilePath -> Annex ()) -> RawFilePath -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action
|
||||
|
||||
replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceFile' :: (RawFilePath -> Annex ()) -> RawFilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a
|
||||
replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do
|
||||
let basetmp = relatedTemplate' (toRawFilePath file)
|
||||
let basetmp = relatedTemplate' file
|
||||
withTmpDirIn (fromRawFilePath othertmpdir) (toOsPath basetmp) $ \tmpdir -> do
|
||||
let tmpfile = toRawFilePath tmpdir P.</> basetmp
|
||||
r <- action tmpfile
|
||||
when (checkres r) $
|
||||
replaceFileFrom tmpfile (toRawFilePath file) createdirectory
|
||||
replaceFileFrom tmpfile file createdirectory
|
||||
return r
|
||||
|
||||
replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex ()
|
||||
|
|
|
@ -289,7 +289,7 @@ onAddSymlink' linktarget mk file filestatus = go mk
|
|||
if linktarget == Just link
|
||||
then ensurestaged (Just link) =<< getDaemonStatus
|
||||
else do
|
||||
liftAnnex $ replaceWorkTreeFile file $
|
||||
liftAnnex $ replaceWorkTreeFile (toRawFilePath file) $
|
||||
makeAnnexLink link
|
||||
addLink file link (Just key)
|
||||
-- other symlink, not git-annex
|
||||
|
|
|
@ -72,7 +72,7 @@ start fixwhat si file key = do
|
|||
|
||||
breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform
|
||||
breakHardLink file key obj = do
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
replaceWorkTreeFile file $ \tmp -> do
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||
unlessM (checkedCopyFile key obj tmp mode) $
|
||||
giveup "unable to break hard link"
|
||||
|
@ -83,7 +83,7 @@ breakHardLink file key obj = do
|
|||
|
||||
makeHardLink :: RawFilePath -> Key -> CommandPerform
|
||||
makeHardLink file key = do
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
replaceWorkTreeFile file $ \tmp -> do
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||
linkFromAnnex' key tmp mode >>= \case
|
||||
LinkAnnexFailed -> giveup "unable to make hard link"
|
||||
|
@ -97,7 +97,7 @@ fixSymlink file link = do
|
|||
mtime <- liftIO $ catchMaybeIO $ Posix.modificationTimeHiRes
|
||||
<$> R.getSymbolicLinkStatus file
|
||||
#endif
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do
|
||||
replaceWorkTreeFile file $ \tmpfile -> do
|
||||
liftIO $ R.createSymbolicLink link tmpfile
|
||||
#if ! defined(mingw32_HOST_OS)
|
||||
liftIO $ maybe noop (\t -> touch tmpfile t False) mtime
|
||||
|
|
|
@ -418,7 +418,7 @@ verifyWorkTree key file = do
|
|||
case mk of
|
||||
Just k | k == key -> whenM (inAnnex key) $ do
|
||||
showNote "fixing worktree content"
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
replaceWorkTreeFile file $ \tmp -> do
|
||||
mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file
|
||||
ifM (annexThin <$> Annex.getGitConfig)
|
||||
( void $ linkFromAnnex' key tmp mode
|
||||
|
|
|
@ -78,7 +78,7 @@ perform file key = do
|
|||
breakhardlink obj = whenM (catchBoolIO $ (> 1) . linkCount <$> liftIO (R.getFileStatus obj)) $ do
|
||||
mfc <- withTSDelta (liftIO . genInodeCache file)
|
||||
unlessM (sameInodeCache obj (maybeToList mfc)) $ do
|
||||
modifyContentDir obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do
|
||||
modifyContentDir obj $ replaceGitAnnexDirFile obj $ \tmp -> do
|
||||
unlessM (checkedCopyFile key obj tmp Nothing) $
|
||||
giveup "unable to lock file"
|
||||
Database.Keys.storeInodeCaches key [obj]
|
||||
|
|
|
@ -104,7 +104,7 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file)
|
|||
st <- liftIO $ R.getFileStatus file
|
||||
when (linkCount st > 1) $ do
|
||||
freezeContent oldobj
|
||||
replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do
|
||||
replaceWorkTreeFile file $ \tmp -> do
|
||||
unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $
|
||||
giveup "can't lock old key"
|
||||
thawContent tmp
|
||||
|
|
|
@ -51,7 +51,7 @@ start si file key = ifM (isJust <$> isAnnexLink file)
|
|||
perform :: RawFilePath -> Key -> CommandPerform
|
||||
perform dest key = do
|
||||
destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus dest
|
||||
destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do
|
||||
destic <- replaceWorkTreeFile dest $ \tmp -> do
|
||||
ifM (inAnnex key)
|
||||
( do
|
||||
r <- linkFromAnnex' key tmp destmode
|
||||
|
|
|
@ -48,7 +48,7 @@ writeLogFile f c = createDirWhenNeeded f $ viaTmp writelog (toOsPath f) c
|
|||
withLogHandle :: RawFilePath -> (Handle -> Annex a) -> Annex a
|
||||
withLogHandle f a = do
|
||||
createAnnexDirectory (parentDir f)
|
||||
replaceGitAnnexDirFile (fromRawFilePath f) $ \tmp ->
|
||||
replaceGitAnnexDirFile f $ \tmp ->
|
||||
bracket (setup tmp) cleanup a
|
||||
where
|
||||
setup tmp = do
|
||||
|
|
|
@ -19,7 +19,8 @@ status.
|
|||
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
|
||||
bytestring. Also readFileStrict should be replaced with Utility.FileIO.readFile'
|
||||
bytestring. Also readFileStrict should be replaced with
|
||||
Utility.FileIO.readFile'
|
||||
Note that the String versions can do newline translation, which has to be
|
||||
handled when converting to the Utility.FileIO ones.
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue