refactor

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.
  -

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.