diff options
| -rw-r--r-- | Command/Copy.hs | 8 | ||||
| -rw-r--r-- | Command/Drop.hs | 7 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 5 | ||||
| -rw-r--r-- | Command/Find.hs | 2 | ||||
| -rw-r--r-- | Command/Get.hs | 7 | ||||
| -rw-r--r-- | Command/Move.hs | 15 | ||||
| -rw-r--r-- | Command/Sync.hs | 2 | ||||
| -rw-r--r-- | Command/Unused.hs | 2 | ||||
| -rw-r--r-- | Remote.hs | 11 | ||||
| -rw-r--r-- | Seek.hs | 4 |
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 () @@ -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 @@ -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 |