diff options
author | Roman Smrž <roman.smrz@seznam.cz> | 2024-07-30 10:42:38 +0200 |
---|---|---|
committer | Roman Smrž <roman.smrz@seznam.cz> | 2024-07-30 10:42:38 +0200 |
commit | ccce704296792fb3efc7590e70b05cff52532258 (patch) | |
tree | 881d680a5e0a76bc88b602b03b0f13497789e23f | |
parent | 3b025f4c1c82e3ce5d4b6017228af32aee9327ac (diff) |
Help for subcommands
-rw-r--r-- | src/Command.hs | 2 | ||||
-rw-r--r-- | src/Command/Run.hs | 9 | ||||
-rw-r--r-- | src/Main.hs | 35 |
3 files changed, 42 insertions, 4 deletions
diff --git a/src/Command.hs b/src/Command.hs index bb0b26f..ae24534 100644 --- a/src/Command.hs +++ b/src/Command.hs @@ -31,6 +31,8 @@ class CommandArgumentsType (CommandArguments c) => Command c where type CommandArguments c :: Type type CommandArguments c = () + commandUsage :: proxy c -> Text + commandInit :: CommandArgumentsType (CommandArguments c) => proxy c -> CommandOptions c -> CommandArguments c -> c commandExec :: c -> CommandExec () diff --git a/src/Command/Run.hs b/src/Command/Run.hs index 28b35c3..677f8f1 100644 --- a/src/Command/Run.hs +++ b/src/Command/Run.hs @@ -27,6 +27,15 @@ instance Command RunCommand where type CommandArguments RunCommand = Maybe Text + commandUsage _ = T.pack $ unlines $ + [ "Usage: minici run" + , " run jobs for commits on current branch not yet in upstream branch" + , " or: minici run <ref>" + , " run jobs for commits on <ref> not yet in its upstream ref" + , " or: minici run <commit>..<commit>" + , " run jobs for commits in given range" + ] + commandInit _ _ = RunCommand . fromMaybe "HEAD" commandExec = cmdRun diff --git a/src/Main.hs b/src/Main.hs index f65c023..7dcc484 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -6,6 +6,7 @@ import Control.Monad.Reader import Data.List import Data.Proxy +import Data.Text qualified as T import System.Console.GetOpt import System.Environment @@ -81,20 +82,46 @@ main = do runSomeCommand ncmd cargs +data FullCommandOptions c = FullCommandOptions + { fcoSpecific :: CommandOptions c + , fcoShowHelp :: Bool + } + +defaultFullOptions :: Command c => proxy c -> FullCommandOptions c +defaultFullOptions proxy = FullCommandOptions + { fcoSpecific = defaultCommandOptions proxy + , fcoShowHelp = False + } + +fullCommandOptions :: Command c => proxy c -> [ OptDescr (FullCommandOptions c -> FullCommandOptions c) ] +fullCommandOptions proxy = + map (fmap $ \f fco -> fco { fcoSpecific = f (fcoSpecific fco) } ) (commandOptions proxy) + ++ + [ Option [ 'h' ] [ "help" ] + (NoArg $ \opts -> opts { fcoShowHelp = True }) + "show this help and exit" + ] + runSomeCommand :: SomeCommandType -> [ String ] -> IO () runSomeCommand (SC tproxy) args = do let exitWithErrors errs = do - hPutStr stderr $ concat errs + hPutStrLn stderr $ concat errs <> "Try `minici " <> commandName tproxy <> " --help' for more information." exitFailure - (opts, cmdargs) <- case getOpt Permute (commandOptions tproxy) args of + (opts, cmdargs) <- case getOpt Permute (fullCommandOptions tproxy) args of (o, strargs, []) -> case runExcept $ argsFromStrings strargs of Left err -> exitWithErrors [ err <> "\n" ] - Right cmdargs -> return (foldl (flip id) (defaultCommandOptions tproxy) o, cmdargs) + Right cmdargs -> do + let fullOptions = foldl (flip id) (defaultFullOptions tproxy) o + return (fullOptions, cmdargs) (_, _, errs) -> exitWithErrors errs + when (fcoShowHelp opts) $ do + putStr $ usageInfo (T.unpack $ commandUsage tproxy) (fullCommandOptions tproxy) + exitSuccess + Just configPath <- findConfig config <- parseConfig configPath - let cmd = commandInit tproxy opts cmdargs + let cmd = commandInit tproxy (fcoSpecific opts) cmdargs let CommandExec exec = commandExec cmd flip runReaderT config exec |