mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions 1

tweak

Browse source
This commit is contained in:
Joey Hess 2011-11-10 22:37:52 -04:00
parent 2de1e2c2ce
commit 4389782628
1 changed files with 11 additions and 11 deletions
Download patch file Download diff file Expand all files Collapse all files

22
Command/Move.hs
View file

@ -28,7 +28,7 @@ seek = [withFilesInGit $ start True]
- This only operates on the cached file content; it does not involve - This only operates on the cached file content; it does not involve
- moving data in the key-value backend. -} - moving data in the key-value backend. -}
start :: Bool -> FilePath -> CommandStart start :: Bool -> FilePath -> CommandStart
start move file = do start move file = isAnnexed file $ \(key, _) -> do
noAuto noAuto
to <- Annex.getState Annex.toremote to <- Annex.getState Annex.toremote
from <- Annex.getState Annex.fromremote from <- Annex.getState Annex.fromremote
@ -36,10 +36,10 @@ start move file = do
(Nothing, Nothing) -> error "specify either --from or --to" (Nothing, Nothing) -> error "specify either --from or --to"
(Nothing, Just name) -> do (Nothing, Just name) -> do
dest <- Remote.byName name dest <- Remote.byName name
toStart dest move file toStart dest move file key
(Just name, Nothing) -> do (Just name, Nothing) -> do
src <- Remote.byName name src <- Remote.byName name
fromStart src move file fromStart src move file key
(_ , _) -> error "only one of --from or --to can be specified" (_ , _) -> error "only one of --from or --to can be specified"
where where
noAuto = when move $ whenM (Annex.getState Annex.auto) $ error noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
@ -58,8 +58,8 @@ showMoveAction False file = showStart "copy" file
- A file's content can be moved even if there are insufficient copies to - A file's content can be moved even if there are insufficient copies to
- allow it to be dropped. - allow it to be dropped.
-} -}
toStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart toStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
toStart dest move file = isAnnexed file $ \(key, _) -> do toStart dest move file key = do
u <- getUUID u <- getUUID
ishere <- inAnnex key ishere <- inAnnex key
if not ishere || u == Remote.uuid dest if not ishere || u == Remote.uuid dest
@ -109,14 +109,14 @@ toPerform dest move key = moveLock move key $ do
- If the current repository already has the content, it is still removed - If the current repository already has the content, it is still removed
- from the remote. - from the remote.
-} -}
fromStart :: Remote.Remote Annex -> Bool -> FilePath -> CommandStart fromStart :: Remote.Remote Annex -> Bool -> FilePath -> Key -> CommandStart
fromStart src move file fromStart src move file key
| move == True = isAnnexed file $ \(key, _) -> go key | move == True = go
| otherwise = isAnnexed file $ \(key, _) -> do | otherwise = do
ishere <- inAnnex key ishere <- inAnnex key
if ishere then stop else go key if ishere then stop else go
where where
go key = do go = do
u <- getUUID u <- getUUID
remotes <- Remote.keyPossibilities key remotes <- Remote.keyPossibilities key
if u == Remote.uuid src || not (any (== src) remotes) if u == Remote.uuid src || not (any (== src) remotes)