b223988e22
--backend is no longer a global option, and is only accepted by commands that actually need it. Three commands that used to support backend but don't any longer are watch, webapp, and assistant. It would be possible to make them support it, but I doubt anyone used the option with these. And in the case of webapp and assistant, the option was handled inconsistently, only taking affect when the command is run with an existing git-annex repo, not when it creates a new one. Also, renamed GlobalOption etc to AnnexOption. Because there are many options of this type that are not actually global (any more) and get added to commands that need them. Sponsored-by: Kevin Mueller on Patreon
68 lines
2 KiB
Haskell
68 lines
2 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2015-2022 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
module Command.RegisterUrl where
|
|
|
|
import Command
|
|
import Logs.Web
|
|
import Command.FromKey (keyOpt, keyOpt')
|
|
import qualified Remote
|
|
|
|
cmd :: Command
|
|
cmd = withAnnexOptions [jsonOptions] $ command "registerurl"
|
|
SectionPlumbing "registers an url for a key"
|
|
(paramPair paramKey paramUrl)
|
|
(seek <$$> optParser)
|
|
|
|
data RegisterUrlOptions = RegisterUrlOptions
|
|
{ keyUrlPairs :: CmdParams
|
|
, batchOption :: BatchMode
|
|
}
|
|
|
|
optParser :: CmdParamsDesc -> Parser RegisterUrlOptions
|
|
optParser desc = RegisterUrlOptions
|
|
<$> cmdParams desc
|
|
<*> parseBatchOption False
|
|
|
|
seek :: RegisterUrlOptions -> CommandSeek
|
|
seek o = case (batchOption o, keyUrlPairs o) of
|
|
(Batch fmt, _) -> seekBatch setUrlPresent o fmt
|
|
-- older way of enabling batch input, does not support BatchNull
|
|
(NoBatch, []) -> seekBatch setUrlPresent o (BatchFormat BatchLine (BatchKeys False))
|
|
(NoBatch, ps) -> commandAction (start setUrlPresent ps)
|
|
|
|
seekBatch :: (Key -> URLString -> Annex ()) -> RegisterUrlOptions -> BatchFormat -> CommandSeek
|
|
seekBatch a o fmt = batchOnly Nothing (keyUrlPairs o) $
|
|
batchInput fmt (pure . parsebatch) $
|
|
batchCommandAction . start' a
|
|
where
|
|
parsebatch l =
|
|
let (keyname, u) = separate (== ' ') l
|
|
in if null u
|
|
then Left "no url provided"
|
|
else case keyOpt' keyname of
|
|
Left e -> Left e
|
|
Right k -> Right (k, u)
|
|
|
|
start :: (Key -> URLString -> Annex ()) -> [String] -> CommandStart
|
|
start a (keyname:url:[]) = start' a (si, (keyOpt keyname, url))
|
|
where
|
|
si = SeekInput [keyname, url]
|
|
start _ _ = giveup "specify a key and an url"
|
|
|
|
start' :: (Key -> URLString -> Annex ()) -> (SeekInput, (Key, URLString)) -> CommandStart
|
|
start' a (si, (key, url)) =
|
|
starting "registerurl" ai si $
|
|
perform a key url
|
|
where
|
|
ai = ActionItemOther (Just url)
|
|
|
|
perform :: (Key -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform
|
|
perform a key url = do
|
|
r <- Remote.claimingUrl url
|
|
a key (setDownloader' url r)
|
|
next $ return True
|