support cmdnorepo actions, also using getopt-applicative there
This commit is contained in:
parent
6e5c1f8db3
commit
92d8f80bff
10 changed files with 54 additions and 68 deletions
45
CmdLine.hs
45
CmdLine.hs
|
@ -45,7 +45,7 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
|
|||
inRepo $ autocorrect . Just
|
||||
forM_ fields $ uncurry Annex.setField
|
||||
(cmd, seek) <- liftIO $
|
||||
O.handleParseResult (parseCmd (name:args) allcmds)
|
||||
O.handleParseResult (parseCmd (name:args) allcmds cmdparser)
|
||||
when (cmdnomessages cmd) $
|
||||
Annex.setOutput QuietOutput
|
||||
-- TODO: propigate global options to annex state (how?)
|
||||
|
@ -54,11 +54,12 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
|
|||
startup
|
||||
performCommandAction cmd seek $
|
||||
shutdown $ cmdnocommit cmd
|
||||
go (Left e) = do
|
||||
go (Left norepo) = do
|
||||
when fuzzy $
|
||||
autocorrect =<< Git.Config.global
|
||||
-- a <- O.handleParseResult (parseCmd (name:args) allcmds)
|
||||
error "TODO"
|
||||
let norepoparser = fromMaybe (throw norepo) . cmdnorepo
|
||||
(_cmd, a) <- O.handleParseResult (parseCmd (name:args) allcmds norepoparser)
|
||||
a
|
||||
|
||||
autocorrect = Git.AutoCorrect.prepare inputcmdname cmdname cmds
|
||||
err msg = msg ++ "\n\n" ++ usage header allcmds
|
||||
|
@ -69,44 +70,16 @@ dispatch fuzzyok allargs allcmds commonoptions fields header getgitrepo = do
|
|||
_ -> inputcmdname
|
||||
| otherwise = inputcmdname
|
||||
|
||||
#if 0
|
||||
case getOptCmd args cmd commonoptions of
|
||||
Right (flags, params) -> go flags params
|
||||
=<< (E.try getgitrepo :: IO (Either E.SomeException Git.Repo))
|
||||
Left parseerr -> error parseerr
|
||||
where
|
||||
go flags params (Right g) = do
|
||||
state <- Annex.new g
|
||||
Annex.eval state $ do
|
||||
checkEnvironment
|
||||
when fuzzy $
|
||||
inRepo $ autocorrect . Just
|
||||
forM_ fields $ uncurry Annex.setField
|
||||
when (cmdnomessages cmd) $
|
||||
Annex.setOutput QuietOutput
|
||||
sequence_ flags
|
||||
whenM (annexDebug <$> Annex.getGitConfig) $
|
||||
liftIO enableDebugOutput
|
||||
startup
|
||||
performCommandAction cmd params $
|
||||
shutdown $ cmdnocommit cmd
|
||||
go _flags params (Left e) = do
|
||||
when fuzzy $
|
||||
autocorrect =<< Git.Config.global
|
||||
maybe (throw e) (\a -> a params) (cmdnorepo cmd)
|
||||
cmd = Prelude.head cmds
|
||||
#endif
|
||||
|
||||
{- Parses command line and selects a command to run and gets the
|
||||
- seek action for the command. -}
|
||||
parseCmd :: CmdParams -> [Command] -> O.ParserResult (Command, CommandSeek)
|
||||
parseCmd allargs allcmds = O.execParserPure (O.prefs O.idm) pinfo allargs
|
||||
{- Parses command line, selecting one of the commands from the list. -}
|
||||
parseCmd :: CmdParams -> [Command] -> (Command -> O.Parser v) -> O.ParserResult (Command, v)
|
||||
parseCmd allargs allcmds getparser = O.execParserPure (O.prefs O.idm) pinfo allargs
|
||||
where
|
||||
pinfo = O.info (O.subparser $ mconcat $ map mkcommand allcmds) O.idm
|
||||
mkcommand c = O.command (cmdname c) (O.info (mkparser c) O.idm)
|
||||
mkparser c = (,)
|
||||
<$> pure c
|
||||
<*> cmdparser c
|
||||
<*> getparser c
|
||||
|
||||
{- Parses command line params far enough to find the Command to run, and
|
||||
- returns the remaining params.
|
||||
|
|
|
@ -11,7 +11,6 @@ import Common.Annex
|
|||
import Types.Command
|
||||
|
||||
import System.Console.GetOpt
|
||||
import qualified Options.Applicative as O
|
||||
|
||||
usageMessage :: String -> String
|
||||
usageMessage s = "Usage: " ++ s
|
||||
|
@ -56,13 +55,6 @@ commandUsage cmd = unlines
|
|||
, "[option ...]"
|
||||
]
|
||||
|
||||
{- Simple CommandParser generator, for when the CommandSeek wants all
|
||||
- non-option parameters. -}
|
||||
withParams :: (CmdParams -> CommandSeek) -> String -> CommandParser
|
||||
withParams mkseek paramdesc = mkseek <$> O.many cmdparams
|
||||
where
|
||||
cmdparams = O.argument O.str (O.metavar paramdesc)
|
||||
|
||||
{- Descriptions of params used in usage messages. -}
|
||||
paramPaths :: String
|
||||
paramPaths = paramRepeating paramPath -- most often used
|
||||
|
|
17
Command.hs
17
Command.hs
|
@ -7,6 +7,7 @@
|
|||
|
||||
module Command (
|
||||
command,
|
||||
withParams,
|
||||
noRepo,
|
||||
noCommit,
|
||||
noMessages,
|
||||
|
@ -32,11 +33,19 @@ import CmdLine.Action as ReExported
|
|||
import CmdLine.Option as ReExported
|
||||
import CmdLine.GitAnnex.Options as ReExported
|
||||
|
||||
import qualified Options.Applicative as O
|
||||
|
||||
{- Generates a normal Command -}
|
||||
command :: String -> CommandSection -> String -> String -> (String -> CommandParser) -> Command
|
||||
command name section desc paramdesc mkparser =
|
||||
Command [] Nothing commonChecks False False name paramdesc
|
||||
section desc (mkparser paramdesc)
|
||||
Command [] commonChecks False False name paramdesc
|
||||
section desc (mkparser paramdesc) Nothing
|
||||
|
||||
{- Option parser that takes all non-option params as-is. -}
|
||||
withParams :: (CmdParams -> v) -> String -> O.Parser v
|
||||
withParams mkseek paramdesc = mkseek <$> O.many cmdparams
|
||||
where
|
||||
cmdparams = O.argument O.str (O.metavar paramdesc)
|
||||
|
||||
{- Indicates that a command doesn't need to commit any changes to
|
||||
- the git-annex branch. -}
|
||||
|
@ -50,8 +59,8 @@ noMessages c = c { cmdnomessages = True }
|
|||
|
||||
{- Adds a fallback action to a command, that will be run if it's used
|
||||
- outside a git repository. -}
|
||||
noRepo :: (CmdParams -> IO ()) -> Command -> Command
|
||||
noRepo a c = c { cmdnorepo = Just a }
|
||||
noRepo :: (String -> O.Parser (IO ())) -> Command -> Command
|
||||
noRepo a c = c { cmdnorepo = Just (a (cmdparamdesc c)) }
|
||||
|
||||
{- Adds options to a command. -}
|
||||
withOptions :: [Option] -> Command -> Command
|
||||
|
|
|
@ -20,10 +20,11 @@ import Assistant.Install
|
|||
import System.Environment
|
||||
|
||||
cmd :: Command
|
||||
cmd = noRepo checkNoRepoOpts $ dontCheck repoExists $ withOptions options $
|
||||
notBareRepo $ command "assistant" SectionCommon
|
||||
"automatically sync changes"
|
||||
paramNothing (withParams seek)
|
||||
cmd = dontCheck repoExists $ withOptions options $ notBareRepo $
|
||||
noRepo (withParams checkNoRepoOpts) $
|
||||
command "assistant" SectionCommon
|
||||
"automatically sync changes"
|
||||
paramNothing (withParams seek)
|
||||
|
||||
options :: [Option]
|
||||
options =
|
||||
|
|
|
@ -22,9 +22,12 @@ import qualified Command.Fsck
|
|||
import System.Console.GetOpt
|
||||
|
||||
cmd :: Command
|
||||
cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $
|
||||
command "help" SectionCommon "display help"
|
||||
"COMMAND" (withParams seek)
|
||||
cmd = noCommit $ dontCheck repoExists $
|
||||
noRepo (parseparams startNoRepo) $
|
||||
command "help" SectionCommon "display help"
|
||||
"COMMAND" (parseparams seek)
|
||||
where
|
||||
parseparams = withParams
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withWords start
|
||||
|
|
|
@ -12,10 +12,12 @@ import Command
|
|||
import Messages
|
||||
|
||||
cmd :: Command
|
||||
cmd = noRepo startIO $ dontCheck repoExists $
|
||||
cmd = noRepo (parseparams startIO) $ dontCheck repoExists $
|
||||
command "test" SectionTesting
|
||||
"run built-in test suite"
|
||||
paramNothing (withParams seek)
|
||||
paramNothing (parseparams seek)
|
||||
where
|
||||
parseparams = withParams
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withWords start
|
||||
|
|
|
@ -18,10 +18,12 @@ import qualified Remote
|
|||
import qualified Backend
|
||||
|
||||
cmd :: Command
|
||||
cmd = withOptions [rawOption] $
|
||||
noCommit $ noRepo startNoRepo $ dontCheck repoExists $
|
||||
command "version" SectionQuery "show version info"
|
||||
paramNothing (withParams seek)
|
||||
cmd = withOptions [rawOption] $ dontCheck repoExists $ noCommit $
|
||||
noRepo (parseparams startNoRepo) $
|
||||
command "version" SectionQuery "show version info"
|
||||
paramNothing (parseparams seek)
|
||||
where
|
||||
parseparams = withParams
|
||||
|
||||
rawOption :: Option
|
||||
rawOption = flagOption [] "raw" "output only program version"
|
||||
|
|
|
@ -39,9 +39,10 @@ import System.Environment (getArgs)
|
|||
|
||||
cmd :: Command
|
||||
cmd = withOptions [listenOption] $
|
||||
noCommit $ noRepo startNoRepo $ dontCheck repoExists $ notBareRepo $
|
||||
command "webapp" SectionCommon "launch webapp"
|
||||
paramNothing (withParams seek)
|
||||
noCommit $ dontCheck repoExists $ notBareRepo $
|
||||
noRepo (withParams startNoRepo) $
|
||||
command "webapp" SectionCommon "launch webapp"
|
||||
paramNothing (withParams seek)
|
||||
|
||||
listenOption :: Option
|
||||
listenOption = fieldOption [] "listen" paramAddress
|
||||
|
|
|
@ -12,9 +12,12 @@ import Command
|
|||
import Assistant.XMPP.Git
|
||||
|
||||
cmd :: Command
|
||||
cmd = noCommit $ noRepo startNoRepo $ dontCheck repoExists $
|
||||
command "xmppgit" SectionPlumbing "git to XMPP relay"
|
||||
paramNothing (withParams seek)
|
||||
cmd = noCommit $ dontCheck repoExists $
|
||||
noRepo (parseparams startNoRepo) $
|
||||
command "xmppgit" SectionPlumbing "git to XMPP relay"
|
||||
paramNothing (parseparams seek)
|
||||
where
|
||||
parseparams = withParams
|
||||
|
||||
seek :: CmdParams -> CommandSeek
|
||||
seek = withWords start
|
||||
|
|
|
@ -39,7 +39,6 @@ type CommandCleanup = Annex Bool
|
|||
{- A command is defined by specifying these things. -}
|
||||
data Command = Command
|
||||
{ cmdoptions :: [Option] -- command-specific options
|
||||
, cmdnorepo :: Maybe (CmdParams -> IO ()) -- an action to run when not in a repo
|
||||
, cmdcheck :: [CommandCheck] -- check stage
|
||||
, cmdnocommit :: Bool -- don't commit journalled state changes
|
||||
, cmdnomessages :: Bool -- don't output normal messages
|
||||
|
@ -48,6 +47,7 @@ data Command = Command
|
|||
, cmdsection :: CommandSection
|
||||
, cmddesc :: String -- description of command for usage
|
||||
, cmdparser :: CommandParser -- command line parser
|
||||
, cmdnorepo :: Maybe (Parser (IO ())) -- used when not in a repo
|
||||
}
|
||||
|
||||
{- Command-line parameters, after the command is selected and options
|
||||
|
|
Loading…
Reference in a new issue