List sub parsers

IntersectMBO · Jul 22, 2021 · d75b9e2 · d75b9e2
1 parent 02c13b2
commit d75b9e2
Show file tree

Hide file tree

Showing 2 changed files with 44 additions and 4 deletions.
diff --git a/cardano-cli/src/Cardano/CLI/Parsers.hs b/cardano-cli/src/Cardano/CLI/Parsers.hs
@@ -84,7 +84,7 @@ parseClientCommand =
     , parseByron
     , parseDeprecatedShelleySubcommand
     , backwardsCompatibilityCommands
-    , parseDisplayVersion
+    , parseDisplayVersion opts
     ]
 
 parseByron :: Parser ClientCommand
@@ -121,12 +121,16 @@ parseDeprecatedShelleySubcommand =
     ]
 
 -- Yes! A --version flag or version command. Either guess is right!
-parseDisplayVersion :: Parser ClientCommand
-parseDisplayVersion =
+parseDisplayVersion :: ParserInfo a -> Parser ClientCommand
+parseDisplayVersion allParserInfo =
       subparser
         (mconcat
          [ commandGroup "Miscellaneous commands"
          , metavar "Miscellaneous commands"
+         , command'
+           "help"
+           "Show all help"
+           (pure (Help pref allParserInfo))
          , command'
            "version"
            "Show the cardano-cli version"

diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs #-}
 
 -- | Dispatch for running all the CLI commands
 module Cardano.CLI.Run
@@ -10,6 +11,7 @@ module Cardano.CLI.Run
 import           Cardano.Prelude
 
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
+import           Data.String
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
 
@@ -24,6 +26,12 @@ import           Cardano.Config.Git.Rev (gitRev)
 import           Data.Version (showVersion)
 import           Paths_cardano_cli (version)
 import           System.Info (arch, compilerName, compilerVersion, os)
+import           Options.Applicative.Types (Option (..), OptReader (..), Parser (..), ParserInfo (..), ParserPrefs (..))
+import           Options.Applicative.Help.Core
+import           Options.Applicative.Help.Types (renderHelp)
+
+import qualified Data.List as L
+import qualified System.IO as IO
 
 -- | Sub-commands of 'cardano-cli'.
 data ClientCommand =
@@ -38,8 +46,8 @@ data ClientCommand =
     -- now-deprecated \"shelley\" subcommand.
   | DeprecatedShelleySubcommand ShelleyCommand
 
+  | forall a. Help ParserPrefs (ParserInfo a)
   | DisplayVersion
-  deriving Show
 
 data ClientCommandErrors
   = ByronClientError ByronClientCmdError
@@ -53,6 +61,7 @@ runClientCommand (DeprecatedShelleySubcommand c) =
   firstExceptT (ShelleyClientError c)
     $ runShelleyClientCommandWithDeprecationWarning
     $ runShelleyClientCommand c
+runClientCommand (Help pprefs allParserInfo) = runHelp pprefs allParserInfo
 runClientCommand DisplayVersion = runDisplayVersion
 
 renderClientCommandError :: ClientCommandErrors -> Text
@@ -91,3 +100,30 @@ runDisplayVersion = do
                 ]
   where
     renderVersion = Text.pack . showVersion
+
+
+helpAll :: ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
+helpAll pprefs progn rnames parserInfo = do
+  IO.putStrLn $ renderHelp 80 (usage_help parserInfo)
+  IO.putStrLn ""
+  go (infoParser parserInfo)
+  where go :: Parser a -> IO ()
+        go p = case p of
+          NilP _ -> return ()
+          OptP optP -> case optMain optP of
+            CmdReader _ cs f -> do
+              forM_ cs $ \c ->
+                forM_ (f c) $ \subParserInfo -> 
+                  helpAll pprefs progn (c:rnames) subParserInfo
+            _ -> return ()
+          AltP pa pb -> go pa >> go pb
+          MultP pf px -> go pf >> go px
+          BindP pa _ -> go pa
+        usage_help i =
+              mconcat
+              [ usageHelp (pure . parserUsage pprefs (infoParser i) . L.unwords $ progn : reverse rnames)
+              , descriptionHelp (infoProgDesc i)
+              ]
+
+runHelp :: ParserPrefs -> ParserInfo a -> ExceptT ClientCommandErrors IO ()
+runHelp pprefs allParserInfo = liftIO $ helpAll pprefs "cardano-cli" [] allParserInfo