summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-01-06 04:02:35 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-01-06 04:06:13 -0400
commitdf21cbfdd2b7342c206ebd4aea32d989328374dc (patch)
tree24f6624e4e4c6dc06b53735bfb52973366e7b159
parent0a36f92a31196451c2d838fd0ae15527e8bbce18 (diff)
look up --to and --from remote names only once
This will speed up commands like move and drop.
-rw-r--r--Command/Copy.hs8
-rw-r--r--Command/Drop.hs7
-rw-r--r--Command/DropUnused.hs5
-rw-r--r--Command/Find.hs2
-rw-r--r--Command/Get.hs7
-rw-r--r--Command/Move.hs15
-rw-r--r--Command/Sync.hs2
-rw-r--r--Command/Unused.hs2
-rw-r--r--Remote.hs11
-rw-r--r--Seek.hs4
10 files changed, 30 insertions, 33 deletions
diff --git a/Command/Copy.hs b/Command/Copy.hs
index d789d41f6..c83c72412 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -10,17 +10,19 @@ module Command.Copy where
import Common.Annex
import Command
import qualified Command.Move
+import qualified Remote
def :: [Command]
def = [withOptions Command.Move.options $ command "copy" paramPaths seek
"copy content of files to/from another repository"]
seek :: [CommandSeek]
-seek = [withField "to" id $ \to -> withField "from" id $ \from ->
- withNumCopies $ \n -> whenAnnexed $ start to from n]
+seek = [withField "to" Remote.byName $ \to ->
+ withField "from" Remote.byName $ \from ->
+ withNumCopies $ \n -> whenAnnexed $ start to from n]
-- A copy is just a move that does not delete the source file.
-- 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 $
Command.Move.start to from False file (key, backend)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index f76951f08..07ea50df1 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -25,15 +25,14 @@ fromOption :: Option
fromOption = fieldOption ['f'] "from" paramRemote "drop content from a remote"
seek :: [CommandSeek]
-seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \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
case from of
Nothing -> startLocal file numcopies key
- Just name -> do
- remote <- Remote.byName name
+ Just remote -> do
u <- getUUID
if Remote.uuid remote == u
then startLocal file numcopies key
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index fd3e84fe5..1c5bf8b8c 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -51,10 +51,9 @@ start (unused, unusedbad, unusedtmp) s = search
next $ a key
perform :: Key -> CommandPerform
-perform key = maybe droplocal dropremote =<< Annex.getField "from"
+perform key = maybe droplocal dropremote =<< Remote.byName =<< Annex.getField "from"
where
- dropremote name = do
- r <- Remote.byName name
+ dropremote r = do
showAction $ "from " ++ Remote.name r
ok <- Remote.removeKey r key
next $ Command.Drop.cleanupRemote key r ok
diff --git a/Command/Find.hs b/Command/Find.hs
index eb0267c14..8760cc947 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -33,7 +33,7 @@ seek :: [CommandSeek]
seek = [withField "format" formatconverter $ \f ->
withFilesInGit $ whenAnnexed $ start f]
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 format file (key, _) = do
diff --git a/Command/Get.hs b/Command/Get.hs
index 4a50fe3fe..1a0435c36 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -18,17 +18,16 @@ def = [withOptions [Command.Move.fromOption] $ command "get" paramPaths seek
"make content of annexed files available"]
seek :: [CommandSeek]
-seek = [withField "from" id $ \from -> withNumCopies $ \n ->
+seek = [withField "from" Remote.byName $ \from -> withNumCopies $ \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) $
autoCopies key (<) numcopies $ do
case from of
Nothing -> go $ perform key
- Just name -> do
+ Just src -> do
-- get --from = copy --from
- src <- Remote.byName name
stopUnless (Command.Move.fromOk src key) $
go $ Command.Move.fromPerform src False key
where
diff --git a/Command/Move.hs b/Command/Move.hs
index 66a0c1660..4978283bf 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -29,20 +29,17 @@ options :: [Option]
options = [fromOption, toOption]
seek :: [CommandSeek]
-seek = [withField "to" id $ \to -> withField "from" id $ \from ->
- withFilesInGit $ whenAnnexed $ start to from True]
+seek = [withField "to" Remote.byName $ \to ->
+ withField "from" Remote.byName $ \from ->
+ 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
noAuto
case (from, to) of
(Nothing, Nothing) -> error "specify either --from or --to"
- (Nothing, Just name) -> do
- dest <- Remote.byName name
- toStart dest move file key
- (Just name, Nothing) -> do
- src <- Remote.byName name
- fromStart src move file key
+ (Nothing, Just dest) -> toStart dest move file key
+ (Just src, Nothing) -> fromStart src move file key
(_ , _) -> error "only one of --from or --to can be specified"
where
noAuto = when move $ whenM (Annex.getState Annex.auto) $ error
diff --git a/Command/Sync.hs b/Command/Sync.hs
index e5884cc4a..3d541c4de 100644
--- a/Command/Sync.hs
+++ b/Command/Sync.hs
@@ -61,7 +61,7 @@ syncRemotes rs = do
wanted
| null rs = good =<< available
| otherwise = listed
- listed = mapM Remote.byName rs
+ listed = catMaybes <$> mapM (Remote.byName . Just) rs
available = filter nonspecial <$> Remote.enabledRemoteList
good = filterM $ Remote.Git.repoAvail . Types.Remote.repo
nonspecial r = Types.Remote.remotetype r == Remote.Git.remote
diff --git a/Command/Unused.hs b/Command/Unused.hs
index 59efe64c8..a6883dce1 100644
--- a/Command/Unused.hs
+++ b/Command/Unused.hs
@@ -66,7 +66,7 @@ checkUnused = do
checkRemoteUnused :: String -> CommandPerform
checkRemoteUnused name = do
- checkRemoteUnused' =<< Remote.byName name
+ checkRemoteUnused' =<< fromJust <$> Remote.byName (Just name)
next $ return True
checkRemoteUnused' :: Remote -> Annex ()
diff --git a/Remote.hs b/Remote.hs
index 8046175d2..3f60ca3ac 100644
--- a/Remote.hs
+++ b/Remote.hs
@@ -94,14 +94,15 @@ enabledRemoteList = filterM (repoNotIgnored . repo) =<< remoteList
remoteMap :: Annex (M.Map UUID String)
remoteMap = M.fromList . map (\r -> (uuid r, name r)) <$> remoteList
-{- Looks up a remote by name. (Or by UUID.) Only finds currently configured
- - git remotes. -}
-byName :: String -> Annex (Remote)
-byName n = do
+{- When a name is specified, looks up the remote matching that name.
+ - (Or it can be a UUID.) Only finds currently configured git remotes. -}
+byName :: Maybe String -> Annex (Maybe Remote)
+byName Nothing = return Nothing
+byName (Just n) = do
res <- byName' n
case res of
Left e -> error e
- Right r -> return r
+ Right r -> return $ Just r
byName' :: String -> Annex (Either String Remote)
byName' "" = return $ Left "no remote specified"
byName' n = do
diff --git a/Seek.hs b/Seek.hs
index af074c7c5..53101b23e 100644
--- a/Seek.hs
+++ b/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.
- 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
- f <- converter <$> Annex.getField field
+ f <- converter =<< Annex.getField field
a f ps
withNothing :: CommandStart -> CommandSeek