From 90cd3aad370302b1547eb11cbccb3c47c2709bbe Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 22 Jan 2025 13:37:26 -0400 Subject: [PATCH] RawFilePath conversion for replaceFile Sponsored-by: Joshua Antonishen --- Annex/AutoMerge.hs | 9 +++++---- Annex/Content.hs | 4 ++-- Annex/Content/PointerFile.hs | 5 ++--- Annex/Ingest.hs | 4 +--- Annex/ReplaceFile.hs | 14 +++++++------- Assistant/Threads/Watcher.hs | 2 +- Command/Fix.hs | 6 +++--- Command/Fsck.hs | 2 +- Command/Lock.hs | 2 +- Command/ReKey.hs | 2 +- Command/Unlock.hs | 2 +- Logs/File.hs | 2 +- doc/todo/RawFilePath_conversion.mdwn | 3 ++- 13 files changed, 28 insertions(+), 29 deletions(-) diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index bb43d0593b..5d90878152 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -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) diff --git a/Annex/Content.hs b/Annex/Content.hs index 40f13e7ea5..5a7a89ff10 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -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 diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index c2acc9ab93..5dc4d0210b 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -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 diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 2a1a6c7aff..ed7479526f 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -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 () diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index c3bb2474af..188b300b88 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -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 () diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 04c5f97b25..37ac9b876e 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -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 diff --git a/Command/Fix.hs b/Command/Fix.hs index 862853a861..eb8f6383e3 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -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 diff --git a/Command/Fsck.hs b/Command/Fsck.hs index e01b3402d5..5924b4d11e 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -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 diff --git a/Command/Lock.hs b/Command/Lock.hs index 7dbcffbbd9..96aebaab23 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -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] diff --git a/Command/ReKey.hs b/Command/ReKey.hs index f092e85a84..a7a547b719 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -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 diff --git a/Command/Unlock.hs b/Command/Unlock.hs index c8faa7532f..e0f7ccb29a 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -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 diff --git a/Logs/File.hs b/Logs/File.hs index 97efb58ec1..f385b06d66 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -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 diff --git a/doc/todo/RawFilePath_conversion.mdwn b/doc/todo/RawFilePath_conversion.mdwn index cef9ffbd7a..e1ca599956 100644 --- a/doc/todo/RawFilePath_conversion.mdwn +++ b/doc/todo/RawFilePath_conversion.mdwn @@ -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.