fromkey --json

* fromkey: Added --json.
* fromkey --batch output changed to support using it with --json.
  The old output was not parseable for any useful information, so
  this is not expected to break anything.

CHANGELOG

@@ -12,6 +12,10 @@ git-annex (7.20190130) UNRELEASED; urgency=medium
   * Fix race in cleanup of othertmp directory that could result in a failure
     attempting to access it.
   * fromkey: Made idempotent.
+  * fromkey: Added --json.
+  * fromkey --batch output changed to support using it with --json.
+    The old output was not parseable for any useful information, so
+    this is not expected to break anything.
 
  -- Joey Hess <id@joeyh.name>  Wed, 30 Jan 2019 12:30:22 -0400
 

CmdLine/Batch.hs

@@ -93,15 +93,15 @@ batchCommandAction a = maybe (batchBadInput (Batch BatchLine)) (const noop)
 -- to handle them.
 --
 -- File matching options are not checked.
-allBatchFiles :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()
-allBatchFiles fmt a = batchInput fmt Right $ batchCommandAction . a
+batchStart :: BatchFormat -> (String -> CommandStart) -> Annex ()
+batchStart fmt a = batchInput fmt Right $ batchCommandAction . a
 
--- Like allBatchFiles, but checks the file matching options
+-- Like batchStart, but checks the file matching options
 -- and skips non-matching files.
 batchFilesMatching :: BatchFormat -> (FilePath -> CommandStart) -> Annex ()
 batchFilesMatching fmt a = do
 	matcher <- getMatcher
-	allBatchFiles fmt $ \f ->
+	batchStart fmt $ \f ->
 		ifM (matcher $ MatchingFile $ FileInfo f f)
 			( a f
 			, return Nothing

Command/FromKey.hs

@@ -19,7 +19,7 @@ import qualified Backend.URL
 import Network.URI
 
 cmd :: Command
-cmd = notDirect $ notBareRepo $
+cmd = notDirect $ notBareRepo $ withGlobalOptions [jsonOptions] $
 	command "fromkey" SectionPlumbing "adds a file using a specific key"
 		(paramRepeating (paramPair paramKey paramPath))
 		(seek <$$> optParser)
@@ -36,13 +36,25 @@ optParser desc = FromKeyOptions
 
 seek :: FromKeyOptions -> CommandSeek
 seek o = case (batchOption o, keyFilePairs o) of
-	(Batch fmt, _) -> commandAction $ startMass fmt
+	(Batch fmt, _) -> seekBatch fmt
 	-- older way of enabling batch input, does not support BatchNull
-	(NoBatch, []) -> commandAction $ startMass BatchLine
+	(NoBatch, []) -> seekBatch BatchLine
 	(NoBatch, ps) -> do
 		force <- Annex.getState Annex.force
 		withPairs (commandAction . start force) ps
 
+seekBatch :: BatchFormat -> CommandSeek
+seekBatch fmt = batchInput fmt parse commandAction
+  where
+	parse s = 
+		let (keyname, file) = separate (== ' ') s
+		in if not (null keyname) && not (null file)
+			then Right $ go file (mkKey keyname)
+			else Left "Expected pairs of key and filename"
+	go file key = do
+		showStart "fromkey" file
+		next $ perform key file
+
 start :: Bool -> (String, FilePath) -> CommandStart
 start force (keyname, file) = do
 	let key = mkKey keyname
@@ -53,22 +65,6 @@ start force (keyname, file) = do
 	showStart "fromkey" file
 	next $ perform key file
 
-startMass :: BatchFormat -> CommandStart
-startMass fmt = do
-	showStart' "fromkey" (Just "stdin")
-	next (massAdd fmt)
-
-massAdd :: BatchFormat -> CommandPerform
-massAdd fmt = go True =<< map (separate (== ' ')) <$> batchLines fmt
-  where
-	go status [] = next $ return status
-	go status ((keyname,f):rest) | not (null keyname) && not (null f) = do
-		let key = mkKey keyname
-		ok <- perform' key f
-		let !status' = status && ok
-		go status' rest
-	go _ _ = giveup "Expected pairs of key and file on stdin, but got something else."
-
 -- From user input to a Key.
 -- User can input either a serialized key, or an url.
 --
@@ -85,18 +81,20 @@ mkKey s = case parseURI s of
 		Nothing -> giveup $ "bad key/url " ++ s
 
 perform :: Key -> FilePath -> CommandPerform
-perform key file = do
-	ok <- perform' key file
-	next $ return ok
-
-perform' :: Key -> FilePath -> Annex Bool
-perform' key file = lookupFileNotHidden file >>= \case
-	Nothing -> do
-		link <- calcRepo $ gitAnnexLink file key
-		liftIO $ createDirectoryIfMissing True (parentDir file)
-		liftIO $ createSymbolicLink link file
-		Annex.Queue.addCommand "add" [Param "--"] [file]
-		return True
+perform key file = lookupFileNotHidden file >>= \case
+	Nothing -> ifM (liftIO $ doesFileExist file)
+		( hasothercontent
+		, do
+			link <- calcRepo $ gitAnnexLink file key
+			liftIO $ createDirectoryIfMissing True (parentDir file)
+			liftIO $ createSymbolicLink link file
+			Annex.Queue.addCommand "add" [Param "--"] [file]
+			next $ return True
+		)
 	Just k
-		| k == key -> return True
-		| otherwise -> giveup $ file ++ " already exists with different content"
+		| k == key -> next $ return True
+		| otherwise -> hasothercontent
+  where
+	hasothercontent = do
+		warning $ file ++ " already exists with different content"
+		next $ return False

doc/git-annex-fromkey.mdwn

@@ -42,6 +42,11 @@ to do that.
   (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.
+
 # SEE ALSO
 
 [[git-annex]](1)

doc/todo/batch_command_result_status/comment_1_78290ab147983ab8efdeb21b4ae53832._comment

@@ -0,0 +1,17 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 1"""
+ date="2019-02-05T17:20:40Z"
+ content="""
+Many commands do have an interface that works like that. For example
+`git annex get --batch --json` has json output and does not stop when a get
+fails.
+
+So this comes down to specific behaviors of specific commands.
+I've added --json to fromkey.
+
+I don't think that setpresentkey can fail, unless there's a disk IO error
+or something?
+
+Any others?
+"""]]