summaryrefslogtreecommitdiff
path: root/Utility/Directory.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-28 15:26:27 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-28 16:17:55 -0400
commit6869e6023e21698038da7e4a858cbaf6f7b7bbed (patch)
treed6ae8aecbc2b8f65b36f3e0e1dba740d1308bb2e /Utility/Directory.hs
parentff2d9c828379ce29e5feb6ac770996be04ac072f (diff)
support .git/annex on a different disk than the rest of the repo
The only fully supported thing is to have the main repository on one disk, and .git/annex on another. Only commands that move data in/out of the annex will need to copy it across devices. There is only partial support for putting arbitrary subdirectories of .git/annex on different devices. For one thing, but this can require more copies to be done. For example, when .git/annex/tmp is on one device, and .git/annex/journal on another, every journal write involves a call to mv(1). Also, there are a few places that make hard links between various subdirectories of .git/annex with createLink, that are not handled. In the common case without cross-device, the new moveFile is actually faster than renameFile, avoiding an unncessary stat to check that a file (not a directory) is being moved. Of course if a cross-device move is needed, it is as slow as mv(1) of the data.
Diffstat (limited to 'Utility/Directory.hs')
-rw-r--r--Utility/Directory.hs51
1 files changed, 51 insertions, 0 deletions
diff --git a/Utility/Directory.hs b/Utility/Directory.hs
new file mode 100644
index 000000000..7f8822fca
--- /dev/null
+++ b/Utility/Directory.hs
@@ -0,0 +1,51 @@
+{- directory manipulation
+ -
+ - Copyright 2011 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Utility.Directory where
+
+import System.IO.Error
+import System.Posix.Files
+import System.Directory
+import Control.Exception (throw)
+
+import Utility.SafeCommand
+import Utility.Conditional
+import Utility.TempFile
+
+{- Moves one filename to another.
+ - First tries a rename, but falls back to moving across devices if needed. -}
+moveFile :: FilePath -> FilePath -> IO ()
+moveFile src dest = try (rename src dest) >>= onrename
+ where
+ onrename (Right _) = return ()
+ onrename (Left e)
+ | isPermissionError e = rethrow
+ | isDoesNotExistError e = rethrow
+ | otherwise = do
+ -- copyFile is likely not as optimised as
+ -- the mv command, so we'll use the latter.
+ -- But, mv will move into a directory if
+ -- dest is one, which is not desired.
+ whenM (isdir dest) rethrow
+ viaTmp mv dest undefined
+ where
+ rethrow = throw e
+ mv tmp _ = do
+ ok <- boolSystem "mv" [Param "-f",
+ Param src, Param tmp]
+ if ok
+ then return ()
+ else do
+ -- delete any partial
+ _ <- try $
+ removeFile tmp
+ rethrow
+ isdir f = do
+ r <- try (getFileStatus f)
+ case r of
+ (Left _) -> return False
+ (Right s) -> return $ isDirectory s