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

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

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

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