From d9fd205cbb7d5dc5e441bb5dcc139c557b4324bc Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 26 Oct 2023 13:36:49 -0400 Subject: [PATCH] push RawFilePath down into Annex.ReplaceFile Minor optimisation, but a win in every case, except for a couple where it's a wash. Note that replaceFile still takes a FilePath, because it needs to operate on Chars to truncate unicode filenames properly. --- Annex/AutoMerge.hs | 6 +++--- Annex/Content.hs | 2 +- Annex/Content/PointerFile.hs | 16 +++++++--------- Annex/Ingest.hs | 2 +- Annex/ReplaceFile.hs | 14 +++++++------- Assistant/Threads/Watcher.hs | 2 +- Command/Fix.hs | 14 ++++++-------- Command/Fsck.hs | 9 ++++----- Command/Lock.hs | 2 +- Command/ReKey.hs | 5 ++--- Command/Unlock.hs | 6 +++--- Logs/File.hs | 4 ++-- 12 files changed, 38 insertions(+), 44 deletions(-) diff --git a/Annex/AutoMerge.hs b/Annex/AutoMerge.hs index 77afe521c9..bb43d0593b 100644 --- a/Annex/AutoMerge.hs +++ b/Annex/AutoMerge.hs @@ -242,7 +242,7 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do stageSymlink dest' =<< hashSymlink l replacewithsymlink dest link = replaceWorkTreeFile dest $ - makeGitLink link . toRawFilePath + makeGitLink link makepointer key dest destmode = do unless inoverlay $ @@ -267,10 +267,10 @@ resolveMerge' unstagedmap (Just us) them inoverlay u = do Nothing -> noop Just sha -> replaceWorkTreeFile item $ \tmp -> do c <- catObject sha - liftIO $ L.writeFile tmp c + liftIO $ L.writeFile (decodeBS tmp) c when isexecutable $ liftIO $ void $ tryIO $ - modifyFileMode (toRawFilePath tmp) $ + modifyFileMode tmp $ addModes executeModes -- Update the work tree to reflect the graft. diff --git a/Annex/Content.hs b/Annex/Content.hs index b212fcc77a..6a028d901d 100644 --- a/Annex/Content.hs +++ b/Annex/Content.hs @@ -477,7 +477,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 -> - linkFromAnnex' key (toRawFilePath tmp) destmode + linkFromAnnex' key tmp destmode {- This is only safe to use when dest is not a worktree file. -} linkFromAnnex' :: Key -> RawFilePath -> Maybe FileMode -> Annex LinkAnnexResult diff --git a/Annex/Content/PointerFile.hs b/Annex/Content/PointerFile.hs index 7fc4be5327..c2acc9ab93 100644 --- a/Annex/Content/PointerFile.hs +++ b/Annex/Content/PointerFile.hs @@ -38,11 +38,10 @@ populatePointerFile restage k obj f = go =<< liftIO (isPointerFile f) destmode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus f liftIO $ removeWhenExistsWith R.removeLink f (ic, populated) <- replaceWorkTreeFile f' $ \tmp -> do - let tmp' = toRawFilePath tmp - ok <- linkOrCopy k obj tmp' destmode >>= \case - Just _ -> thawContent tmp' >> return True - Nothing -> liftIO (writePointerFile tmp' k destmode) >> return False - ic <- withTSDelta (liftIO . genInodeCache tmp') + ok <- linkOrCopy k obj tmp destmode >>= \case + Just _ -> thawContent tmp >> return True + Nothing -> liftIO (writePointerFile tmp k destmode) >> return False + ic <- withTSDelta (liftIO . genInodeCache tmp) return (ic, ok) maybe noop (restagePointerFile restage f) ic if populated @@ -60,14 +59,13 @@ depopulatePointerFile key file = do secureErase file liftIO $ removeWhenExistsWith R.removeLink file ic <- replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do - let tmp' = toRawFilePath tmp - liftIO $ writePointerFile tmp' key mode + liftIO $ writePointerFile tmp key mode #if ! defined(mingw32_HOST_OS) -- Don't advance mtime; this avoids unnecessary re-smudging -- by git in some cases. liftIO $ maybe noop - (\t -> touch tmp' t False) + (\t -> touch tmp t False) (fmap Posix.modificationTimeHiRes st) #endif - withTSDelta (liftIO . genInodeCache tmp') + withTSDelta (liftIO . genInodeCache tmp) maybe noop (restagePointerFile (Restage True) file) ic diff --git a/Annex/Ingest.hs b/Annex/Ingest.hs index 26a5e388eb..c07c11ef12 100644 --- a/Annex/Ingest.hs +++ b/Annex/Ingest.hs @@ -306,7 +306,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 . toRawFilePath + replaceWorkTreeFile file' $ makeAnnexLink l -- touch symlink to have same time as the original file, -- as provided in the InodeCache diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs index 9f671cb9d6..21735eba14 100644 --- a/Annex/ReplaceFile.hs +++ b/Annex/ReplaceFile.hs @@ -26,17 +26,17 @@ import Utility.Path.Max #endif {- replaceFile on a file located inside the gitAnnexDir. -} -replaceGitAnnexDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceGitAnnexDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitAnnexDirFile = replaceFile createAnnexDirectory {- replaceFile on a file located inside the .git directory. -} -replaceGitDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceGitDirFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceGitDirFile = replaceFile $ \dir -> do top <- fromRepo localGitDir liftIO $ createDirectoryUnder [top] dir {- replaceFile on a worktree file. -} -replaceWorkTreeFile :: FilePath -> (FilePath -> Annex a) -> Annex a +replaceWorkTreeFile :: FilePath -> (RawFilePath -> Annex a) -> Annex a replaceWorkTreeFile = replaceFile createWorkTreeDirectory {- Replaces a possibly already existing file with a new version, @@ -54,10 +54,10 @@ 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 -> (FilePath -> Annex a) -> Annex a +replaceFile :: (RawFilePath -> Annex ()) -> FilePath -> (RawFilePath -> Annex a) -> Annex a replaceFile createdirectory file action = replaceFile' createdirectory file (const True) action -replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (FilePath -> Annex a) -> Annex a +replaceFile' :: (RawFilePath -> Annex ()) -> FilePath -> (a -> Bool) -> (RawFilePath -> Annex a) -> Annex a replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir -> do let othertmpdir' = fromRawFilePath othertmpdir #ifndef mingw32_HOST_OS @@ -72,10 +72,10 @@ replaceFile' createdirectory file checkres action = withOtherTmp $ \othertmpdir let basetmp = "t" #endif withTmpDirIn othertmpdir' basetmp $ \tmpdir -> do - let tmpfile = tmpdir basetmp + let tmpfile = toRawFilePath (tmpdir basetmp) r <- action tmpfile when (checkres r) $ - replaceFileFrom (toRawFilePath tmpfile) (toRawFilePath file) createdirectory + replaceFileFrom tmpfile (toRawFilePath file) createdirectory return r replaceFileFrom :: RawFilePath -> RawFilePath -> (RawFilePath -> Annex ()) -> Annex () diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs index 1f5ebf80a0..2df29ce76c 100644 --- a/Assistant/Threads/Watcher.hs +++ b/Assistant/Threads/Watcher.hs @@ -293,7 +293,7 @@ onAddSymlink' linktarget mk file filestatus = go mk then ensurestaged (Just link) =<< getDaemonStatus else do liftAnnex $ replaceWorkTreeFile file $ - makeAnnexLink link . toRawFilePath + makeAnnexLink link addLink file link (Just key) -- other symlink, not git-annex go Nothing = ensurestaged linktarget =<< getDaemonStatus diff --git a/Command/Fix.hs b/Command/Fix.hs index 28c8cfa9be..6ca5f5b2b7 100644 --- a/Command/Fix.hs +++ b/Command/Fix.hs @@ -73,12 +73,11 @@ start fixwhat si file key = do breakHardLink :: RawFilePath -> Key -> RawFilePath -> CommandPerform breakHardLink file key obj = do replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do - let tmp' = toRawFilePath tmp mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file - unlessM (checkedCopyFile key obj tmp' mode) $ + unlessM (checkedCopyFile key obj tmp mode) $ giveup "unable to break hard link" - thawContent tmp' - Database.Keys.storeInodeCaches key [tmp'] + thawContent tmp + Database.Keys.storeInodeCaches key [tmp] modifyContentDir obj $ freezeContent obj next $ return True @@ -86,7 +85,7 @@ makeHardLink :: RawFilePath -> Key -> CommandPerform makeHardLink file key = do replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file - linkFromAnnex' key (toRawFilePath tmp) mode >>= \case + linkFromAnnex' key tmp mode >>= \case LinkAnnexFailed -> giveup "unable to make hard link" _ -> noop next $ return True @@ -99,10 +98,9 @@ fixSymlink file link = do <$> R.getSymbolicLinkStatus file #endif replaceWorkTreeFile (fromRawFilePath file) $ \tmpfile -> do - let tmpfile' = toRawFilePath tmpfile - liftIO $ R.createSymbolicLink link tmpfile' + liftIO $ R.createSymbolicLink link tmpfile #if ! defined(mingw32_HOST_OS) - liftIO $ maybe noop (\t -> touch tmpfile' t False) mtime + liftIO $ maybe noop (\t -> touch tmpfile t False) mtime #endif stageSymlink file =<< hashSymlink link next $ return True diff --git a/Command/Fsck.hs b/Command/Fsck.hs index b25e49b73e..748f77ab01 100644 --- a/Command/Fsck.hs +++ b/Command/Fsck.hs @@ -417,16 +417,15 @@ verifyWorkTree key file = do Just k | k == key -> whenM (inAnnex key) $ do showNote "fixing worktree content" replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do - let tmp' = toRawFilePath tmp mode <- liftIO $ catchMaybeIO $ fileMode <$> R.getFileStatus file ifM (annexThin <$> Annex.getGitConfig) - ( void $ linkFromAnnex' key tmp' mode + ( void $ linkFromAnnex' key tmp mode , do obj <- calcRepo (gitAnnexLocation key) - void $ checkedCopyFile key obj tmp' mode - thawContent tmp' + void $ checkedCopyFile key obj tmp mode + thawContent tmp ) - Database.Keys.storeInodeCaches key [tmp'] + Database.Keys.storeInodeCaches key [tmp] _ -> return () return True diff --git a/Command/Lock.hs b/Command/Lock.hs index d547a07f93..7aace76c9b 100644 --- a/Command/Lock.hs +++ b/Command/Lock.hs @@ -79,7 +79,7 @@ perform file key = do mfc <- withTSDelta (liftIO . genInodeCache file) unlessM (sameInodeCache obj (maybeToList mfc)) $ do modifyContentDir obj $ replaceGitAnnexDirFile (fromRawFilePath obj) $ \tmp -> do - unlessM (checkedCopyFile key obj (toRawFilePath tmp) Nothing) $ + 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 5958f48ac5..0b9d94e31b 100644 --- a/Command/ReKey.hs +++ b/Command/ReKey.hs @@ -111,10 +111,9 @@ linkKey file oldkey newkey = ifM (isJust <$> isAnnexLink file) when (linkCount st > 1) $ do freezeContent oldobj replaceWorkTreeFile (fromRawFilePath file) $ \tmp -> do - let tmp' = toRawFilePath tmp - unlessM (checkedCopyFile oldkey oldobj tmp' Nothing) $ + unlessM (checkedCopyFile oldkey oldobj tmp Nothing) $ giveup "can't lock old key" - thawContent tmp' + thawContent tmp ic <- withTSDelta (liftIO . genInodeCache file) case v of Left e -> do diff --git a/Command/Unlock.hs b/Command/Unlock.hs index c0c79a7a6a..25e4d9aa04 100644 --- a/Command/Unlock.hs +++ b/Command/Unlock.hs @@ -54,14 +54,14 @@ perform dest key = do destic <- replaceWorkTreeFile (fromRawFilePath dest) $ \tmp -> do ifM (inAnnex key) ( do - r <- linkFromAnnex' key (toRawFilePath tmp) destmode + r <- linkFromAnnex' key tmp destmode case r of LinkAnnexOk -> return () LinkAnnexNoop -> return () LinkAnnexFailed -> giveup "unlock failed" - , liftIO $ writePointerFile (toRawFilePath tmp) key destmode + , liftIO $ writePointerFile tmp key destmode ) - withTSDelta (liftIO . genInodeCache (toRawFilePath tmp)) + withTSDelta (liftIO . genInodeCache tmp) next $ cleanup dest destic key destmode cleanup :: RawFilePath -> Maybe InodeCache -> Key -> Maybe FileMode -> CommandCleanup diff --git a/Logs/File.hs b/Logs/File.hs index 56b0c90dda..94b2992238 100644 --- a/Logs/File.hs +++ b/Logs/File.hs @@ -47,8 +47,8 @@ withLogHandle f a = do bracket (setup tmp) cleanup a where setup tmp = do - setAnnexFilePerm (toRawFilePath tmp) - liftIO $ openFile tmp WriteMode + setAnnexFilePerm tmp + liftIO $ openFile (fromRawFilePath tmp) WriteMode cleanup h = liftIO $ hClose h -- | Appends a line to a log file, first locking it to prevent