diff --git a/CHANGELOG b/CHANGELOG index 5e5c20cb22..392620d9e5 100644 --- a/CHANGELOG +++ b/CHANGELOG @@ -4,6 +4,9 @@ git-annex (10.20220128) UNRELEASED; urgency=medium * Pass --no-textconv when running git diff internally. * Fix git-annex forget propagation between repositories. (reversion introduced in version 7.20190122) + * registerurl, unregisterurl: Improved output when reading from stdin + to be more like other batch commands. + * registerurl, unregisterurl: Added --json and --json-error-messages options. -- Joey Hess Mon, 31 Jan 2022 13:14:42 -0400 diff --git a/Command/FromKey.hs b/Command/FromKey.hs index 22eafcefe5..d8f04ee01f 100644 --- a/Command/FromKey.hs +++ b/Command/FromKey.hs @@ -86,12 +86,15 @@ start matcher force (si, (keyname, file)) = do -- the uri scheme, to see if it looks like the prefix of a key. This relies -- on key backend names never containing a ':'. keyOpt :: String -> Key -keyOpt s = case parseURI s of +keyOpt = either giveup id . keyOpt' + +keyOpt' :: String -> Either String Key +keyOpt' s = case parseURI s of Just u | not (isKeyPrefix (uriScheme u)) -> - Backend.URL.fromUrl s Nothing + Right $ Backend.URL.fromUrl s Nothing _ -> case deserializeKey s of - Just k -> k - Nothing -> giveup $ "bad key/url " ++ s + Just k -> Right k + Nothing -> Left $ "bad key/url " ++ s perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform perform matcher key file = lookupKeyNotHidden file >>= \case diff --git a/Command/RegisterUrl.hs b/Command/RegisterUrl.hs index f422729572..0754f477b5 100644 --- a/Command/RegisterUrl.hs +++ b/Command/RegisterUrl.hs @@ -1,21 +1,19 @@ {- git-annex command - - - Copyright 2015-2018 Joey Hess + - Copyright 2015-2022 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} -{-# LANGUAGE BangPatterns #-} - module Command.RegisterUrl where import Command import Logs.Web -import Command.FromKey (keyOpt) +import Command.FromKey (keyOpt, keyOpt') import qualified Remote cmd :: Command -cmd = command "registerurl" +cmd = withGlobalOptions [jsonOptions] $ command "registerurl" SectionPlumbing "registers an url for a key" (paramPair paramKey paramUrl) (seek <$$> optParser) @@ -32,45 +30,39 @@ optParser desc = RegisterUrlOptions seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of - (Batch (BatchFormat sep _), _) -> batchOnly Nothing (keyUrlPairs o) $ - commandAction $ startMass setUrlPresent sep + (Batch fmt, _) -> seekBatch setUrlPresent o fmt -- older way of enabling batch input, does not support BatchNull - (NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine - (NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps + (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:[]) = - starting "registerurl" ai si $ - perform a (keyOpt keyname) url +start a (keyname:url:[]) = start' a (si, (keyOpt keyname, url)) where - ai = ActionItemOther (Just url) si = SeekInput [keyname, url] start _ _ = giveup "specify a key and an url" -startMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandStart -startMass a sep = - starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $ - performMass a sep - -performMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandPerform -performMass a sep = go True =<< map (separate (== ' ')) <$> batchLines fmt +start' :: (Key -> URLString -> Annex ()) -> (SeekInput, (Key, URLString)) -> CommandStart +start' a (si, (key, url)) = + starting "registerurl" ai si $ + perform a key url where - fmt = BatchFormat sep (BatchKeys False) - go status [] = next $ return status - go status ((keyname,u):rest) | not (null keyname) && not (null u) = do - let key = keyOpt keyname - ok <- perform' a key u - let !status' = status && ok - go status' rest - go _ _ = giveup "Expected pairs of key and url on stdin, but got something else." + ai = ActionItemOther (Just url) perform :: (Key -> URLString -> Annex ()) -> Key -> URLString -> CommandPerform perform a key url = do - ok <- perform' a key url - next $ return ok - -perform' :: (Key -> URLString -> Annex ()) -> Key -> URLString -> Annex Bool -perform' a key url = do r <- Remote.claimingUrl url a key (setDownloader' url r) - return True + next $ return True diff --git a/Command/UnregisterUrl.hs b/Command/UnregisterUrl.hs index 2e2dcc83ae..35e591a18d 100644 --- a/Command/UnregisterUrl.hs +++ b/Command/UnregisterUrl.hs @@ -1,6 +1,6 @@ {- git-annex command - - - Copyright 2015-2021 Joey Hess + - Copyright 2015-2022 Joey Hess - - Licensed under the GNU AGPL version 3 or higher. -} @@ -11,18 +11,18 @@ module Command.UnregisterUrl where import Command import Logs.Web -import Command.RegisterUrl (start, startMass, optParser, RegisterUrlOptions(..)) +import Command.RegisterUrl (seekBatch, start, optParser, RegisterUrlOptions(..)) cmd :: Command -cmd = command "unregisterurl" +cmd = withGlobalOptions [jsonOptions] $ command "unregisterurl" SectionPlumbing "unregisters an url for a key" (paramPair paramKey paramUrl) (seek <$$> optParser) seek :: RegisterUrlOptions -> CommandSeek seek o = case (batchOption o, keyUrlPairs o) of - (Batch (BatchFormat sep _), _) -> commandAction $ startMass unregisterUrl sep - (NoBatch, ps) -> withWords (commandAction . start unregisterUrl) ps + (Batch fmt, _) -> seekBatch unregisterUrl o fmt + (NoBatch, ps) -> commandAction (start unregisterUrl ps) unregisterUrl :: Key -> String -> Annex () unregisterUrl key url = do diff --git a/doc/git-annex-registerurl.mdwn b/doc/git-annex-registerurl.mdwn index bafb3b77c1..ad0e511665 100644 --- a/doc/git-annex-registerurl.mdwn +++ b/doc/git-annex-registerurl.mdwn @@ -37,6 +37,16 @@ valid url, an URL key is constructed from the url. (Note that for this to be used, you have to explicitly enable batch mode with `--batch`) +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * Also the [[git-annex-common-options]](1) can be used. # SEE ALSO diff --git a/doc/git-annex-unregisterurl.mdwn b/doc/git-annex-unregisterurl.mdwn index 6860514c95..0a2f8a395a 100644 --- a/doc/git-annex-unregisterurl.mdwn +++ b/doc/git-annex-unregisterurl.mdwn @@ -14,6 +14,9 @@ no longer be downloaded from them. Unregistering a key's last web url will make git-annex no longer treat content as being present in the web special remote. +Normally the key is a git-annex formatted key. However, if the key cannot be +parsed as a key, and is a valid url, an URL key is constructed from the url. + # OPTIONS * `--batch` @@ -26,6 +29,16 @@ as being present in the web special remote. When in batch mode, the input is delimited by nulls instead of the usual newlines. +* `--json` + + Enable JSON output. This is intended to be parsed by programs that use + git-annex. Each line of output is a JSON object. + +* `--json-error-messages` + + Messages that would normally be output to standard error are included in + the json instead. + * Also the [[git-annex-common-options]](1) can be used. # SEE ALSO diff --git a/doc/todo/--json_for_registerurl.mdwn b/doc/todo/--json_for_registerurl.mdwn index 9572e25cba..da22801cb3 100644 --- a/doc/todo/--json_for_registerurl.mdwn +++ b/doc/todo/--json_for_registerurl.mdwn @@ -4,3 +4,11 @@ [[!meta author=yoh]] [[!tag projects/datalad]] + +> Added --json and --json-error-messages. Note that this did change the +> --batch output in a way that could possibly break something that expected +> the old output to never change. I think it's acceptable to break that +> because there has never been a guarantee of unchanging output format +> except with --batch for most commands. +> +> [[done]] --[[Joey]] diff --git a/doc/todo/--json_for_registerurl/comment_1_68fd330b6f20ef2d56234a639a5323c4._comment b/doc/todo/--json_for_registerurl/comment_1_68fd330b6f20ef2d56234a639a5323c4._comment index d54ddef0f6..7e3013a05c 100644 --- a/doc/todo/--json_for_registerurl/comment_1_68fd330b6f20ef2d56234a639a5323c4._comment +++ b/doc/todo/--json_for_registerurl/comment_1_68fd330b6f20ef2d56234a639a5323c4._comment @@ -14,7 +14,8 @@ a behavior change. Urk. Aside from crashing if an invalid key is provided, or perhaps some other exceptional error, there are no real ways it could -fail so --json-error-messages is unlikely to be useful. +fail so --json-error-messages is unlikely to be useful. But adding --json +always adds it anyway. (unregisterurl has the same interface and mostly same implementation, and so same problems as registerurl.)