summaryrefslogtreecommitdiff
path: root/Command
diff options
context:
space:
mode:
Diffstat (limited to 'Command')
-rw-r--r--Command/Add.hs44
1 files changed, 34 insertions, 10 deletions
diff --git a/Command/Add.hs b/Command/Add.hs
index e7d16b6c0..5c7cad044 100644
--- a/Command/Add.hs
+++ b/Command/Add.hs
@@ -9,6 +9,10 @@ module Command.Add where
import Control.Monad.State (liftIO)
import System.Posix.Files
+import System.Directory
+import Control.Exception.Control (handle)
+import Control.Exception.Base (throwIO)
+import Control.Exception.Extensible (IOException)
import Command
import qualified Annex
@@ -20,6 +24,7 @@ import Content
import Messages
import Utility
import Touch
+import Locations
command :: [Command]
command = [repoCommand "add" paramPath seek "add files to annex"]
@@ -46,20 +51,39 @@ perform (file, backend) = do
case k of
Nothing -> stop
Just (key, _) -> do
- moveAnnex key file
+ handle (undo file key) $ moveAnnex key file
next $ cleanup file key
-cleanup :: FilePath -> Key -> CommandCleanup
-cleanup file key = do
- link <- calcGitLink file key
- liftIO $ createSymbolicLink link file
+{- On error, put the file back so it doesn't seem to have vanished.
+ - This can be called before or after the symlink is in place. -}
+undo :: FilePath -> Key -> IOException -> Annex a
+undo file key e = do
+ unlessM (inAnnex key) $ rethrow -- no cleanup to do
+ liftIO $ whenM (doesFileExist file) $ do removeFile file
+ handle tryharder $ fromAnnex key file
+ logStatus key InfoMissing
+ rethrow
+ where
+ rethrow = liftIO $ throwIO e
- logStatus key InfoPresent
+ -- fromAnnex could fail if the file ownership is weird
+ tryharder :: IOException -> Annex ()
+ tryharder _ = do
+ g <- Annex.gitRepo
+ liftIO $ renameFile (gitAnnexLocation g key) file
- -- touch the symlink to have the same mtime as the file it points to
- s <- liftIO $ getFileStatus file
- let mtime = modificationTime s
- liftIO $ touch file (TimeSpec mtime) False
+cleanup :: FilePath -> Key -> CommandCleanup
+cleanup file key = do
+ handle (undo file key) $ do
+ link <- calcGitLink file key
+ liftIO $ createSymbolicLink link file
+ logStatus key InfoPresent
+
+ -- touch the symlink to have the same mtime as the
+ -- file it points to
+ s <- liftIO $ getFileStatus file
+ let mtime = modificationTime s
+ liftIO $ touch file (TimeSpec mtime) False
force <- Annex.getState Annex.force
if force