From ccce704296792fb3efc7590e70b05cff52532258 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Tue, 30 Jul 2024 10:42:38 +0200
Subject: Help for subcommands

---
 src/Command.hs     |  2 ++
 src/Command/Run.hs |  9 +++++++++
 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
-- 
cgit v1.2.3