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.

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