diff options
Diffstat (limited to 'Command')
-rw-r--r-- | Command/Add.hs | 44 |
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 |