convert replaceFile to createDirectoryUnder

Since it was used on both worktree and .git/annex files, split into
multiple functions.

In passing, this also improves permissions of created directories in
.git/annex, using createAnnexDirectory on those.
This commit is contained in:
Joey Hess 2020-03-06 11:31:01 -04:00
parent b6c14a84ab
commit eaa49ab53d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
12 changed files with 53 additions and 26 deletions

View file

@ -1,21 +1,48 @@
{- git-annex file replacing
-
- Copyright 2013-2015 Joey Hess <id@joeyh.name>
- Copyright 2013-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Annex.ReplaceFile where
module Annex.ReplaceFile (
replaceGitAnnexDirFile,
replaceGitDirFile,
replaceWorkTreeFile,
replaceFile,
) where
import Annex.Common
import Annex.Tmp
import Annex.Perms
import Git
import Utility.Tmp.Dir
#ifndef mingw32_HOST_OS
import Utility.Path.Max
#endif
{- replaceFile on a file located inside the gitAnnexDir. -}
replaceGitAnnexDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a
replaceGitAnnexDirFile = replaceFile createAnnexDirectory
{- replaceFile on a file located inside the .git directory. -}
replaceGitDirFile :: FilePath -> (FilePath -> Annex a) -> Annex a
replaceGitDirFile = replaceFile $ \dir -> do
top <- fromRawFilePath <$> fromRepo localGitDir
liftIO $ createDirectoryUnder top dir
{- replaceFile on a worktree file. -}
replaceWorkTreeFile :: FilePath -> (FilePath -> Annex a) -> Annex a
replaceWorkTreeFile = replaceFile $ \dir ->
fromRepo repoWorkTree >>= liftIO . \case
Just wt -> createDirectoryUnder (fromRawFilePath wt) dir
-- Should never happen, but let the file move be what
-- throws an exception as that would more clearly indicate
-- the problem.
Nothing -> noop
{- Replaces a possibly already existing file with a new version,
- atomically, by running an action.
-
@ -27,9 +54,12 @@ import Utility.Path.Max
- will be deleted, and the existing file will be preserved.
-
- Throws an IO exception when it was unable to replace the file.
-
- The createdirectory action is only run when moving the file into place
- fails, and can create any parent directory structure needed.
-}
replaceFile :: FilePath -> (FilePath -> Annex a) -> Annex a
replaceFile file action = withOtherTmp $ \othertmpdir -> do
replaceFile :: (FilePath -> Annex ()) -> FilePath -> (FilePath -> Annex a) -> Annex a
replaceFile createdirectory file action = withOtherTmp $ \othertmpdir -> do
#ifndef mingw32_HOST_OS
-- Use part of the filename as the template for the temp
-- directory. This does not need to be unique, but it
@ -44,13 +74,13 @@ replaceFile file action = withOtherTmp $ \othertmpdir -> do
withTmpDirIn othertmpdir basetmp $ \tmpdir -> do
let tmpfile = tmpdir </> basetmp
r <- action tmpfile
liftIO $ replaceFileFrom tmpfile file
replaceFileFrom tmpfile file createdirectory
return r
replaceFileFrom :: FilePath -> FilePath -> IO ()
replaceFileFrom src dest = go `catchIO` fallback
replaceFileFrom :: FilePath -> FilePath -> (FilePath -> Annex ()) -> Annex ()
replaceFileFrom src dest createdirectory = go `catchIO` fallback
where
go = moveFile src dest
go = liftIO $ moveFile src dest
fallback _ = do
createDirectoryIfMissing True $ parentDir dest
createdirectory (parentDir dest)
go