Merge pull request #5265 from input-output-hk/newhoggy/fix-cardano-te…

…stnet-cli-tests

Fix `cardano-testnet` CLI golden tests

cardano-testnet/app/cardano-testnet.hs

@@ -2,14 +2,13 @@ module Main where
 
 import qualified Cardano.Crypto.Init as Crypto
 
-import           Options.Applicative
-import           Testnet.Parsers
+import qualified Options.Applicative as Opt
+
+import           Testnet.Parsers (opts, pref, runTestnetCmd)
 
 main :: IO ()
 main = do
   Crypto.cryptoInit
 
-  tNetCmd <- customExecParser
-               (prefs $ showHelpOnEmpty <> showHelpOnError)
-               (info (commands <**> helper) idm)
+  tNetCmd <- Opt.customExecParser pref opts
   runTestnetCmd tNetCmd

cardano-testnet/cardano-testnet.cabal

@@ -84,6 +84,7 @@ library
   other-modules:        Parsers.Babbage
                         Parsers.Byron
                         Parsers.Cardano
+                        Parsers.Help
                         Parsers.Shelley
                         Parsers.Version
                         Testnet
@@ -98,6 +99,8 @@ library
 
   autogen-modules:      Paths_cardano_testnet
 
+
+
 executable cardano-testnet
   import:               project-config
 
@@ -120,23 +123,26 @@ test-suite cardano-testnet-golden
 
   other-modules:        Test.Golden.Testnet.Config
                         Test.Golden.Testnet.Help
+                        Test.Golden.Testnet.Util
 
   type:                 exitcode-stdio-1.0
 
   build-depends:        aeson
                       , aeson-pretty
                       , bytestring
                       , cardano-api
-                      , cardano-cli:cardano-cli-test-lib
                       , cardano-crypto-class
                       , cardano-testnet
+                      , exceptions
                       , filepath
                       , hedgehog
                       , hedgehog-extras ^>= 0.4.5.1
+                      , process
                       , regex-compat
                       , tasty
                       , tasty-hedgehog
                       , text
+                      , transformers
 
   ghc-options:          -threaded -rtsopts -with-rtsopts=-N -with-rtsopts=-T
 

cardano-testnet/src/Parsers/Help.hs

@@ -0,0 +1,51 @@
+module Parsers.Help
+  ( HelpOptions(..)
+  , cmdHelp
+  , runHelpOptions
+  ) where
+
+import           Control.Monad (forM_)
+import qualified Data.List as List
+import           Options.Applicative
+import           Options.Applicative.Help.Core
+import           Options.Applicative.Help.Types (renderHelp)
+import           Options.Applicative.Types (OptReader (..), Option (..), Parser (..))
+import qualified System.IO as IO
+
+import           Cardano.CLI.Common.Parsers
+
+data HelpOptions = HelpOptions
+  deriving (Eq, Show)
+
+optsHelp :: Parser HelpOptions
+optsHelp = pure HelpOptions
+
+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) . List.unwords $ progn : reverse rnames)
+      , descriptionHelp (infoProgDesc i)
+      ]
+
+runHelpOptions :: ParserPrefs -> ParserInfo a -> HelpOptions -> IO ()
+runHelpOptions pprefs allParserInfo HelpOptions {} = helpAll pprefs "cardano-testnet" [] allParserInfo
+
+cmdHelp :: Mod CommandFields HelpOptions
+cmdHelp = command' "help" "Show cardano-testnet help" optsHelp

cardano-testnet/src/Testnet/Parsers.hs

@@ -1,16 +1,29 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+
 module Testnet.Parsers
   ( commands
   , runTestnetCmd
+  , pref
+  , opts
   ) where
 
 import           Data.Foldable
 import           Options.Applicative
+import qualified Options.Applicative as Opt
 import           Parsers.Babbage
 import           Parsers.Byron
 import           Parsers.Cardano
+import           Parsers.Help
 import           Parsers.Shelley
 import           Parsers.Version
 
+pref :: ParserPrefs
+pref = Opt.prefs $ showHelpOnEmpty <> showHelpOnError
+
+opts :: ParserInfo CardanoTestnetCommands
+opts = Opt.info (commands <**> helper) idm
+
 -- TODO: Remove StartBabbageTestnet and StartShelleyTestnet
 -- by allowing the user to start testnets in any era (excluding Byron)
 -- via StartCardanoTestnet
@@ -20,19 +33,24 @@ data CardanoTestnetCommands
   | StartCardanoTestnet CardanoOptions
   | StartShelleyTestnet ShelleyOptions
   | GetVersion VersionOptions
+  | Help ParserPrefs (ParserInfo CardanoTestnetCommands) HelpOptions
 
 commands :: Parser CardanoTestnetCommands
 commands =
-  asum [ fmap StartCardanoTestnet (subparser cmdCardano)
-       , fmap StartByrontestnet (subparser cmdByron)
-       , fmap StartShelleyTestnet (subparser cmdShelley)
-       , fmap StartBabbageTestnet (subparser cmdBabbage)
-       , fmap GetVersion (subparser cmdVersion)
-       ]
+  asum
+    [ fmap StartCardanoTestnet (subparser cmdCardano)
+    , fmap StartByrontestnet (subparser cmdByron)
+    , fmap StartShelleyTestnet (subparser cmdShelley)
+    , fmap StartBabbageTestnet (subparser cmdBabbage)
+    , fmap GetVersion (subparser cmdVersion)
+    , fmap (Help pref opts) (subparser cmdHelp)
+    ]
 
 runTestnetCmd :: CardanoTestnetCommands -> IO ()
-runTestnetCmd (StartBabbageTestnet opts) = runBabbageOptions opts
-runTestnetCmd (StartByrontestnet opts) = runByronOptions opts
-runTestnetCmd (StartCardanoTestnet opts) = runCardanoOptions opts
-runTestnetCmd (StartShelleyTestnet opts) = runShelleyOptions opts
-runTestnetCmd (GetVersion opts) = runVersionOptions opts
+runTestnetCmd = \case
+  StartBabbageTestnet cmdOpts -> runBabbageOptions cmdOpts
+  StartByrontestnet cmdOpts -> runByronOptions cmdOpts
+  StartCardanoTestnet cmdOpts -> runCardanoOptions cmdOpts
+  StartShelleyTestnet cmdOpts -> runShelleyOptions cmdOpts
+  GetVersion cmdOpts -> runVersionOptions cmdOpts
+  Help pPrefs pInfo cmdOpts -> runHelpOptions pPrefs pInfo cmdOpts

cardano-testnet/test/cardano-testnet-golden/Test/Golden/Testnet/Help.hs

@@ -15,7 +15,7 @@ import           Data.Text (Text)
 import           Hedgehog (Property)
 import           Hedgehog.Extras.Stock.OS (isWin32)
 import           System.FilePath ((</>))
-import           Test.Cardano.CLI.Util
+import           Test.Golden.Testnet.Util
 import           Text.Regex (Regex, mkRegex, subRegex)
 
 import qualified Data.Char as Char
@@ -49,20 +49,20 @@ extractCmd = id
 golden_HelpAll :: Property
 golden_HelpAll =
   H.propertyOnce . H.moduleWorkspace "help" $ \_ -> do
-    -- These tests are not run on Windows because the cardano-cli usage
+    -- These tests are not run on Windows because the cardano-testnet usage
     -- output is slightly different on Windows.  For example it uses
-    -- "cardano-cli.exe" instead of "cardano-cli".
+    -- "cardano-testnet.exe" instead of "cardano-testnet".
     unless isWin32 $ do
       helpFp <- H.note "test/cardano-testnet-golden/files/golden/help.cli"
 
-      help <- filterAnsi <$> execCardanoCLI
+      help <- filterAnsi <$> execCardanoTestnet
         [ "help"
         ]
 
       H.diffVsGoldenFile help helpFp
 
-third :: (a, b, c) -> c
-third (_, _, c) = c
+second :: (a, b, c) -> b
+second (_, b, _) = b
 
 -- | Return the string with the prefix dropped if the prefix is present, otherwise return Nothing.
 selectAndDropPrefix :: Text -> Text -> Maybe Text
@@ -78,16 +78,16 @@ deselectSuffix suffix text =
     else Just text
 
 selectCmd :: Text -> Maybe Text
-selectCmd = selectAndDropPrefix "Usage: cardano-cli " <=< deselectSuffix " COMMAND"
+selectCmd = selectAndDropPrefix "Usage: cardano-testnet " <=< deselectSuffix " COMMAND"
 
 golden_HelpCmds :: Property
 golden_HelpCmds =
   H.propertyOnce . H.moduleWorkspace "help-commands" $ \_ -> do
-    -- These tests are not run on Windows because the cardano-cli usage
+    -- These tests are not run on Windows because the cardano-testnet usage
     -- output is slightly different on Windows.  For example it uses
-    -- "cardano-cli.exe" instead of "cardano-cli".
+    -- "cardano-testnet.exe" instead of "cardano-testnet".
     unless isWin32 $ do
-      help <- filterAnsi <$> execCardanoCLI
+      help <- filterAnsi <$> execCardanoTestnet
         [ "help"
         ]
 
@@ -98,6 +98,6 @@ golden_HelpCmds =
         H.noteShow_ usage
         let expectedCmdHelpFp = "test/cardano-testnet-golden/files/golden/help" </> Text.unpack (Text.intercalate "_" usage) <> ".cli"
 
-        cmdHelp <- filterAnsi . third <$> execDetailCardanoCli (fmap Text.unpack usage)
+        cmdHelp <- filterAnsi . second <$> execDetailCardanoTestnet (fmap Text.unpack usage <> ["--help"])
 
         H.diffVsGoldenFile cmdHelp expectedCmdHelpFp