016d1bee88
What this can currently be used for is only to change an url from being used by a special remote to being used by the web remote. This could have been a --move-from option to registerurl. But, that would have complicated its option and --batch processing, and also would have complicated unregisterurl, which is implemented on top of Command.Registerurl. So, a separate command was actually less complicated to implement. The generic description of the command is because I want to make this command a catch-all for other url updating kind of things, if there are ever any more. Also because it was hard to come up with a good name for the specific action. I considered `git-annex moveurl`, but that seems to indicate data is perhaps actually being moved, and seems to sit at the same level as addurl and rmurl, and this command is at the plumbing level of registerurl and unregisterurl. Sponsored-by: Dartmouth College's DANDI project
79 lines
2.2 KiB
Haskell
79 lines
2.2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2015-2024 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.ReregisterUrl where
|
|
|
|
import Command
|
|
import Logs.Web
|
|
import Command.FromKey (keyOpt, keyOpt')
|
|
import qualified Remote
|
|
import Git.Types
|
|
|
|
cmd :: Command
|
|
cmd = withAnnexOptions [jsonOptions] $ command "reregisterurl"
|
|
SectionPlumbing "updates url registration information"
|
|
(paramKey)
|
|
(seek <$$> optParser)
|
|
|
|
data ReregisterUrlOptions = ReregisterUrlOptions
|
|
{ keyOpts :: CmdParams
|
|
, batchOption :: BatchMode
|
|
, moveFromOption :: Maybe (DeferredParse Remote)
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser ReregisterUrlOptions
|
|
optParser desc = ReregisterUrlOptions
|
|
<$> cmdParams desc
|
|
<*> parseBatchOption False
|
|
<*> optional (mkParseRemoteOption <$> parseMoveFromOption)
|
|
|
|
parseMoveFromOption :: Parser RemoteName
|
|
parseMoveFromOption = strOption
|
|
( long "move-from" <> metavar paramRemote
|
|
<> completeRemotes
|
|
)
|
|
|
|
seek :: ReregisterUrlOptions -> CommandSeek
|
|
seek o = case (batchOption o, keyOpts o) of
|
|
(Batch fmt, _) -> seekBatch o fmt
|
|
(NoBatch, ps) -> commandAction (start o ps)
|
|
|
|
seekBatch :: ReregisterUrlOptions -> BatchFormat -> CommandSeek
|
|
seekBatch o fmt = batchOnly Nothing (keyOpts o) $
|
|
batchInput fmt (pure . parsebatch) $
|
|
batchCommandAction . start' o
|
|
where
|
|
parsebatch l = case keyOpt' l of
|
|
Left e -> Left e
|
|
Right k -> Right k
|
|
|
|
start :: ReregisterUrlOptions -> [String] -> CommandStart
|
|
start o (keyname:[]) = start' o (si, keyOpt keyname)
|
|
where
|
|
si = SeekInput [keyname]
|
|
start _ _ = giveup "specify a key"
|
|
|
|
start' :: ReregisterUrlOptions -> (SeekInput, Key) -> CommandStart
|
|
start' o (si, key) =
|
|
starting "reregisterurl" ai si $
|
|
perform o key
|
|
where
|
|
ai = ActionItemKey key
|
|
|
|
perform :: ReregisterUrlOptions -> Key -> CommandPerform
|
|
perform o key = maybe (pure Nothing) (Just <$$> getParsed) (moveFromOption o) >>= \case
|
|
Nothing -> next $ return True
|
|
Just r -> do
|
|
us <- map fst
|
|
. filter (\(_, d) -> d == OtherDownloader)
|
|
. map getDownloader
|
|
<$> getUrls key
|
|
us' <- filterM (\u -> (== r) <$> Remote.claimingUrl u) us
|
|
forM_ us' $ \u -> do
|
|
setUrlMissing key (setDownloader u OtherDownloader)
|
|
setUrlPresent key u
|
|
next $ return True
|