look up --to and --from remote names only once
This will speed up commands like move and drop.
This commit is contained in:
parent
0a36f92a31
commit
df21cbfdd2
10 changed files with 30 additions and 33 deletions
|
@ -10,17 +10,19 @@ module Command.Copy where
|
||||||
import Common.Annex
|
import Common.Annex
|
||||||
import Command
|
import Command
|
||||||
import qualified Command.Move
|
import qualified Command.Move
|
||||||
|
import qualified Remote
|
||||||
|
|
||||||
def :: [Command]
|
def :: [Command]
|
||||||
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
|
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
|
||||||
"copy content of files to/from another repository"]
|
"copy content of files to/from another repository"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "to" id $ \to -> withField "from" id $ \from ->
|
seek = [withField "to" Remote.byName $ \to ->
|
||||||
|
withField "from" Remote.byName $ \from ->
|
||||||
withNumCopies $ \n -> whenAnnexed $ start to from n]
|
withNumCopies $ \n -> whenAnnexed $ start to from n]
|
||||||
|
|
||||||
-- A copy is just a move that does not delete the source file.
|
-- A copy is just a move that does not delete the source file.
|
||||||
-- However, --auto mode avoids unnecessary copies.
|
-- However, --auto mode avoids unnecessary copies.
|
||||||
start :: Maybe String -> Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
|
start to from numcopies file (key, backend) = autoCopies key (<) numcopies $
|
||||||
Command.Move.start to from False file (key, backend)
|
Command.Move.start to from False file (key, backend)
|
||||||
|
|
|
@ -25,15 +25,14 @@ fromOption :: Option
|
||||||
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
|
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "from" id $ \from -> withNumCopies $ \n ->
|
seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n ->
|
||||||
whenAnnexed $ start from n]
|
whenAnnexed $ start from n]
|
||||||
|
|
||||||
start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
|
start from numcopies file (key, _) = autoCopies key (>) numcopies $ do
|
||||||
case from of
|
case from of
|
||||||
Nothing -> startLocal file numcopies key
|
Nothing -> startLocal file numcopies key
|
||||||
Just name -> do
|
Just remote -> do
|
||||||
remote <- Remote.byName name
|
|
||||||
u <- getUUID
|
u <- getUUID
|
||||||
if Remote.uuid remote == u
|
if Remote.uuid remote == u
|
||||||
then startLocal file numcopies key
|
then startLocal file numcopies key
|
||||||
|
|
|
@ -51,10 +51,9 @@ start (unused, unusedbad, unusedtmp) s = search
|
||||||
next $ a key
|
next $ a key
|
||||||
|
|
||||||
perform :: Key -> CommandPerform
|
perform :: Key -> CommandPerform
|
||||||
perform key = maybe droplocal dropremote =<< Annex.getField "from"
|
perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from"
|
||||||
where
|
where
|
||||||
dropremote name = do
|
dropremote r = do
|
||||||
r <- Remote.byName name
|
|
||||||
showAction $ "from " ++ Remote.name r
|
showAction $ "from " ++ Remote.name r
|
||||||
ok <- Remote.removeKey r key
|
ok <- Remote.removeKey r key
|
||||||
next $ Command.Drop.cleanupRemote key r ok
|
next $ Command.Drop.cleanupRemote key r ok
|
||||||
|
|
|
@ -33,7 +33,7 @@ seek :: [CommandSeek]
|
||||||
seek = [withField "format" formatconverter $ \f ->
|
seek = [withField "format" formatconverter $ \f ->
|
||||||
withFilesInGit $ whenAnnexed $ start f]
|
withFilesInGit $ whenAnnexed $ start f]
|
||||||
where
|
where
|
||||||
formatconverter = maybe Nothing (Just . Utility.Format.gen)
|
formatconverter = return . maybe Nothing (Just . Utility.Format.gen)
|
||||||
|
|
||||||
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start format file (key, _) = do
|
start format file (key, _) = do
|
||||||
|
|
|
@ -18,17 +18,16 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
|
||||||
"make content of annexed files available"]
|
"make content of annexed files available"]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "from" id $ \from -> withNumCopies $ \n ->
|
seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \n ->
|
||||||
whenAnnexed $ start from n]
|
whenAnnexed $ start from n]
|
||||||
|
|
||||||
start :: Maybe String -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Int -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
|
start from numcopies file (key, _) = stopUnless (not <$> inAnnex key) $
|
||||||
autoCopies key (<) numcopies $ do
|
autoCopies key (<) numcopies $ do
|
||||||
case from of
|
case from of
|
||||||
Nothing -> go $ perform key
|
Nothing -> go $ perform key
|
||||||
Just name -> do
|
Just src -> do
|
||||||
-- get --from = copy --from
|
-- get --from = copy --from
|
||||||
src <- Remote.byName name
|
|
||||||
stopUnless (Command.Move.fromOk src key) $
|
stopUnless (Command.Move.fromOk src key) $
|
||||||
go $ Command.Move.fromPerform src False key
|
go $ Command.Move.fromPerform src False key
|
||||||
where
|
where
|
||||||
|
|
|
@ -29,20 +29,17 @@ options :: [Option]
|
||||||
options = [fromOption, toOption]
|
options = [fromOption, toOption]
|
||||||
|
|
||||||
seek :: [CommandSeek]
|
seek :: [CommandSeek]
|
||||||
seek = [withField "to" id $ \to -> withField "from" id $ \from ->
|
seek = [withField "to" Remote.byName $ \to ->
|
||||||
|
withField "from" Remote.byName $ \from ->
|
||||||
withFilesInGit $ whenAnnexed $ start to from True]
|
withFilesInGit $ whenAnnexed $ start to from True]
|
||||||
|
|
||||||
start :: Maybe String -> Maybe String -> Bool -> FilePath -> (Key, Backend) -> CommandStart
|
start :: Maybe Remote -> Maybe Remote -> Bool -> FilePath -> (Key, Backend) -> CommandStart
|
||||||
start to from move file (key, _) = do
|
start to from move file (key, _) = do
|
||||||
noAuto
|
noAuto
|
||||||
case (from, to) of
|
case (from, to) of
|
||||||
(Nothing, Nothing) -> error "specify either --from or --to"
|
(Nothing, Nothing) -> error "specify either --from or --to"
|
||||||
(Nothing, Just name) -> do
|
(Nothing, Just dest) -> toStart dest move file key
|
||||||
dest <- Remote.byName name
|
(Just src, Nothing) -> fromStart src move file key
|
||||||
toStart dest move file key
|
|
||||||
(Just name, Nothing) -> do
|
|
||||||
src <- Remote.byName name
|
|
||||||
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
|
||||||
|
|
|
@ -61,7 +61,7 @@ syncRemotes rs = do
|
||||||
wanted
|
wanted
|
||||||
| null rs = good =<< available
|
| null rs = good =<< available
|
||||||
| otherwise = listed
|
| otherwise = listed
|
||||||
listed = mapM Remote.byName rs
|
listed = catMaybes <$> mapM (Remote.byName . Just) rs
|
||||||
available = filter nonspecial <$> Remote.enabledRemoteList
|
available = filter nonspecial <$> Remote.enabledRemoteList
|
||||||
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
|
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
|
||||||
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
|
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
|
||||||
|
|
|
@ -66,7 +66,7 @@ checkUnused = do
|
||||||
|
|
||||||
checkRemoteUnused :: String -> CommandPerform
|
checkRemoteUnused :: String -> CommandPerform
|
||||||
checkRemoteUnused name = do
|
checkRemoteUnused name = do
|
||||||
checkRemoteUnused' =<< Remote.byName name
|
checkRemoteUnused' =<< fromJust <$> Remote.byName (Just name)
|
||||||
next $ return True
|
next $ return True
|
||||||
|
|
||||||
checkRemoteUnused' :: Remote -> Annex ()
|
checkRemoteUnused' :: Remote -> Annex ()
|
||||||
|
|
11
Remote.hs
11
Remote.hs
|
@ -94,14 +94,15 @@ enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
|
||||||
remoteMap :: Annex (M.Map UUID String)
|
remoteMap :: Annex (M.Map UUID String)
|
||||||
remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
|
remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
|
||||||
|
|
||||||
{- Looks up a remote by name. (Or by UUID.) Only finds currently configured
|
{- When a name is specified, looks up the remote matching that name.
|
||||||
- git remotes. -}
|
- (Or it can be a UUID.) Only finds currently configured git remotes. -}
|
||||||
byName :: String -> Annex (Remote)
|
byName :: Maybe String -> Annex (Maybe Remote)
|
||||||
byName n = do
|
byName Nothing = return Nothing
|
||||||
|
byName (Just n) = do
|
||||||
res <- byName' n
|
res <- byName' n
|
||||||
case res of
|
case res of
|
||||||
Left e -> error e
|
Left e -> error e
|
||||||
Right r -> return r
|
Right r -> return $ Just r
|
||||||
byName' :: String -> Annex (Either String Remote)
|
byName' :: String -> Annex (Either String Remote)
|
||||||
byName' "" = return $ Left "no remote specified"
|
byName' "" = return $ Left "no remote specified"
|
||||||
byName' n = do
|
byName' n = do
|
||||||
|
|
4
Seek.hs
4
Seek.hs
|
@ -91,9 +91,9 @@ withKeys a params = return $ map (a . parse) params
|
||||||
- a conversion function, and then is passed into the seek action.
|
- a conversion function, and then is passed into the seek action.
|
||||||
- This ensures that the conversion function only runs once.
|
- This ensures that the conversion function only runs once.
|
||||||
-}
|
-}
|
||||||
withField :: String -> (Maybe String -> a) -> (a -> CommandSeek) -> CommandSeek
|
withField :: String -> (Maybe String -> Annex a) -> (a -> CommandSeek) -> CommandSeek
|
||||||
withField field converter a ps = do
|
withField field converter a ps = do
|
||||||
f <- converter <$> Annex.getField field
|
f <- converter =<< Annex.getField field
|
||||||
a f ps
|
a f ps
|
||||||
|
|
||||||
withNothing :: CommandStart -> CommandSeek
|
withNothing :: CommandStart -> CommandSeek
|
||||||
|
|
Loading…
Reference in a new issue