diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs index 382431bfb8..21ecfc3ea4 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands.hs @@ -3,11 +3,11 @@ module Cardano.CLI.EraBased.Commands ( AnyEraCommand (..) - , EraBasedCommand (..) + , Cmds (..) , renderAnyEraCommand - , renderEraBasedCommand + , renderCmds , pAnyEraCommand - , pEraBasedCommand + , pCmds ) where import Cardano.Api (CardanoEra (..), ShelleyBasedEra (..)) @@ -27,21 +27,21 @@ import Options.Applicative (Parser) import qualified Options.Applicative as Opt data AnyEraCommand where - AnyEraCommandOf :: ShelleyBasedEra era -> EraBasedCommand era -> AnyEraCommand + AnyEraCommandOf :: ShelleyBasedEra era -> Cmds era -> AnyEraCommand renderAnyEraCommand :: AnyEraCommand -> Text renderAnyEraCommand = \case - AnyEraCommandOf _ cmd -> renderEraBasedCommand cmd + AnyEraCommandOf _ cmd -> renderCmds cmd -data EraBasedCommand era - = EraBasedGovernanceCmds (EraBasedGovernanceCmds era) - | TransactionCmds (TransactionCmds era) - | StakeAddressCmds (StakeAddressCmds era) +data Cmds era + = GovernanceCmds (GovernanceCmds era) + | StakeAddressCmds (StakeAddressCmds era) + | TransactionCmds (TransactionCmds era) -renderEraBasedCommand :: EraBasedCommand era -> Text -renderEraBasedCommand = \case - EraBasedGovernanceCmds cmd -> - renderEraBasedGovernanceCmds cmd +renderCmds :: Cmds era -> Text +renderCmds = \case + GovernanceCmds cmd -> + renderGovernanceCmds cmd StakeAddressCmds cmd -> renderStakeAddressCmds cmd TransactionCmds cmd -> @@ -53,35 +53,35 @@ pAnyEraCommand envCli = [ -- Note, byron is ommitted because there is already a legacy command group for it. subParser "shelley" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraShelley <$> pEraBasedCommand envCli ShelleyEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraShelley <$> pCmds envCli ShelleyEra) $ Opt.progDesc "Shelley era commands" , subParser "allegra" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraAllegra <$> pEraBasedCommand envCli AllegraEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraAllegra <$> pCmds envCli AllegraEra) $ Opt.progDesc "Allegra era commands" , subParser "mary" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraMary <$> pEraBasedCommand envCli MaryEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraMary <$> pCmds envCli MaryEra) $ Opt.progDesc "Mary era commands" , subParser "alonzo" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraAlonzo <$> pEraBasedCommand envCli AlonzoEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraAlonzo <$> pCmds envCli AlonzoEra) $ Opt.progDesc "Alonzo era commands" , subParser "babbage" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraBabbage <$> pEraBasedCommand envCli BabbageEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraBabbage <$> pCmds envCli BabbageEra) $ Opt.progDesc "Babbage era commands" , subParser "conway" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraConway <$> pEraBasedCommand envCli ConwayEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraConway <$> pCmds envCli ConwayEra) $ Opt.progDesc "Conway era commands" , subParser "latest" - $ Opt.info (AnyEraCommandOf ShelleyBasedEraBabbage <$> pEraBasedCommand envCli BabbageEra) + $ Opt.info (AnyEraCommandOf ShelleyBasedEraBabbage <$> pCmds envCli BabbageEra) $ Opt.progDesc "Latest era commands (Babbage)" ] -pEraBasedCommand :: EnvCli -> CardanoEra era -> Parser (EraBasedCommand era) -pEraBasedCommand envCli era = +pCmds :: EnvCli -> CardanoEra era -> Parser (Cmds era) +pCmds envCli era = asum $ catMaybes [ Just $ subParser "governance" - $ Opt.info (EraBasedGovernanceCmds <$> pEraBasedGovernanceCmds envCli era) + $ Opt.info (GovernanceCmds <$> pGovernanceCmds envCli era) $ Opt.progDesc "Era-based governance commands" , fmap StakeAddressCmds <$> pStakeAddressCmds era envCli , Just diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs index b9bf73ea99..79033712e8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Governance.hs @@ -3,8 +3,8 @@ {-# LANGUAGE LambdaCase #-} module Cardano.CLI.EraBased.Commands.Governance - ( EraBasedGovernanceCmds(..) - , renderEraBasedGovernanceCmds + ( GovernanceCmds(..) + , renderGovernanceCmds ) where import Cardano.Api @@ -18,44 +18,44 @@ import Cardano.CLI.Types.Common import Data.Text (Text) -data EraBasedGovernanceCmds era - = EraBasedGovernanceMIRPayStakeAddressesCertificate +data GovernanceCmds era + = GovernanceMIRPayStakeAddressesCertificate (ShelleyToBabbageEra era) MIRPot [StakeAddress] [Lovelace] (File () Out) - | EraBasedGovernanceMIRTransfer + | GovernanceMIRTransfer (ShelleyToBabbageEra era) Lovelace (File () Out) TransferDirection - | EraBasedGovernanceActionCmds + | GovernanceActionCmds (GovernanceActionCmds era) - | EraBasedGovernanceCommitteeCmds + | GovernanceCommitteeCmds (GovernanceCommitteeCmds era) - | EraBasedGovernanceDRepCmds + | GovernanceDRepCmds (GovernanceDRepCmds era) - | EraBasedGovernanceVoteCmds + | GovernanceVoteCmds (GovernanceVoteCmds era) - | EraBasedGovernanceQueryCmds + | GovernanceQueryCmds (GovernanceQueryCmds era) -renderEraBasedGovernanceCmds :: EraBasedGovernanceCmds era -> Text -renderEraBasedGovernanceCmds = \case - EraBasedGovernanceMIRPayStakeAddressesCertificate {} -> +renderGovernanceCmds :: GovernanceCmds era -> Text +renderGovernanceCmds = \case + GovernanceMIRPayStakeAddressesCertificate {} -> "governance create-mir-certificate stake-addresses" - EraBasedGovernanceMIRTransfer _ _ _ TransferToTreasury -> + GovernanceMIRTransfer _ _ _ TransferToTreasury -> "governance create-mir-certificate transfer-to-treasury" - EraBasedGovernanceMIRTransfer _ _ _ TransferToReserves -> + GovernanceMIRTransfer _ _ _ TransferToReserves -> "governance create-mir-certificate transfer-to-reserves" - EraBasedGovernanceActionCmds cmds -> + GovernanceActionCmds cmds -> renderGovernanceActionCmds cmds - EraBasedGovernanceCommitteeCmds cmds -> + GovernanceCommitteeCmds cmds -> renderGovernanceCommitteeCmds cmds - EraBasedGovernanceDRepCmds cmds -> + GovernanceDRepCmds cmds -> renderGovernanceDRepCmds cmds - EraBasedGovernanceVoteCmds cmds -> + GovernanceVoteCmds cmds -> renderGovernanceVoteCmds cmds - EraBasedGovernanceQueryCmds cmds -> + GovernanceQueryCmds cmds -> renderGovernanceQueryCmds cmds diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs index 04cebd8b87..0fefd5e5d9 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Governance.hs @@ -2,9 +2,9 @@ {-# LANGUAGE GADTs #-} module Cardano.CLI.EraBased.Options.Governance - ( EraBasedGovernanceCmds(..) - , renderEraBasedGovernanceCmds - , pEraBasedGovernanceCmds + ( GovernanceCmds(..) + , renderGovernanceCmds + , pGovernanceCmds ) where import Cardano.Api @@ -24,23 +24,18 @@ import Data.Maybe import Options.Applicative import qualified Options.Applicative as Opt -pEraBasedGovernanceCmds :: EnvCli -> CardanoEra era -> Parser (EraBasedGovernanceCmds era) -pEraBasedGovernanceCmds envCli era = +pGovernanceCmds :: EnvCli -> CardanoEra era -> Parser (GovernanceCmds era) +pGovernanceCmds envCli era = asum $ catMaybes [ pCreateMirCertificatesCmds era - , fmap EraBasedGovernanceQueryCmds <$> pGovernanceQueryCmds envCli era - , fmap EraBasedGovernanceActionCmds <$> pGovernanceActionCmds era - , fmap EraBasedGovernanceCommitteeCmds <$> pGovernanceCommitteeCmds era - , fmap EraBasedGovernanceDRepCmds <$> pGovernanceDRepCmds envCli era - , fmap EraBasedGovernanceVoteCmds <$> pGovernanceVoteCmds era + , fmap GovernanceQueryCmds <$> pGovernanceQueryCmds envCli era + , fmap GovernanceActionCmds <$> pGovernanceActionCmds era + , fmap GovernanceCommitteeCmds <$> pGovernanceCommitteeCmds era + , fmap GovernanceDRepCmds <$> pGovernanceDRepCmds envCli era + , fmap GovernanceVoteCmds <$> pGovernanceVoteCmds era ] --------------------------------------------------------------------------------- --- Vote related --------------------------------------------------------------------------------- - - -pCreateMirCertificatesCmds :: CardanoEra era -> Maybe (Parser (EraBasedGovernanceCmds era)) +pCreateMirCertificatesCmds :: CardanoEra era -> Maybe (Parser (GovernanceCmds era)) pCreateMirCertificatesCmds era = do w <- maybeFeatureInEra era pure @@ -50,7 +45,7 @@ pCreateMirCertificatesCmds era = do mirCertParsers :: () => ShelleyToBabbageEra era - -> Parser (EraBasedGovernanceCmds era) + -> Parser (GovernanceCmds era) mirCertParsers w = asum [ subParser "stake-addresses" @@ -66,9 +61,9 @@ mirCertParsers w = pMIRPayStakeAddresses :: () => ShelleyToBabbageEra era - -> Parser (EraBasedGovernanceCmds era) + -> Parser (GovernanceCmds era) pMIRPayStakeAddresses w = - EraBasedGovernanceMIRPayStakeAddressesCertificate w + GovernanceMIRPayStakeAddressesCertificate w <$> pMIRPot <*> some pStakeAddress <*> some pRewardAmt @@ -76,18 +71,18 @@ pMIRPayStakeAddresses w = pMIRTransferToTreasury :: () => ShelleyToBabbageEra era - -> Parser (EraBasedGovernanceCmds era) + -> Parser (GovernanceCmds era) pMIRTransferToTreasury w = - EraBasedGovernanceMIRTransfer w + GovernanceMIRTransfer w <$> pTransferAmt <*> pOutputFile <*> pure TransferToTreasury pMIRTransferToReserves :: () => ShelleyToBabbageEra era - -> Parser (EraBasedGovernanceCmds era) + -> Parser (GovernanceCmds era) pMIRTransferToReserves w = - EraBasedGovernanceMIRTransfer w + GovernanceMIRTransfer w <$> pTransferAmt <*> pOutputFile <*> pure TransferToReserves diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run.hs index 851623c1dd..ea4aef7a0b 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run.hs @@ -3,8 +3,8 @@ module Cardano.CLI.EraBased.Run ( runAnyEraCommand - , runEraBasedCommand - , runEraBasedGovernanceCmds + , runCmds + , runGovernanceCmds ) where import Cardano.Api @@ -30,44 +30,45 @@ runAnyEraCommand :: () -> ExceptT CmdError IO () runAnyEraCommand = \case AnyEraCommandOf sbe cmd -> - shelleyBasedEraConstraints sbe $ runEraBasedCommand cmd + shelleyBasedEraConstraints sbe $ runCmds cmd -runEraBasedCommand :: () - => EraBasedCommand era -> ExceptT CmdError IO () -runEraBasedCommand = \case - EraBasedGovernanceCmds cmd -> - runEraBasedGovernanceCmds cmd +runCmds :: () + => Cmds era + -> ExceptT CmdError IO () +runCmds = \case + GovernanceCmds cmd -> + runGovernanceCmds cmd StakeAddressCmds cmd -> runStakeAddressCmds cmd & firstExceptT CmdStakeAddressError TransactionCmds cmd -> runTransactionCmds cmd & firstExceptT CmdTransactionError -runEraBasedGovernanceCmds :: () - => EraBasedGovernanceCmds era +runGovernanceCmds :: () + => GovernanceCmds era -> ExceptT CmdError IO () -runEraBasedGovernanceCmds = \case - EraBasedGovernanceMIRPayStakeAddressesCertificate w mirpot vKeys rewards out -> +runGovernanceCmds = \case + GovernanceMIRPayStakeAddressesCertificate w mirpot vKeys rewards out -> runGovernanceMIRCertificatePayStakeAddrs w mirpot vKeys rewards out & firstExceptT CmdGovernanceCmdError - EraBasedGovernanceMIRTransfer w ll oFp direction -> + GovernanceMIRTransfer w ll oFp direction -> runGovernanceMIRCertificateTransfer w ll oFp direction & firstExceptT CmdGovernanceCmdError - EraBasedGovernanceCommitteeCmds cmds -> + GovernanceCommitteeCmds cmds -> runGovernanceCommitteeCmds cmds & firstExceptT CmdGovernanceCommitteeError - EraBasedGovernanceActionCmds cmds -> + GovernanceActionCmds cmds -> runGovernanceActionCmds cmds & firstExceptT CmdGovernanceActionError - EraBasedGovernanceDRepCmds cmds -> + GovernanceDRepCmds cmds -> runGovernanceDRepCmds cmds - EraBasedGovernanceVoteCmds cmds -> + GovernanceVoteCmds cmds -> runGovernanceVoteCmds cmds - EraBasedGovernanceQueryCmds cmds -> + GovernanceQueryCmds cmds -> runGovernanceQueryCmds cmds diff --git a/cardano-cli/src/Cardano/CLI/Options.hs b/cardano-cli/src/Cardano/CLI/Options.hs index cb8e8e0667..3de0e632d8 100644 --- a/cardano-cli/src/Cardano/CLI/Options.hs +++ b/cardano-cli/src/Cardano/CLI/Options.hs @@ -24,7 +24,6 @@ import Options.Applicative import qualified Options.Applicative as Opt import qualified Prettyprinter as PP - opts :: EnvCli -> ParserInfo ClientCommand opts envCli = Opt.info (parseClientCommand envCli <**> Opt.helper) $ mconcat @@ -83,7 +82,7 @@ parseLegacy envCli = _parseTopLevelLatest :: EnvCli -> Parser ClientCommand _parseTopLevelLatest envCli = - AnyEraCommand . AnyEraCommandOf ShelleyBasedEraBabbage <$> pEraBasedCommand envCli BabbageEra + AnyEraCommand . AnyEraCommandOf ShelleyBasedEraBabbage <$> pCmds envCli BabbageEra -- | Parse Legacy commands at the top level of the CLI. parseTopLevelLegacy :: EnvCli -> Parser ClientCommand