summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2024-07-30 10:42:38 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2024-07-30 10:42:38 +0200
commitccce704296792fb3efc7590e70b05cff52532258 (patch)
tree881d680a5e0a76bc88b602b03b0f13497789e23f
parent3b025f4c1c82e3ce5d4b6017228af32aee9327ac (diff)
Help for subcommands
-rw-r--r--src/Command.hs2
-rw-r--r--src/Command/Run.hs9
-rw-r--r--src/Main.hs35
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