From f246621a92d2dae3d7d9d6358e6916097729f5c9 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Fri, 12 Feb 2016 16:43:51 -0400 Subject: checkpresentkey: Allow to be run without an explicit remote and add --batch * checkpresentkey: Allow to be run without an explicit remote. * checkpresentkey: Added --batch. --- Command/CheckPresentKey.hs | 82 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 62 insertions(+), 20 deletions(-) (limited to 'Command') 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 + - Copyright 2015-2016 Joey Hess - - 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) -- cgit v1.2.3