checkpresentkey: Allow to be run without an explicit remote and add --batch
* checkpresentkey: Allow to be run without an explicit remote. * checkpresentkey: Added --batch.
This commit is contained in:
parent
84d657312e
commit
cc4d3e3d45
5 changed files with 90 additions and 23 deletions
|
@ -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
|
||||
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"
|
||||
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 = 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)
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue