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/Main.hs | 35 +++++++++++++++++++++++++++++++----
 1 file changed, 31 insertions(+), 4 deletions(-)

(limited to 'src/Main.hs')

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