checkpresentkey: Allow to be run without an explicit remote and add --batch

* checkpresentkey: Allow to be run without an explicit remote.
* checkpresentkey: Added --batch.

1 files changed, 62 insertions, 20 deletions

diff --git a/Command/CheckPresentKey.hs b/Command/CheckPresentKey.hs
index e8dabe18f..6fe1f552c 100644
--- a/Command/CheckPresentKey.hs
+++ b/Command/CheckPresentKey.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2015 Joey Hess <id@joeyh.name>
+ - Copyright 2015-2016 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -9,29 +9,71 @@ module Command.CheckPresentKey where
 
 import Command
 import qualified Remote
-import Annex
-import Types.Messages
 
 cmd :: Command
-cmd = noCommit $ 
+cmd = noCommit $ noMessages $
 	command "checkpresentkey" SectionPlumbing
 		"check if key is present in remote"
-		(paramPair paramKey paramRemote)
-		(withParams seek)
+		(paramPair paramKey (paramOptional paramRemote))
+		(seek <$$> optParser)
 
-seek :: CmdParams -> CommandSeek
-seek = withWords start
+data CheckPresentKeyOptions = CheckPresentKeyOptions
+	{ params :: CmdParams
+	, batchOption :: BatchMode
+	}
 
-start :: [String] -> CommandStart
-start (ks:rn:[]) = do
-	setOutput QuietOutput
-	maybe (error "Unknown remote") (go <=< flip Remote.hasKey k)
-		=<< Remote.byNameWithUUID (Just rn)
+optParser :: CmdParamsDesc -> Parser CheckPresentKeyOptions
+optParser desc = CheckPresentKeyOptions
+	<$> cmdParams desc
+	<*> parseBatchOption
+
+seek :: CheckPresentKeyOptions -> CommandSeek
+seek o = case batchOption o of
+	NoBatch -> case params o of
+		(ks:rn:[]) -> toRemote rn >>= (check ks . Just) >>= exitResult
+		(ks:[]) -> check ks Nothing >>= exitResult
+		_ -> wrongnumparams
+	Batch -> do
+		checker <- case params o of
+			(rn:[]) -> toRemote rn >>= \r -> return (flip check (Just r))
+			[] -> return (flip check Nothing)
+			_ -> wrongnumparams
+		batchInput Right $ checker >=> batchResult
+  where
+	wrongnumparams = error "Wrong number of parameters"
+					
+data Result = Present | NotPresent | CheckFailure String
+
+check :: String -> Maybe Remote -> Annex Result
+check ks mr = case mr of
+	Nothing -> go Nothing =<< Remote.keyPossibilities k
+	Just r -> go Nothing [r]
   where
-	k = fromMaybe (error "bad key") (file2key ks)
-	go (Right True) = liftIO exitSuccess
-	go (Right False) = liftIO exitFailure
-	go (Left e) = liftIO $ do
-		hPutStrLn stderr e
-		exitWith $ ExitFailure 100
-start _ = error "Wrong number of parameters"
+	k = toKey ks
+	go Nothing [] = return NotPresent
+	go (Just e) [] = return $ CheckFailure e
+	go olderr (r:rs) = do
+		v <- Remote.hasKey r k
+		case v of
+			Right True -> return Present
+			Right False -> go olderr rs
+			Left e -> go (Just e) rs
+
+exitResult :: Result -> Annex a
+exitResult Present = liftIO exitSuccess
+exitResult NotPresent = liftIO exitFailure
+exitResult (CheckFailure msg) = liftIO $ do
+	hPutStrLn stderr msg
+	exitWith $ ExitFailure 100
+
+batchResult :: Result -> Annex ()
+batchResult Present = liftIO $ putStrLn "1"
+batchResult NotPresent = liftIO $ putStrLn "0"
+batchResult failure = exitResult failure
+
+toKey :: String -> Key
+toKey = fromMaybe (error "Bad key") . file2key
+
+toRemote :: String -> Annex Remote
+toRemote rn = maybe (error "Unknown remote") return
+	=<< Remote.byNameWithUUID (Just rn)