{- git-annex command - - Copyright 2010 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Move where import Control.Monad.State (liftIO) import Command import qualified Command.Drop import qualified Annex import qualified AnnexQueue import LocationLog import Types import Content import qualified Remote import UUID import Messages import Utility command :: [Command] command = [repoCommand "move" paramPath seek "move content of files to/from another repository"] seek :: [CommandSeek] seek = [withFilesInGit $ start True] {- Move (or copy) a file either --to or --from a repository. - - This only operates on the cached file content; it does not involve - moving data in the key-value backend. -} start :: Bool -> CommandStartString start move file = do to <- Annex.getState Annex.toremote from <- Annex.getState Annex.fromremote case (from, to) of (Nothing, Nothing) -> error "specify either --from or --to" (Nothing, Just name) -> do dest <- Remote.byName name toStart dest move file (Just name, Nothing) -> do src <- Remote.byName name fromStart src move file (_ , _) -> error "only one of --from or --to can be specified" showAction :: Bool -> FilePath -> Annex () showAction True file = showStart "move" file showAction False file = showStart "copy" file {- Used to log a change in a remote's having a key. The change is logged - in the local repo, not on the remote. The process of transferring the - key to the remote, or removing the key from it *may* log the change - on the remote, but this cannot be relied on. For example, it's not done - for bare repos. -} remoteHasKey :: Remote.Remote Annex -> Key -> Bool -> Annex () remoteHasKey remote key present = do g <- Annex.gitRepo let remoteuuid = Remote.uuid remote logfile <- liftIO $ logChange g key remoteuuid status AnnexQueue.add "add" [Param "--"] logfile where status = if present then ValuePresent else ValueMissing {- Moves (or copies) the content of an annexed file to a remote. - - If the remote already has the content, it is still removed from - the current repository. - - Note that unlike drop, this does not honor annex.numcopies. - A file's content can be moved even if there are insufficient copies to - allow it to be dropped. -} toStart :: Remote.Remote Annex -> Bool -> CommandStartString toStart dest move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g ishere <- inAnnex key if not ishere || u == Remote.uuid dest then return Nothing -- not here, so nothing to do else do showAction move file return $ Just $ toPerform dest move key toPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform toPerform dest 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, -- it has to be done, to avoid inaverdent data loss. fast <- Annex.getState Annex.fast isthere <- if fast && not move && not (Remote.hasKeyCheap dest) then do (remotes, _) <- Remote.keyPossibilities key return $ Right $ dest `elem` remotes else Remote.hasKey dest key case isthere of Left err -> do showNote $ show err return Nothing Right False -> do showNote $ "to " ++ Remote.name dest ++ "..." ok <- Remote.storeKey dest key if ok then return $ Just $ toCleanup dest move key else return Nothing -- failed Right True -> return $ Just $ toCleanup dest move key toCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup toCleanup dest move key = do remoteHasKey dest key True if move then Command.Drop.cleanup key else return True {- Moves (or copies) the content of an annexed file from a remote - to the current repository. - - If the current repository already has the content, it is still removed - from the remote. -} fromStart :: Remote.Remote Annex -> Bool -> CommandStartString fromStart src move file = isAnnexed file $ \(key, _) -> do g <- Annex.gitRepo u <- getUUID g (remotes, _) <- Remote.keyPossibilities key if (u == Remote.uuid src) || (null $ filter (== src) remotes) then return Nothing else do showAction move file return $ Just $ fromPerform src move key fromPerform :: Remote.Remote Annex -> Bool -> Key -> CommandPerform fromPerform src move key = do ishere <- inAnnex key if ishere then return $ Just $ fromCleanup src move key else do showNote $ "from " ++ Remote.name src ++ "..." ok <- getViaTmp key $ Remote.retrieveKeyFile src key if ok then return $ Just $ fromCleanup src move key else return Nothing -- fail fromCleanup :: Remote.Remote Annex -> Bool -> Key -> CommandCleanup fromCleanup src True key = do ok <- Remote.removeKey src key -- better safe than sorry: assume the src dropped the key -- even if it seemed to fail; the failure could have occurred -- after it really dropped it remoteHasKey src key False return ok fromCleanup _ False _ = return True