refactor

diff --git a/Annex/Perms.hs b/Annex/Perms.hs
index d255ce97ee17e7c2fcba0ecc4457d107ea8e7768..fe01d13a2bffdf095745214bcd193402c29224bc 100644 (file)
--- a/Annex/Perms.hs
+++ b/Annex/Perms.hs
@@ -11,6 +11,7 @@ module Annex.Perms (
        setAnnexDirPerm,
        annexFileMode,
        createAnnexDirectory,
+       createWorkTreeDirectory,
        noUmask,
        freezeContent,
        isContentWritePermOk,
@@ -25,6 +26,7 @@ module Annex.Perms (
 
 import Annex.Common
 import Utility.FileMode
+import Git
 import Git.ConfigTypes
 import qualified Annex
 import Config
@@ -77,6 +79,20 @@ createAnnexDirectory dir = do
                liftIO $ createDirectory p
                setAnnexDirPerm p
 
+{- Create a directory in the git work tree, creating any parent
+ - directories up to the top of the work tree.
+ -
+ - Uses default permissions.
+ -}
+createWorkTreeDirectory :: FilePath -> Annex ()
+createWorkTreeDirectory dir = do
+       fromRepo repoWorkTree >>= liftIO . \case
+               Just wt -> createDirectoryUnder (fromRawFilePath wt) dir
+               -- Should never happen, but let whatever tries to write
+               -- to the directory be what throws an exception, as that
+               -- will be clearer than an exception from here.
+               Nothing -> noop
+
 {- Normally, blocks writing to an annexed file, and modifies file
  - permissions to allow reading it.
  -

diff --git a/Annex/ReplaceFile.hs b/Annex/ReplaceFile.hs
index 7fc513b59dd73d8766f38ea357a63e20fa6561e2..ddbbedf96ae1d2da857c1acd9c7b212f33380d25 100644 (file)
--- a/Annex/ReplaceFile.hs
+++ b/Annex/ReplaceFile.hs
@@ -35,13 +35,7 @@ replaceGitDirFile = replaceFile $ \dir -> do
 
 {- 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
+replaceWorkTreeFile = replaceFile createWorkTreeDirectory
 
 {- Replaces a possibly already existing file with a new version, 
  - atomically, by running an action.