diff options
| -rw-r--r-- | Command/Copy.hs | 12 | ||||
| -rw-r--r-- | Command/Get.hs | 50 | ||||
| -rw-r--r-- | Command/Move.hs | 72 | ||||
| -rw-r--r-- | Command/TransferKey.hs | 2 | ||||
| -rw-r--r-- | Seek.hs | 4 |
5 files changed, 86 insertions, 54 deletions
diff --git a/Command/Copy.hs b/Command/Copy.hs index 75b91c85c..979eead65 100644 --- a/Command/Copy.hs +++ b/Command/Copy.hs @@ -14,13 +14,16 @@ import qualified Remote import Annex.Wanted def :: [Command] -def = [withOptions Command.Move.options $ command "copy" paramPaths seek +def = [withOptions Command.Move.moveOptions $ command "copy" paramPaths seek SectionCommon "copy content of files to/from another repository"] seek :: [CommandSeek] -seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to -> - withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start to from] +seek = + [ withField Command.Move.toOption Remote.byNameWithUUID $ \to -> + withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> + withAll (Command.Move.startAll to from False) $ + withFilesInGit $ whenAnnexed $ start to from + ] {- A copy is just a move that does not delete the source file. - However, --auto mode avoids unnecessary copies, and avoids getting or @@ -33,4 +36,3 @@ start to from file (key, backend) = stopUnless shouldCopy $ check = case to of Nothing -> wantGet False (Just file) Just r -> wantSend False (Just file) (Remote.uuid r) - diff --git a/Command/Get.hs b/Command/Get.hs index 5b6fdecfa..56dbe415f 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010, 2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -14,37 +14,53 @@ import Annex.Content import qualified Command.Move import Logs.Transfer import Annex.Wanted +import GitAnnex.Options +import Types.Key +import Types.Remote def :: [Command] -def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek +def = [withOptions getOptions $ command "get" paramPaths seek SectionCommon "make content of annexed files available"] +getOptions :: [Option] +getOptions = [allOption, Command.Move.fromOption] + seek :: [CommandSeek] -seek = [withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start from] +seek = + [ withField Command.Move.fromOption Remote.byNameWithUUID $ \from -> + withAll (startAll from) $ + withFilesInGit $ whenAnnexed $ start from + ] start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart -start from file (key, _) = stopUnless (not <$> inAnnex key) $ - stopUnless (checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file))) $ do +start from file (key, _) = start' expensivecheck from key (Just file) + where + expensivecheck = checkAuto (numCopiesCheck file key (<) <||> wantGet False (Just file)) + +startAll :: Maybe Remote -> Key -> CommandStart +startAll from key = start' (return True) from key Nothing + +start' :: Annex Bool -> Maybe Remote -> Key -> AssociatedFile -> CommandStart +start' expensivecheck from key afile = stopUnless (not <$> inAnnex key) $ + stopUnless expensivecheck $ case from of - Nothing -> go $ perform key file + Nothing -> go $ perform key afile Just src -> - -- get --from = copy --from stopUnless (Command.Move.fromOk src key) $ - go $ Command.Move.fromPerform src False key file + go $ Command.Move.fromPerform src False key afile where - go a = do - showStart "get" file + go a = do + showStart "get" (fromMaybe (key2file key) afile) next a -perform :: Key -> FilePath -> CommandPerform -perform key file = stopUnless (getViaTmp key $ getKeyFile key file) $ +perform :: Key -> AssociatedFile -> CommandPerform +perform key afile = stopUnless (getViaTmp key $ getKeyFile key afile) $ next $ return True -- no cleanup needed {- Try to find a copy of the file in one of the remotes, - and copy it to here. -} -getKeyFile :: Key -> FilePath -> FilePath -> Annex Bool -getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key +getKeyFile :: Key -> AssociatedFile -> FilePath -> Annex Bool +getKeyFile key afile dest = dispatch =<< Remote.keyPossibilities key where dispatch [] = do showNote "not available" @@ -69,7 +85,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key either (const False) id <$> Remote.hasKey r key | otherwise = return True docopy r continue = do - ok <- download (Remote.uuid r) key (Just file) noRetry $ \p -> do + ok <- download (Remote.uuid r) key afile noRetry $ \p -> do showAction $ "from " ++ Remote.name r - Remote.retrieveKeyFile r key (Just file) dest p + Remote.retrieveKeyFile r key afile dest p if ok then return ok else continue diff --git a/Command/Move.hs b/Command/Move.hs index ec0e68bb7..3f91f1bd9 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2010-2011 Joey Hess <joey@kitenet.net> + - Copyright 2010-2013 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -17,9 +17,12 @@ import Annex.UUID import qualified Option import Logs.Presence import Logs.Transfer +import GitAnnex.Options +import Types.Key +import Types.Remote def :: [Command] -def = [withOptions options $ command "move" paramPaths seek +def = [withOptions moveOptions $ command "move" paramPaths seek SectionCommon "move content of files to/from another repository"] fromOption :: Option @@ -28,29 +31,40 @@ fromOption = Option.field ['f'] "from" paramRemote "source remote" toOption :: Option toOption = Option.field ['t'] "to" paramRemote "destination remote" -options :: [Option] -options = [fromOption, toOption] +moveOptions :: [Option] +moveOptions = [allOption, fromOption, toOption] seek :: [CommandSeek] -seek = [withField toOption Remote.byNameWithUUID $ \to -> - withField fromOption Remote.byNameWithUUID $ \from -> - withFilesInGit $ whenAnnexed $ start to from True] +seek = + [ withField toOption Remote.byNameWithUUID $ \to -> + withField fromOption Remote.byNameWithUUID $ \from -> + withAll (startAll to from True) $ + withFilesInGit $ whenAnnexed $ start to from True + ] start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart -start to from move file (key, _) = do +start to from move file (key, _) = start' to from move (Just file) key + +startAll :: Maybe Remote -> Maybe Remote -> Bool -> Key -> CommandStart +startAll to from move key = start' to from move Nothing key + +start' :: Maybe Remote -> Maybe Remote -> Bool -> AssociatedFile -> Key -> CommandStart +start' to from move afile key = do noAuto case (from, to) of (Nothing, Nothing) -> error "specify either --from or --to" - (Nothing, Just dest) -> toStart dest move file key - (Just src, Nothing) -> fromStart src move file key + (Nothing, Just dest) -> toStart dest move afile key + (Just src, Nothing) -> fromStart src move afile key (_ , _) -> error "only one of --from or --to can be specified" where noAuto = when move $ whenM (Annex.getState Annex.auto) $ error "--auto is not supported for move" -showMoveAction :: Bool -> FilePath -> Annex () -showMoveAction True file = showStart "move" file -showMoveAction False file = showStart "copy" file +showMoveAction :: Bool -> Key -> AssociatedFile -> Annex () +showMoveAction True _ (Just file) = showStart "move" file +showMoveAction False _ (Just file) = showStart "copy" file +showMoveAction True key Nothing = showStart "move" (key2file key) +showMoveAction False key Nothing = showStart "copy" (key2file key) {- Moves (or copies) the content of an annexed file to a remote. - @@ -61,17 +75,17 @@ showMoveAction False file = showStart "copy" file - A file's content can be moved even if there are insufficient copies to - allow it to be dropped. -} -toStart :: Remote -> Bool -> FilePath -> Key -> CommandStart -toStart dest move file key = do +toStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart +toStart dest move afile key = do u <- getUUID ishere <- inAnnex key if not ishere || u == Remote.uuid dest then stop -- not here, so nothing to do else do - showMoveAction move file - next $ toPerform dest move key file -toPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform -toPerform dest move key file = moveLock move key $ do + showMoveAction move key afile + next $ toPerform dest move key afile +toPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform +toPerform dest move key afile = 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, @@ -87,8 +101,8 @@ toPerform dest move key file = moveLock move key $ do stop Right False -> do showAction $ "to " ++ Remote.name dest - ok <- upload (Remote.uuid dest) key (Just file) noRetry $ - Remote.storeKey dest key (Just file) + ok <- upload (Remote.uuid dest) key afile noRetry $ + Remote.storeKey dest key afile if ok then do Remote.logStatus dest key InfoPresent @@ -117,14 +131,14 @@ toPerform dest move key file = moveLock move key $ do - If the current repository already has the content, it is still removed - from the remote. -} -fromStart :: Remote -> Bool -> FilePath -> Key -> CommandStart -fromStart src move file key +fromStart :: Remote -> Bool -> AssociatedFile -> Key -> CommandStart +fromStart src move afile key | move = go | otherwise = stopUnless (not <$> inAnnex key) go where go = stopUnless (fromOk src key) $ do - showMoveAction move file - next $ fromPerform src move key file + showMoveAction move key afile + next $ fromPerform src move key afile fromOk :: Remote -> Key -> Annex Bool fromOk src key @@ -137,16 +151,16 @@ fromOk src key remotes <- Remote.keyPossibilities key return $ u /= Remote.uuid src && elem src remotes -fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform -fromPerform src move key file = moveLock move key $ +fromPerform :: Remote -> Bool -> Key -> AssociatedFile -> CommandPerform +fromPerform src move key afile = moveLock move key $ ifM (inAnnex key) ( handle move True , handle move =<< go ) where - go = download (Remote.uuid src) key (Just file) noRetry $ \p -> do + go = download (Remote.uuid src) key afile noRetry $ \p -> do showAction $ "from " ++ Remote.name src - getViaTmp key $ \t -> Remote.retrieveKeyFile src key (Just file) t p + getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p handle _ False = stop -- failed handle False True = next $ return True -- copy complete handle True True = do -- finish moving diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 13790dd50..849cbc12b 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -24,7 +24,7 @@ def = [withOptions options $ "transfers a key from or to a remote"] options :: [Option] -options = fileOption : Command.Move.options +options = [fileOption, Command.Move.fromOption, Command.Move.toOption] fileOption :: Option fileOption = Option.field [] "file" paramFile "the associated file" @@ -122,8 +122,8 @@ withNothing :: CommandStart -> CommandSeek withNothing a [] = return [a] withNothing _ _ = error "This command takes no parameters." -{- If --all is specified, runs an action on all logged keys. - - Otherwise, fall back to a regular CommandSeek action on +{- If --all is specified, or in a bare repo, runs an action on all + - known keys. Otherwise, fall back to a regular CommandSeek action on - whatever params were passed. -} withAll :: (Key -> CommandStart) -> CommandSeek -> CommandSeek withAll allop fallbackop params = go =<< (Annex.getFlag "all" <||> isbare) |