diff --git a/cardano-cli/src/Cardano/CLI/Parsers.hs b/cardano-cli/src/Cardano/CLI/Parsers.hs index aa9ea825402..7a8d909448a 100644 --- a/cardano-cli/src/Cardano/CLI/Parsers.hs +++ b/cardano-cli/src/Cardano/CLI/Parsers.hs @@ -35,7 +35,7 @@ parseClientCommand :: Parser ClientCommand parseClientCommand = asum [ parseByron <|> backwardsCompatibilityCommands - , parseShelley + , parseShelley <|> parseDeprecatedShelleySubcommand , parseDisplayVersion ] @@ -51,15 +51,25 @@ parseByron = parseByronCommands ] +-- | Parse Shelley-related commands at the top level of the CLI. parseShelley :: Parser ClientCommand -parseShelley = +parseShelley = ShelleyCommand <$> parseShelleyCommands + +-- | Parse Shelley-related commands under the now-deprecated \"shelley\" +-- subcommand. +-- +-- Note that this subcommand is 'internal' and is therefore hidden from the +-- help text. +parseDeprecatedShelleySubcommand :: Parser ClientCommand +parseDeprecatedShelleySubcommand = subparser $ mconcat - [ commandGroup "Shelley specific commands" + [ commandGroup "Shelley specific commands (deprecated)" , metavar "Shelley specific commands" , command' "shelley" - "Shelley specific commands" - (ShelleyCommand <$> parseShelleyCommands) + "Shelley specific commands (deprecated)" + (DeprecatedShelleySubcommand <$> parseShelleyCommands) + , internal ] -- Yes! A --version flag or version command. Either guess is right! diff --git a/cardano-cli/src/Cardano/CLI/Run.hs b/cardano-cli/src/Cardano/CLI/Run.hs index e804af8791f..dc260a16ef1 100644 --- a/cardano-cli/src/Cardano/CLI/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Run.hs @@ -11,6 +11,7 @@ import Cardano.Prelude import Control.Monad.Trans.Except.Extra (firstExceptT) import qualified Data.Text as Text +import qualified Data.Text.IO as Text import Cardano.CLI.Byron.Commands (ByronCommand) import Cardano.CLI.Byron.Run (ByronClientCmdError, renderByronClientCmdError, @@ -33,6 +34,10 @@ data ClientCommand = -- | Shelley Related Commands | ShelleyCommand ShelleyCommand + -- | Shelley-related commands that have been parsed under the + -- now-deprecated \"shelley\" subcommand. + | DeprecatedShelleySubcommand ShelleyCommand + | DisplayVersion deriving Show @@ -45,6 +50,10 @@ data ClientCommandErrors runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO () runClientCommand (ByronCommand c) = firstExceptT ByronClientError $ runByronClientCommand c runClientCommand (ShelleyCommand c) = firstExceptT (ShelleyClientError c) $ runShelleyClientCommand c +runClientCommand (DeprecatedShelleySubcommand c) = + firstExceptT (ShelleyClientError c) + $ runShelleyClientCommandWithDeprecationWarning + $ runShelleyClientCommand c runClientCommand DisplayVersion = runDisplayVersion renderClientCommandError :: ClientCommandErrors -> Text @@ -53,6 +62,26 @@ renderClientCommandError (ByronClientError err) = renderClientCommandError (ShelleyClientError cmd err) = renderShelleyClientCmdError cmd err +-- | Combine an 'ExceptT' that will write a warning message to @stderr@ with +-- the provided 'ExceptT'. +ioExceptTWithWarning :: MonadIO m => Text -> ExceptT e m () -> ExceptT e m () +ioExceptTWithWarning warningMsg e = + liftIO (Text.hPutStrLn stderr warningMsg) >> e + +-- | Used in the event that Shelley-related commands are run using the +-- now-deprecated \"shelley\" subcommand. +runShelleyClientCommandWithDeprecationWarning + :: MonadIO m + => ExceptT e m () + -> ExceptT e m () +runShelleyClientCommandWithDeprecationWarning = + ioExceptTWithWarning warningMsg + where + warningMsg :: Text + warningMsg = + "WARNING: The \"shelley\" subcommand is now deprecated and will be " + <> "removed in the future. Please use the top-level commands instead." + runDisplayVersion :: ExceptT ClientCommandErrors IO () runDisplayVersion = do liftIO . putTextLn $ mconcat