diff options
| -rw-r--r-- | CmdLine/Batch.hs | 35 | ||||
| -rw-r--r-- | CmdLine/GitAnnex.hs | 12 | ||||
| -rw-r--r-- | Command/ContentLocation.hs | 17 | ||||
| -rw-r--r-- | Command/ExamineKey.hs | 21 | ||||
| -rw-r--r-- | Command/LookupKey.hs | 21 |
5 files changed, 58 insertions, 48 deletions
diff --git a/CmdLine/Batch.hs b/CmdLine/Batch.hs index 24f942978..57823b67b 100644 --- a/CmdLine/Batch.hs +++ b/CmdLine/Batch.hs @@ -10,29 +10,42 @@ module CmdLine.Batch where import Common.Annex import Command -batchOption :: Option -batchOption = flagOption [] "batch" "enable batch mode" - data BatchMode = Batch | NoBatch + +batchOption :: Parser BatchMode +batchOption = flag NoBatch Batch + ( long "batch" + <> help "enable batch mode" + ) + type Batchable t = BatchMode -> t -> CommandStart -- A Batchable command can run in batch mode, or not. -- In batch mode, one line at a time is read, parsed, and a reply output to -- stdout. In non batch mode, the command's parameters are parsed and -- a reply output for each. -batchable :: ((t -> CommandStart) -> CmdParams -> CommandSeek) -> Batchable t -> CmdParams -> CommandSeek -batchable seeker starter params = ifM (getOptionFlag batchOption) - ( batchloop - , seeker (starter NoBatch) params - ) +batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser +batchable handler parser paramdesc = batchseeker <$> batchparser where - batchloop = do + batchparser = (,,) + <$> parser + <*> batchOption + <*> cmdParams paramdesc + + batchseeker (opts, NoBatch, params) = mapM_ (go NoBatch opts) params + batchseeker (opts, Batch, _) = batchloop opts + + batchloop opts = do mp <- liftIO $ catchMaybeIO getLine case mp of Nothing -> return () Just p -> do - seeker (starter Batch) [p] - batchloop + go Batch opts p + batchloop opts + + go batchmode opts p = + unlessM (handler opts p) $ + batchBadInput batchmode -- bad input is indicated by an empty line in batch mode. In non batch -- mode, exit on bad input. diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index 74a831f8b..c569519e5 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -23,9 +23,9 @@ import qualified Command.Move import qualified Command.Copy import qualified Command.Get import qualified Command.Fsck ---import qualified Command.LookupKey ---import qualified Command.ContentLocation ---import qualified Command.ExamineKey +import qualified Command.LookupKey +import qualified Command.ContentLocation +import qualified Command.ExamineKey import qualified Command.FromKey import qualified Command.RegisterUrl import qualified Command.SetKey @@ -158,9 +158,9 @@ cmds = , Command.Schedule.cmd , Command.Ungroup.cmd , Command.Vicfg.cmd --- , Command.LookupKey.cmd --- , Command.ContentLocation.cmd --- , Command.ExamineKey.cmd + , Command.LookupKey.cmd + , Command.ContentLocation.cmd + , Command.ExamineKey.cmd , Command.FromKey.cmd , Command.RegisterUrl.cmd , Command.SetKey.cmd diff --git a/Command/ContentLocation.hs b/Command/ContentLocation.hs index bca73f926..8a5eaa7a9 100644 --- a/Command/ContentLocation.hs +++ b/Command/ContentLocation.hs @@ -11,21 +11,20 @@ import Common.Annex import Command import CmdLine.Batch import Annex.Content +import Types.Key cmd :: Command -cmd = withOptions [batchOption] $ noCommit $ noMessages $ +cmd = noCommit $ noMessages $ command "contentlocation" SectionPlumbing "looks up content for a key" - (paramRepeating paramKey) (withParams seek) + (paramRepeating paramKey) + (batchable run (pure ())) -seek :: CmdParams -> CommandSeek -seek = batchable withKeys start - -start :: Batchable Key -start batchmode k = do - maybe (batchBadInput batchmode) (liftIO . putStrLn) +run :: () -> String -> Annex Bool +run _ p = do + let k = fromMaybe (error "bad key") $ file2key p + maybe (return False) (\f -> liftIO (putStrLn f) >> return True) =<< inAnnex' (pure True) Nothing check k - stop where check f = ifM (liftIO (doesFileExist f)) ( return (Just f) diff --git a/Command/ExamineKey.hs b/Command/ExamineKey.hs index e0a1d9747..55f72f71b 100644 --- a/Command/ExamineKey.hs +++ b/Command/ExamineKey.hs @@ -11,21 +11,18 @@ import Common.Annex import Command import CmdLine.Batch import qualified Utility.Format -import Command.Find (FindOptions(..), showFormatted, keyVars) +import Command.Find (parseFormatOption, showFormatted, keyVars) import Types.Key cmd :: Command -cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $ +cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $ command "examinekey" SectionPlumbing "prints information from a key" - (paramRepeating paramKey) (withParams seek) + (paramRepeating paramKey) + (batchable run (optional parseFormatOption)) -seek :: CmdParams -> CommandSeek -seek ps = do - format <- getFormat - batchable withKeys (start format) ps - -start :: Maybe Utility.Format.Format -> Batchable Key -start format _ key = do - showFormatted format (key2file key) (keyVars key) - stop +run :: Maybe Utility.Format.Format -> String -> Annex Bool +run format p = do + let k = fromMaybe (error "bad key") $ file2key p + showFormatted format (key2file k) (keyVars k) + return True diff --git a/Command/LookupKey.hs b/Command/LookupKey.hs index 021dc963b..54023eab7 100644 --- a/Command/LookupKey.hs +++ b/Command/LookupKey.hs @@ -14,16 +14,17 @@ import Annex.CatFile import Types.Key cmd :: Command -cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $ +cmd = notBareRepo $ noCommit $ noMessages $ command "lookupkey" SectionPlumbing "looks up key used for file" - (paramRepeating paramFile) (withParams seek) + (paramRepeating paramFile) + (batchable run (pure ())) -seek :: CmdParams -> CommandSeek -seek = batchable withStrings start - -start :: Batchable String -start batchmode file = do - maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file) - =<< catKeyFile file - stop +run :: () -> String -> Annex Bool +run _ file = do + mk <- catKeyFile file + case mk of + Just k -> do + liftIO $ putStrLn $ key2file k + return True + Nothing -> return False |