summaryrefslogtreecommitdiff
path: root/Command/Move.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-11-09 16:54:18 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-11-09 16:54:18 -0400
commit8ce7e73f74e95276472d18816b7c6a60bab25abb (patch)
treef4a29907c46af2735411fe9fcbeca0f9c3149cab /Command/Move.hs
parent58563c5b1aa995ea3ce72cddaa1f02d2ea792c2d (diff)
reorg to allow taking content lock
The lock will only persist during the perform stage, so the content must be removed from the annex then, rather than in the cleanup stage. (No lock is actually taken yet.)
Diffstat (limited to 'Command/Move.hs')
-rw-r--r--Command/Move.hs43
1 files changed, 26 insertions, 17 deletions
diff --git a/Command/Move.hs b/Command/Move.hs
index 5a3ea7172..e955de827 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -68,7 +68,7 @@ toStart dest move file = isAnnexed file $ \(key, _) -> do
showMoveAction move file
next $ toPerform dest move key
toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
-toPerform dest move key = do
+toPerform dest move key = moveLock move key $ do
-- Checking the remote is expensive, so not done in the start step.
-- In fast mode, location tracking is assumed to be correct,
-- and an explicit check is not done, when copying. When moving,
@@ -88,18 +88,20 @@ toPerform dest move key = do
showAction $ "to " ++ Remote.name dest
ok <- Remote.storeKey dest key
if ok
- then next $ toCleanup dest move key
+ then finish
else do
when fastcheck $
warning "This could have failed because --fast is enabled."
stop
- Right True -> next $ toCleanup dest move key
-toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
-toCleanup dest move key = do
- Remote.remoteHasKey dest key True
- if move
- then Command.Drop.cleanupLocal key
- else return True
+ Right True -> finish
+ where
+ finish = do
+ Remote.remoteHasKey dest key True
+ if move
+ then do
+ whenM (inAnnex key) $ removeAnnex key
+ next $ Command.Drop.cleanupLocal key
+ else next $ return True
{- Moves (or copies) the content of an annexed file from a remote
- to the current repository.
@@ -117,16 +119,23 @@ fromStart src move file = isAnnexed file $ \(key, _) -> do
showMoveAction move file
next $ fromPerform src move key
fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform
-fromPerform src move key = do
+fromPerform src move key = moveLock move key $ do
ishere <- inAnnex key
if ishere
- then next $ fromCleanup src move key
+ then handle move True
else do
showAction $ "from " ++ Remote.name src
ok <- getViaTmp key $ Remote.retrieveKeyFile src key
- if ok
- then next $ fromCleanup src move key
- else stop -- fail
-fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup
-fromCleanup src True key = Command.Drop.cleanupRemote key src
-fromCleanup _ False _ = return True
+ handle move ok
+ where
+ handle _ False = stop -- failed
+ handle False True = next $ return True -- copy complete
+ handle True True = do -- finish moving
+ ok <- Remote.removeKey src key
+ next $ Command.Drop.cleanupRemote key src ok
+
+{- Locks a key in order for it to be moved.
+ - No lock is needed when a key is being copied. -}
+moveLock :: Bool -> Key -> Annex a -> Annex a
+moveLock True key a = lockExclusive key a
+moveLock False _ a = a