Merge pull request #195 from input-output-hk/newhogy/merge-errors

Merge `LegacyClientCmdError` into `CmdError`

cardano-cli/cardano-cli.cabal

@@ -124,7 +124,11 @@ library
                         Cardano.CLI.Types.Common
                         Cardano.CLI.Types.Errors.CardanoAddressSigningKeyConversionError
                         Cardano.CLI.Types.Errors.CmdError
+                        Cardano.CLI.Types.Errors.EraBasedDelegationError
+                        Cardano.CLI.Types.Errors.EraBasedRegistrationError
+                        Cardano.CLI.Types.Errors.GovernanceActionsError
                         Cardano.CLI.Types.Errors.GovernanceCmdError
+                        Cardano.CLI.Types.Errors.GovernanceCommitteeError
                         Cardano.CLI.Types.Errors.GovernanceVoteCmdError
                         Cardano.CLI.Types.Errors.ItnKeyConversionError
                         Cardano.CLI.Types.Errors.ProtocolParamsError

cardano-cli/src/Cardano/CLI/EraBased/Commands.hs

@@ -2,8 +2,9 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.EraBased.Commands
-  ( EraBasedCommand (..)
-  , AnyEraCommand (..)
+  ( AnyEraCommand (..)
+  , EraBasedCommand (..)
+  , renderAnyEraCommand
   , renderEraBasedCommand
   , pAnyEraCommand
   , pEraBasedCommand
@@ -23,6 +24,10 @@ import qualified Options.Applicative as Opt
 data AnyEraCommand where
   AnyEraCommandOf :: ShelleyBasedEra era -> EraBasedCommand era -> AnyEraCommand
 
+renderAnyEraCommand :: AnyEraCommand -> Text
+renderAnyEraCommand = \case
+  AnyEraCommandOf _ cmd -> renderEraBasedCommand cmd
+
 newtype EraBasedCommand era
   = EraBasedGovernanceCmds (EraBasedGovernanceCmds era)
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Actions.hs

@@ -14,7 +14,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Governance.Actions
 import           Cardano.CLI.Types.Common
-import           Cardano.CLI.Types.Errors.CmdError
+import           Cardano.CLI.Types.Errors.GovernanceActionsError
 import           Cardano.CLI.Types.Key
 
 import           Control.Monad.Except (ExceptT)

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/Committee.hs

@@ -10,7 +10,7 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Governance.Committee
-import           Cardano.CLI.Types.Errors.CmdError
+import           Cardano.CLI.Types.Errors.GovernanceCommitteeError
 import           Cardano.CLI.Types.Key
 import           Cardano.CLI.Types.Key.VerificationKey
 

cardano-cli/src/Cardano/CLI/EraBased/Run/Governance/DRep.hs

@@ -20,6 +20,8 @@ import           Cardano.CLI.EraBased.Run.Governance
 import           Cardano.CLI.Read
 import           Cardano.CLI.Types.Common
 import           Cardano.CLI.Types.Errors.CmdError
+import           Cardano.CLI.Types.Errors.EraBasedDelegationError
+import           Cardano.CLI.Types.Errors.EraBasedRegistrationError
 import           Cardano.CLI.Types.Errors.GovernanceCmdError
 import           Cardano.CLI.Types.Key
 

cardano-cli/src/Cardano/CLI/Legacy/Run.hs

@@ -1,13 +1,9 @@
 {-# LANGUAGE LambdaCase #-}
 
 module Cardano.CLI.Legacy.Run
-  ( LegacyClientCmdError
-  , renderLegacyClientCmdError
-  , runLegacyCmds
+  ( runLegacyCmds
   ) where
 
-import           Cardano.Api
-
 import           Cardano.CLI.Legacy.Options
 import           Cardano.CLI.Legacy.Run.Address
 import           Cardano.CLI.Legacy.Run.Genesis
@@ -19,80 +15,20 @@ import           Cardano.CLI.Legacy.Run.Query
 import           Cardano.CLI.Legacy.Run.StakeAddress
 import           Cardano.CLI.Legacy.Run.TextView
 import           Cardano.CLI.Legacy.Run.Transaction
-import           Cardano.CLI.Types.Errors.GovernanceCmdError
-import           Cardano.CLI.Types.Errors.ShelleyAddressCmdError
-import           Cardano.CLI.Types.Errors.ShelleyGenesisCmdError
-import           Cardano.CLI.Types.Errors.ShelleyKeyCmdError
-import           Cardano.CLI.Types.Errors.ShelleyNodeCmdError
-import           Cardano.CLI.Types.Errors.ShelleyPoolCmdError
-import           Cardano.CLI.Types.Errors.ShelleyQueryCmdError
-import           Cardano.CLI.Types.Errors.ShelleyTextViewFileError
-import           Cardano.CLI.Types.Errors.ShelleyTxCmdError
+import           Cardano.CLI.Types.Errors.CmdError
 
 import           Control.Monad.Trans.Except (ExceptT)
 import           Control.Monad.Trans.Except.Extra (firstExceptT)
-import           Data.Text (Text)
-import qualified Data.Text as Text
-
-data LegacyClientCmdError
-  = LegacyCmdAddressError !ShelleyAddressCmdError
-  | LegacyCmdGenesisError !ShelleyGenesisCmdError
-  | LegacyCmdGovernanceError !GovernanceCmdError
-  | LegacyCmdNodeError !ShelleyNodeCmdError
-  | LegacyCmdPoolError !ShelleyPoolCmdError
-  | LegacyCmdStakeAddressError !ShelleyStakeAddressCmdError
-  | LegacyCmdTextViewError !ShelleyTextViewFileError
-  | LegacyCmdTransactionError !ShelleyTxCmdError
-  | LegacyCmdQueryError !ShelleyQueryCmdError
-  | LegacyCmdKeyError !ShelleyKeyCmdError
-
-renderLegacyClientCmdError :: LegacyCmds -> LegacyClientCmdError -> Text
-renderLegacyClientCmdError cmd err =
-  case err of
-    LegacyCmdAddressError addrCmdErr ->
-       renderError cmd renderShelleyAddressCmdError addrCmdErr
-    LegacyCmdGenesisError genesisCmdErr ->
-       renderError cmd (Text.pack . displayError) genesisCmdErr
-    LegacyCmdGovernanceError govCmdErr ->
-       renderError cmd (Text.pack . displayError) govCmdErr
-    LegacyCmdNodeError nodeCmdErr ->
-       renderError cmd renderShelleyNodeCmdError nodeCmdErr
-    LegacyCmdPoolError poolCmdErr ->
-       renderError cmd renderShelleyPoolCmdError poolCmdErr
-    LegacyCmdStakeAddressError stakeAddrCmdErr ->
-       renderError cmd (Text.pack . displayError) stakeAddrCmdErr
-    LegacyCmdTextViewError txtViewErr ->
-       renderError cmd renderShelleyTextViewFileError txtViewErr
-    LegacyCmdTransactionError txErr ->
-       renderError cmd renderShelleyTxCmdError txErr
-    LegacyCmdQueryError queryErr ->
-       renderError cmd renderShelleyQueryCmdError queryErr
-    LegacyCmdKeyError keyErr ->
-       renderError cmd renderShelleyKeyCmdError keyErr
-  where
-    renderError :: LegacyCmds -> (a -> Text) -> a -> Text
-    renderError shelleyCmd renderer shelCliCmdErr =
-      mconcat
-        [ "Command failed: "
-        , renderLegacyCommand shelleyCmd
-        , "  Error: "
-        , renderer shelCliCmdErr
-        ]
-
-
---
--- CLI shelley command dispatch
---
 
-runLegacyCmds :: LegacyCmds -> ExceptT LegacyClientCmdError IO ()
+runLegacyCmds :: LegacyCmds -> ExceptT CmdError IO ()
 runLegacyCmds = \case
-  LegacyAddressCmds      cmd -> firstExceptT LegacyCmdAddressError $ runAddressCmds cmd
-  LegacyStakeAddressCmds cmd -> firstExceptT LegacyCmdStakeAddressError $ runStakeAddressCmds cmd
-  LegacyKeyCmds          cmd -> firstExceptT LegacyCmdKeyError $ runKeyCmds cmd
-  LegacyTransactionCmds  cmd -> firstExceptT LegacyCmdTransactionError $ runTransactionCmds cmd
-  LegacyNodeCmds         cmd -> firstExceptT LegacyCmdNodeError $ runNodeCmds cmd
-  LegacyPoolCmds         cmd -> firstExceptT LegacyCmdPoolError $ runPoolCmds cmd
-  LegacyQueryCmds        cmd -> firstExceptT LegacyCmdQueryError $ runQueryCmds cmd
-  LegacyGovernanceCmds   cmd -> firstExceptT LegacyCmdGovernanceError $ runGovernanceCmds cmd
-  LegacyGenesisCmds      cmd -> firstExceptT LegacyCmdGenesisError $ runGenesisCmds cmd
-  LegacyTextViewCmds     cmd -> firstExceptT LegacyCmdTextViewError $ runTextViewCmds cmd
+  LegacyAddressCmds      cmd -> firstExceptT CmdAddressError $ runAddressCmds cmd
+  LegacyGenesisCmds      cmd -> firstExceptT CmdGenesisError $ runGenesisCmds cmd
+  LegacyGovernanceCmds   cmd -> firstExceptT CmdGovernanceCmdError $ runGovernanceCmds cmd
+  LegacyKeyCmds          cmd -> firstExceptT CmdKeyError $ runKeyCmds cmd
+  LegacyNodeCmds         cmd -> firstExceptT CmdNodeError $ runNodeCmds cmd
+  LegacyPoolCmds         cmd -> firstExceptT CmdPoolError $ runPoolCmds cmd
+  LegacyQueryCmds        cmd -> firstExceptT CmdQueryError $ runQueryCmds cmd
+  LegacyStakeAddressCmds cmd -> firstExceptT CmdStakeAddressError $ runStakeAddressCmds cmd
+  LegacyTextViewCmds     cmd -> firstExceptT CmdTextViewError $ runTextViewCmds cmd
+  LegacyTransactionCmds  cmd -> firstExceptT CmdTransactionError $ runTransactionCmds cmd

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

@@ -9,16 +9,13 @@ module Cardano.CLI.Run
   , runClientCommand
   ) where
 
-import           Cardano.Api (Error (..))
-
 import           Cardano.CLI.Byron.Commands (ByronCommand)
 import           Cardano.CLI.Byron.Run (ByronClientCmdError, renderByronClientCmdError,
                    runByronClientCommand)
 import           Cardano.CLI.EraBased.Commands
 import           Cardano.CLI.EraBased.Run
-import           Cardano.CLI.Legacy.Commands (LegacyCmds)
-import           Cardano.CLI.Legacy.Run (LegacyClientCmdError, renderLegacyClientCmdError,
-                   runLegacyCmds)
+import           Cardano.CLI.Legacy.Commands
+import           Cardano.CLI.Legacy.Run (runLegacyCmds)
 import           Cardano.CLI.Render (customRenderHelp)
 import           Cardano.CLI.Run.Ping (PingClientCmdError (..), PingCmd (..),
                    renderPingClientCmdError, runPingCmd)
@@ -58,34 +55,31 @@ data ClientCommand =
   | DisplayVersion
 
 data ClientCommandErrors
-  = CmdError CmdError
-  | ByronClientError ByronClientCmdError
-  | LegacyClientError LegacyCmds LegacyClientCmdError
+  = ByronClientError ByronClientCmdError
+  | CmdError Text CmdError
   | PingClientError PingClientCmdError
 
 runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO ()
 runClientCommand = \case
-  AnyEraCommand cmd ->
-    firstExceptT CmdError $ runAnyEraCommand cmd
-  ByronCommand c ->
-    firstExceptT ByronClientError $ runByronClientCommand c
-  LegacyCmds c ->
-    firstExceptT (LegacyClientError c) $ runLegacyCmds c
-  CliPingCommand c ->
-    firstExceptT PingClientError $ runPingCmd c
+  AnyEraCommand cmds ->
+    firstExceptT (CmdError (renderAnyEraCommand cmds)) $ runAnyEraCommand cmds
+  ByronCommand cmds ->
+    firstExceptT ByronClientError $ runByronClientCommand cmds
+  LegacyCmds cmds ->
+    firstExceptT (CmdError (renderLegacyCommand cmds)) $ runLegacyCmds cmds
+  CliPingCommand cmds ->
+    firstExceptT PingClientError $ runPingCmd cmds
   Help pprefs allParserInfo ->
     runHelp pprefs allParserInfo
   DisplayVersion ->
     runDisplayVersion
 
 renderClientCommandError :: ClientCommandErrors -> Text
 renderClientCommandError = \case
-  CmdError err ->
-    Text.pack $ displayError err
+  CmdError cmdText err ->
+    renderCmdError cmdText err
   ByronClientError err ->
     renderByronClientCmdError err
-  LegacyClientError cmd err ->
-    renderLegacyClientCmdError cmd err
   PingClientError err ->
     renderPingClientCmdError err