converted ContentLocation, ExampleKey, LookupKey

This commit is contained in:
Joey Hess 2015-07-11 20:43:45 -04:00
parent c6375a9158
commit fdcb54d4f2
5 changed files with 58 additions and 48 deletions

View file

@ -10,29 +10,42 @@ module CmdLine.Batch where
import Common.Annex import Common.Annex
import Command import Command
batchOption :: Option
batchOption = flagOption [] "batch" "enable batch mode"
data BatchMode = Batch | NoBatch data BatchMode = Batch | NoBatch
batchOption :: Parser BatchMode
batchOption = flag NoBatch Batch
( long "batch"
<> help "enable batch mode"
)
type Batchable t = BatchMode -> t -> CommandStart type Batchable t = BatchMode -> t -> CommandStart
-- A Batchable command can run in batch mode, or not. -- 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 -- 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 -- stdout. In non batch mode, the command's parameters are parsed and
-- a reply output for each. -- a reply output for each.
batchable :: ((t -> CommandStart) -> CmdParams -> CommandSeek) -> Batchable t -> CmdParams -> CommandSeek batchable :: (opts -> String -> Annex Bool) -> Parser opts -> CmdParamsDesc -> CommandParser
batchable seeker starter params = ifM (getOptionFlag batchOption) batchable handler parser paramdesc = batchseeker <$> batchparser
( batchloop
, seeker (starter NoBatch) params
)
where 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 mp <- liftIO $ catchMaybeIO getLine
case mp of case mp of
Nothing -> return () Nothing -> return ()
Just p -> do Just p -> do
seeker (starter Batch) [p] go Batch opts p
batchloop 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 -- bad input is indicated by an empty line in batch mode. In non batch
-- mode, exit on bad input. -- mode, exit on bad input.

View file

@ -23,9 +23,9 @@ import qualified Command.Move
import qualified Command.Copy import qualified Command.Copy
import qualified Command.Get import qualified Command.Get
import qualified Command.Fsck import qualified Command.Fsck
--import qualified Command.LookupKey import qualified Command.LookupKey
--import qualified Command.ContentLocation import qualified Command.ContentLocation
--import qualified Command.ExamineKey import qualified Command.ExamineKey
import qualified Command.FromKey import qualified Command.FromKey
import qualified Command.RegisterUrl import qualified Command.RegisterUrl
import qualified Command.SetKey import qualified Command.SetKey
@ -158,9 +158,9 @@ cmds =
, Command.Schedule.cmd , Command.Schedule.cmd
, Command.Ungroup.cmd , Command.Ungroup.cmd
, Command.Vicfg.cmd , Command.Vicfg.cmd
-- , Command.LookupKey.cmd , Command.LookupKey.cmd
-- , Command.ContentLocation.cmd , Command.ContentLocation.cmd
-- , Command.ExamineKey.cmd , Command.ExamineKey.cmd
, Command.FromKey.cmd , Command.FromKey.cmd
, Command.RegisterUrl.cmd , Command.RegisterUrl.cmd
, Command.SetKey.cmd , Command.SetKey.cmd

View file

@ -11,21 +11,20 @@ import Common.Annex
import Command import Command
import CmdLine.Batch import CmdLine.Batch
import Annex.Content import Annex.Content
import Types.Key
cmd :: Command cmd :: Command
cmd = withOptions [batchOption] $ noCommit $ noMessages $ cmd = noCommit $ noMessages $
command "contentlocation" SectionPlumbing command "contentlocation" SectionPlumbing
"looks up content for a key" "looks up content for a key"
(paramRepeating paramKey) (withParams seek) (paramRepeating paramKey)
(batchable run (pure ()))
seek :: CmdParams -> CommandSeek run :: () -> String -> Annex Bool
seek = batchable withKeys start run _ p = do
let k = fromMaybe (error "bad key") $ file2key p
start :: Batchable Key maybe (return False) (\f -> liftIO (putStrLn f) >> return True)
start batchmode k = do
maybe (batchBadInput batchmode) (liftIO . putStrLn)
=<< inAnnex' (pure True) Nothing check k =<< inAnnex' (pure True) Nothing check k
stop
where where
check f = ifM (liftIO (doesFileExist f)) check f = ifM (liftIO (doesFileExist f))
( return (Just f) ( return (Just f)

View file

@ -11,21 +11,18 @@ import Common.Annex
import Command import Command
import CmdLine.Batch import CmdLine.Batch
import qualified Utility.Format import qualified Utility.Format
import Command.Find (FindOptions(..), showFormatted, keyVars) import Command.Find (parseFormatOption, showFormatted, keyVars)
import Types.Key import Types.Key
cmd :: Command cmd :: Command
cmd = noCommit $ noMessages $ withOptions [formatOption, jsonOption, batchOption] $ cmd = noCommit $ noMessages $ withGlobalOptions [jsonOption] $
command "examinekey" SectionPlumbing command "examinekey" SectionPlumbing
"prints information from a key" "prints information from a key"
(paramRepeating paramKey) (withParams seek) (paramRepeating paramKey)
(batchable run (optional parseFormatOption))
seek :: CmdParams -> CommandSeek run :: Maybe Utility.Format.Format -> String -> Annex Bool
seek ps = do run format p = do
format <- getFormat let k = fromMaybe (error "bad key") $ file2key p
batchable withKeys (start format) ps showFormatted format (key2file k) (keyVars k)
return True
start :: Maybe Utility.Format.Format -> Batchable Key
start format _ key = do
showFormatted format (key2file key) (keyVars key)
stop

View file

@ -14,16 +14,17 @@ import Annex.CatFile
import Types.Key import Types.Key
cmd :: Command cmd :: Command
cmd = withOptions [batchOption] $ notBareRepo $ noCommit $ noMessages $ cmd = notBareRepo $ noCommit $ noMessages $
command "lookupkey" SectionPlumbing command "lookupkey" SectionPlumbing
"looks up key used for file" "looks up key used for file"
(paramRepeating paramFile) (withParams seek) (paramRepeating paramFile)
(batchable run (pure ()))
seek :: CmdParams -> CommandSeek run :: () -> String -> Annex Bool
seek = batchable withStrings start run _ file = do
mk <- catKeyFile file
start :: Batchable String case mk of
start batchmode file = do Just k -> do
maybe (batchBadInput batchmode) (liftIO . putStrLn . key2file) liftIO $ putStrLn $ key2file k
=<< catKeyFile file return True
stop Nothing -> return False