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 |