Improved formatting:

* Switch to prettyprinter library
* Tracing
* Command for printing all help
* Option ordering note on build-raw command

bench/tx-generator/test/Main.hs

@@ -1,5 +1,7 @@
+{-# LANGUAGE ImportQualifiedPost #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE Trustworthy #-}
+
 module Main (main) where
 
 import           Prelude
@@ -12,7 +14,11 @@ import           Options.Applicative
 import           Cardano.Benchmarking.Command (commandParser)
 import           Cardano.Benchmarking.CliArgsScript (parseGeneratorCmd)
 import           Cardano.Benchmarking.GeneratorTx.SizedMetadata
+import           Hedgehog ((===))
+
+import           Test.Tasty.Hedgehog (testProperty)
 
+import           Hedgehog qualified as H
 
 main :: IO ()
 main = defaultMain tests
@@ -43,8 +49,8 @@ sizedMetadata = testGroup "properties of the CBOR encoding relevant for generati
 cliArgs = testGroup "cli arguments"
   [
      -- Also update readme and documentation when the help-messages changes.
-    testCase "check help message against pinned version"
-      $ assertBool "help message == pinned help message" $ helpMessage == pinnedHelpMessage
+    testProperty "check help message against pinned version"
+      $ H.withTests 1 $ H.property $ H.test $ filter (/= ' ') helpMessage === filter (/= ' ') pinnedHelpMessage
 
      -- examples for calling the tx-generator found in the shell scripts.
   , testCmdLine [here|cliArguments --config /work/cli-tests/benchmarks/shelley3pools/configuration/configuration-generator.yaml --socket-path /work/cli-tests/benchmarks/shelley3pools/logs/sockets/1 --num-of-txs 1000 --add-tx-size 0 --inputs-per-tx 1 --outputs-per-tx 1 --tx-fee 1000000 --tps 10 --init-cooldown 5 --target-node ("127.0.0.1",3000) --target-node ("127.0.0.1",3001) --target-node ("127.0.0.1",3002) --genesis-funds-key configuration/genesis-shelley/utxo-keys/utxo1.skey|]
@@ -56,15 +62,23 @@ cliArgs = testGroup "cli arguments"
     testCmdLine l = testCase "check that example cmd line parses" $ assertBool l $ isJust
                         $ getParseResult $ execParserPure defaultPrefs (info commandParser fullDesc)
                            $ words l
-pinnedHelpMessage = [here|ParserFailure(Usage: <program> --config FILEPATH --socket-path FILEPATH 
-                 [--shelley | --mary | --allegra] [(--target-node (HOST,PORT))] 
-                 [--init-cooldown INT] [--initial-ttl INT] [--num-of-txs INT] 
-                 [--tps DOUBLE] [--inputs-per-tx INT] [--outputs-per-tx INT] 
-                 [--tx-fee INT] [--add-tx-size INT] 
-                 [--fail-on-submission-errors] 
-                 (--genesis-funds-key FILEPATH | --utxo-funds-key FILEPATH
-                   --tx-in TX-IN --tx-out TX-OUT |
-                   --split-utxo-funds-key FILEPATH --split-utxo FILEPATH)
+pinnedHelpMessage = [here|ParserFailure(Usage: <program> --config FILEPATH
+                   --socket-path FILEPATH
+                   [--shelley | --mary | --allegra]
+                   [(--target-node (HOST,PORT))]
+                   [--init-cooldown INT]
+                   [--initial-ttl INT]
+                   [--num-of-txs INT]
+                   [--tps DOUBLE]
+                   [--inputs-per-tx INT]
+                   [--outputs-per-tx INT]
+                   [--tx-fee INT]
+                   [--add-tx-size INT]
+                   [--fail-on-submission-errors]
+                   ( --genesis-funds-key FILEPATH
+                   | --utxo-funds-key FILEPATH --tx-in TX-IN --tx-out TX-OUT
+                   | --split-utxo-funds-key FILEPATH --split-utxo FILEPATH
+                   )
 
 Available options:
   --config FILEPATH        Configuration file for the cardano-node

bench/tx-generator/tx-generator.cabal

@@ -137,10 +137,12 @@ test-suite tx-generator-test
   type:                 exitcode-stdio-1.0
 
   build-depends:        base >=4.12 && <5
-                      , tasty-hunit
-                      , tasty
+                      , hedgehog
                       , heredoc
                       , optparse-applicative
+                      , tasty
+                      , tasty-hedgehog
+                      , tasty-hunit
                       , tx-generator
 
   default-language:     Haskell2010

cabal.project

@@ -107,6 +107,20 @@ package cardano-ledger-alonzo-test
 -- --------------------------- 8< --------------------------
 -- Please do not put any `source-repository-package` clause above this line.
 
+-- Using a fork until our patches can be merged upstream
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/optparse-applicative
+  tag: 3876479d01d681ee529d1b26784335cbe0baf7cd
+  --sha256: 00gavws6jvl930rq09gs5rdwmyc4n42avk7p9s7pjv52d205v967
+
+-- Using a fork until our patches can be merged upstream
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/criterion
+  tag: fb2e7be532db96255d203f86360230cae37130f3
+  --sha256: 14r9zkfa8zslky3969gaq27gi7yi9rlqv0h1iq7zam9l15z53vhr
+
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/hedgehog-extras

cardano-cli/cardano-cli.cabal

@@ -52,6 +52,7 @@ library
 
   exposed-modules:      Cardano.CLI.Helpers
                         Cardano.CLI.Parsers
+                        Cardano.CLI.Render
                         Cardano.CLI.Run
                         Cardano.CLI.Run.Friendly
                         Cardano.CLI.Types
@@ -132,6 +133,7 @@ library
                       , ouroboros-network
                       , parsec
                       , plutus-ledger-api
+                      , prettyprinter
                       , shelley-spec-ledger
                       , small-steps
                       , split

cardano-cli/src/Cardano/CLI/Parsers.hs

@@ -1,17 +1,20 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 module Cardano.CLI.Parsers
   ( opts
   , pref
   ) where
 
 import           Cardano.Prelude
-import           Prelude (String)
-
-import           Options.Applicative
-import qualified Options.Applicative as Opt
-
 import           Cardano.CLI.Byron.Parsers (backwardsCompatibilityCommands, parseByronCommands)
+import           Cardano.CLI.Render (customRenderHelp)
 import           Cardano.CLI.Run (ClientCommand (..))
 import           Cardano.CLI.Shelley.Parsers (parseShelleyCommands)
+import           Options.Applicative
+import           Prelude (String)
+
+import qualified Options.Applicative as Opt
 
 command' :: String -> String -> Parser a -> Mod CommandFields a
 command' c descr p =
@@ -29,7 +32,10 @@ opts =
     )
 
 pref :: ParserPrefs
-pref = Opt.prefs showHelpOnEmpty
+pref = Opt.prefs $ mempty
+  <> showHelpOnEmpty
+  <> helpHangUsageOverflow 10
+  <> helpRenderHelp customRenderHelp
 
 parseClientCommand :: Parser ClientCommand
 parseClientCommand =
@@ -41,7 +47,7 @@ parseClientCommand =
     , parseByron
     , parseDeprecatedShelleySubcommand
     , backwardsCompatibilityCommands
-    , parseDisplayVersion
+    , parseDisplayVersion opts
     ]
 
 parseByron :: Parser ClientCommand
@@ -78,12 +84,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"

cardano-cli/src/Cardano/CLI/Render.hs

@@ -0,0 +1,48 @@
+module Cardano.CLI.Render
+  ( customRenderHelp
+  ) where
+
+import           Cardano.Prelude
+import           Data.Function (id)
+import           Options.Applicative
+import           Options.Applicative.Help.Ann
+import           Options.Applicative.Help.Types (helpText)
+import           Prelude (String)
+import           Prettyprinter
+import           Prettyprinter.Render.Util.SimpleDocTree
+
+import qualified Data.Text as T
+import qualified System.Environment as IO
+import qualified System.IO.Unsafe as IO
+
+cliHelpTraceEnabled :: Bool
+cliHelpTraceEnabled = IO.unsafePerformIO $ do
+  mValue <- IO.lookupEnv "CLI_HELP_TRACE"
+  return $ mValue == Just "1"
+{-# NOINLINE cliHelpTraceEnabled #-}
+
+-- | Convert a help text to 'String'.  When the CLI_HELP_TRACE environment variable is set
+-- to '1', the output will be in HTML so that it can be viewed in a browser where developer
+-- tools can be used to inspect tracing that aids in describing the structure of the output
+-- document.
+customRenderHelp :: Int -> ParserHelp -> String
+customRenderHelp cols
+  = T.unpack
+  . wrapper
+  . renderSimplyDecorated id renderElement
+  . treeForm
+  . layoutSmart (LayoutOptions (AvailablePerLine cols 1.0))
+  . helpText
+  where
+    renderElement = if cliHelpTraceEnabled
+      then \(AnnTrace _ name) x -> "<span name=" <> show name <> ">" <> x <> "</span>"
+      else flip const
+    wrapper = if cliHelpTraceEnabled
+      then id
+        . ("<html>\n" <>)
+        . ("<body>\n" <>)
+        . ("<pre>\n" <>)
+        . (<> "\n</html>")
+        . (<> "\n</body>")
+        . (<> "\n</pre>")
+      else id

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
 
@@ -20,10 +22,17 @@ import           Cardano.CLI.Shelley.Commands (ShelleyCommand)
 import           Cardano.CLI.Shelley.Run (ShelleyClientCmdError, renderShelleyClientCmdError,
                    runShelleyClientCommand)
 
+import           Cardano.CLI.Render (customRenderHelp)
+
 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 qualified Data.List as L
+import qualified System.IO as IO
 
 -- | Sub-commands of 'cardano-cli'.
 data ClientCommand =
@@ -38,8 +47,8 @@ data ClientCommand =
     -- now-deprecated \"shelley\" subcommand.
   | DeprecatedShelleySubcommand ShelleyCommand
 
+  | forall a. Help ParserPrefs (ParserInfo a)
   | DisplayVersion
-  deriving Show
 
 data ClientCommandErrors
   = ByronClientError ByronClientCmdError
@@ -53,6 +62,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 +101,30 @@ runDisplayVersion = do
                 ]
   where
     renderVersion = Text.pack . showVersion
+
+
+helpAll :: ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
+helpAll pprefs progn rnames parserInfo = do
+  IO.putStrLn $ customRenderHelp 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

cardano-cli/src/Cardano/CLI/Shelley/Parsers.hs

@@ -34,6 +34,7 @@ import           Data.Time.Format (defaultTimeLocale, iso8601DateFormat, parseTi
 import           Network.Socket (PortNumber)
 import           Options.Applicative hiding (help, str)
 import           Ouroboros.Consensus.BlockchainTime (SystemStart (..))
+import           Prettyprinter (line, pretty)
 
 import qualified Data.ByteString.Base16 as B16
 import qualified Data.ByteString.Char8 as BSC
@@ -557,9 +558,17 @@ pTransaction :: Parser TransactionCmd
 pTransaction =
   asum
     [ subParser "build-raw"
-        (Opt.info pTransactionBuildRaw $ Opt.progDesc "Build a transaction (low-level, inconvenient)")
+        $ Opt.info pTransactionBuildRaw $ Opt.progDescDoc $ Just $
+          pretty @String "Build a transaction (low-level, inconvenient)"
+          <> line <> line
+          <> "Please note the order of some cmd options is crucial. If used incorrectly may produce "
+          <> "undesired tx body. See nested [] notation above for details."
     , subParser "build"
-        (Opt.info pTransactionBuild $ Opt.progDesc "Build a balanced transaction (automatically calculates fees)")
+        $ Opt.info pTransactionBuild $ Opt.progDescDoc $ Just $
+          pretty @String "Build a balanced transaction (automatically calculates fees)"
+          <> line <> line
+          <> "Please note the order of some cmd options is crucial. If used incorrectly may produce "
+          <> "undesired tx body. See nested [] notation above for details."
     , subParser "sign"
         (Opt.info pTransactionSign $ Opt.progDesc "Sign a transaction")
     , subParser "witness"

cardano-node/src/Cardano/Node/Parsers.hs

@@ -282,4 +282,4 @@ parserHelpOptions = fromMaybe mempty . OptI.unChunk . OptI.fullDesc (Opt.prefs m
 -- | Render the help pretty document.
 renderHelpDoc :: Int -> OptI.Doc -> String
 renderHelpDoc cols =
-  (`OptI.displayS` "") . OptI.renderPretty 1.0 cols
+  (`OptI.renderShowS` "") . OptI.layoutPretty (OptI.LayoutOptions (OptI.AvailablePerLine cols 1.0))