registerurl,unregisterurl: rework output and support --json

* registerurl, unregisterurl: Improved output when reading from stdin
  to be more like other batch commands.
* registerurl, unregisterurl: Added --json and --json-error-messages options.

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. The old
output was just really weird too!

One possible wart is that "git-annex registerurl" with no options now
seems to just hang, since it's waiting for stdin input. Before, it said
"registerurl (stdin)" which was clearer about what's happenening. But this
is a deprecated mode anyway, --batch makes clear what's happening. If
anything, this problem would be a reason to eventually remove the support
for reading from stdin w/o --batch.

Sponsored-by: Dartmouth College's Datalad project

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 <id@joeyh.name>  Mon, 31 Jan 2022 13:14:42 -0400
 

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
+		Just k -> Right k
-		Nothing -> giveup $ "bad key/url " ++ s
+		Nothing -> Left $ "bad key/url " ++ s
 
 perform :: AddUnlockedMatcher -> Key -> RawFilePath -> CommandPerform
 perform matcher key file = lookupKeyNotHidden file >>= \case

Command/RegisterUrl.hs

@@ -1,21 +1,19 @@
 {- git-annex command
  -
- - Copyright 2015-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2022 Joey Hess <id@joeyh.name>
  -
  - 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) $
+	(Batch fmt, _) -> seekBatch setUrlPresent o fmt
-		commandAction $ startMass setUrlPresent sep
 	-- older way of enabling batch input, does not support BatchNull
-	(NoBatch, []) -> commandAction $ startMass setUrlPresent BatchLine
+	(NoBatch, []) -> seekBatch setUrlPresent o (BatchFormat BatchLine (BatchKeys False))
-	(NoBatch, ps) -> withWords (commandAction . start setUrlPresent) ps
+	(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 (keyname:url:[]) = start' a (si, (keyOpt keyname, url))
-	starting "registerurl" ai si $
-		perform a (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
+start' :: (Key -> URLString -> Annex ()) -> (SeekInput, (Key, URLString)) -> CommandStart
-startMass a sep =
+start' a (si, (key, url)) =
-	starting "registerurl" (ActionItemOther (Just "stdin")) (SeekInput []) $
+	starting "registerurl" ai si $
-		performMass a sep
+		perform a key url
-
-performMass :: (Key -> URLString -> Annex ()) -> BatchSeparator -> CommandPerform
-performMass a sep = go True =<< map (separate (== ' ')) <$> batchLines fmt
   where
-	fmt = BatchFormat sep (BatchKeys False)
+	ai = ActionItemOther (Just url)
-	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."
 
 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

Command/UnregisterUrl.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2015-2021 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2022 Joey Hess <id@joeyh.name>
  -
  - 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
+	(Batch fmt, _) -> seekBatch unregisterUrl o fmt
-	(NoBatch, ps) -> withWords (commandAction . start unregisterUrl) ps
+	(NoBatch, ps) -> commandAction (start unregisterUrl ps)
 
 unregisterUrl :: Key -> String -> Annex ()
 unregisterUrl key url = do

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

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

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]]

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.)