module Bcc.CLI.Sophie.Run
  ( SophieClientCmdError
  , renderSophieClientCmdError
  , runSophieClientCommand
  ) where

import           Bcc.Prelude

import           Control.Monad.Trans.Except.Extra (firstExceptT)

import           Bcc.CLI.Sophie.Parsers

import           Bcc.CLI.Sophie.Run.Address
import           Bcc.CLI.Sophie.Run.Governance
import           Bcc.CLI.Sophie.Run.Key
import           Bcc.CLI.Sophie.Run.Node
import           Bcc.CLI.Sophie.Run.Pool
import           Bcc.CLI.Sophie.Run.Query
import           Bcc.CLI.Sophie.Run.StakeAddress
import           Bcc.CLI.Sophie.Run.Transaction
                                         -- Block, System, DevOps
import           Bcc.CLI.Sophie.Run.Genesis
import           Bcc.CLI.Sophie.Run.TextView

data SophieClientCmdError
  = SophieCmdAddressError !SophieAddressCmdError
  | SophieCmdGenesisError !SophieGenesisCmdError
  | SophieCmdGovernanceError !SophieGovernanceCmdError
  | SophieCmdNodeError !SophieNodeCmdError
  | SophieCmdPoolError !SophiePoolCmdError
  | SophieCmdStakeAddressError !SophieStakeAddressCmdError
  | SophieCmdTextViewError !SophieTextViewFileError
  | SophieCmdTransactionError !SophieTxCmdError
  | SophieCmdQueryError !SophieQueryCmdError
  | SophieCmdKeyError !SophieKeyCmdError
  deriving Int -> SophieClientCmdError -> ShowS
[SophieClientCmdError] -> ShowS
SophieClientCmdError -> String
(Int -> SophieClientCmdError -> ShowS)
-> (SophieClientCmdError -> String)
-> ([SophieClientCmdError] -> ShowS)
-> Show SophieClientCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieClientCmdError] -> ShowS
$cshowList :: [SophieClientCmdError] -> ShowS
show :: SophieClientCmdError -> String
$cshow :: SophieClientCmdError -> String
showsPrec :: Int -> SophieClientCmdError -> ShowS
$cshowsPrec :: Int -> SophieClientCmdError -> ShowS
Show

renderSophieClientCmdError :: SophieCommand -> SophieClientCmdError -> Text
renderSophieClientCmdError :: SophieCommand -> SophieClientCmdError -> Text
renderSophieClientCmdError SophieCommand
cmd SophieClientCmdError
err =
  case SophieClientCmdError
err of
    SophieCmdAddressError SophieAddressCmdError
addrCmdErr ->
       SophieCommand
-> (SophieAddressCmdError -> Text) -> SophieAddressCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieAddressCmdError -> Text
renderSophieAddressCmdError SophieAddressCmdError
addrCmdErr
    SophieCmdGenesisError SophieGenesisCmdError
genesisCmdErr ->
       SophieCommand
-> (SophieGenesisCmdError -> Text) -> SophieGenesisCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieGenesisCmdError -> Text
renderSophieGenesisCmdError SophieGenesisCmdError
genesisCmdErr
    SophieCmdGovernanceError SophieGovernanceCmdError
govCmdErr ->
       SophieCommand
-> (SophieGovernanceCmdError -> Text)
-> SophieGovernanceCmdError
-> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieGovernanceCmdError -> Text
renderSophieGovernanceError SophieGovernanceCmdError
govCmdErr
    SophieCmdNodeError SophieNodeCmdError
nodeCmdErr ->
       SophieCommand
-> (SophieNodeCmdError -> Text) -> SophieNodeCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieNodeCmdError -> Text
renderSophieNodeCmdError SophieNodeCmdError
nodeCmdErr
    SophieCmdPoolError SophiePoolCmdError
poolCmdErr ->
       SophieCommand
-> (SophiePoolCmdError -> Text) -> SophiePoolCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophiePoolCmdError -> Text
renderSophiePoolCmdError SophiePoolCmdError
poolCmdErr
    SophieCmdStakeAddressError SophieStakeAddressCmdError
stakeAddrCmdErr ->
       SophieCommand
-> (SophieStakeAddressCmdError -> Text)
-> SophieStakeAddressCmdError
-> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieStakeAddressCmdError -> Text
renderSophieStakeAddressCmdError SophieStakeAddressCmdError
stakeAddrCmdErr
    SophieCmdTextViewError SophieTextViewFileError
txtViewErr ->
       SophieCommand
-> (SophieTextViewFileError -> Text)
-> SophieTextViewFileError
-> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieTextViewFileError -> Text
renderSophieTextViewFileError SophieTextViewFileError
txtViewErr
    SophieCmdTransactionError SophieTxCmdError
txErr ->
       SophieCommand
-> (SophieTxCmdError -> Text) -> SophieTxCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieTxCmdError -> Text
renderSophieTxCmdError SophieTxCmdError
txErr
    SophieCmdQueryError SophieQueryCmdError
queryErr ->
       SophieCommand
-> (SophieQueryCmdError -> Text) -> SophieQueryCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieQueryCmdError -> Text
renderSophieQueryCmdError SophieQueryCmdError
queryErr
    SophieCmdKeyError SophieKeyCmdError
keyErr ->
       SophieCommand
-> (SophieKeyCmdError -> Text) -> SophieKeyCmdError -> Text
forall a. SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
cmd SophieKeyCmdError -> Text
renderSophieKeyCmdError SophieKeyCmdError
keyErr
 where
   renderError :: SophieCommand -> (a -> Text) -> a -> Text
   renderError :: SophieCommand -> (a -> Text) -> a -> Text
renderError SophieCommand
sophieCmd a -> Text
renderer a
shelCliCmdErr =
      [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat [ Text
"Command failed: "
              , SophieCommand -> Text
renderSophieCommand SophieCommand
sophieCmd
              , Text
"  Error: "
              , a -> Text
renderer a
shelCliCmdErr
              ]


--
-- CLI sophie command dispatch
--

runSophieClientCommand :: SophieCommand -> ExceptT SophieClientCmdError IO ()
runSophieClientCommand :: SophieCommand -> ExceptT SophieClientCmdError IO ()
runSophieClientCommand (AddressCmd      AddressCmd
cmd) = (SophieAddressCmdError -> SophieClientCmdError)
-> ExceptT SophieAddressCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieAddressCmdError -> SophieClientCmdError
SophieCmdAddressError (ExceptT SophieAddressCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieAddressCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ AddressCmd -> ExceptT SophieAddressCmdError IO ()
runAddressCmd AddressCmd
cmd
runSophieClientCommand (StakeAddressCmd StakeAddressCmd
cmd) = (SophieStakeAddressCmdError -> SophieClientCmdError)
-> ExceptT SophieStakeAddressCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieStakeAddressCmdError -> SophieClientCmdError
SophieCmdStakeAddressError (ExceptT SophieStakeAddressCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieStakeAddressCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ StakeAddressCmd -> ExceptT SophieStakeAddressCmdError IO ()
runStakeAddressCmd StakeAddressCmd
cmd
runSophieClientCommand (KeyCmd          KeyCmd
cmd) = (SophieKeyCmdError -> SophieClientCmdError)
-> ExceptT SophieKeyCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieKeyCmdError -> SophieClientCmdError
SophieCmdKeyError (ExceptT SophieKeyCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieKeyCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ KeyCmd -> ExceptT SophieKeyCmdError IO ()
runKeyCmd KeyCmd
cmd
runSophieClientCommand (TransactionCmd  TransactionCmd
cmd) = (SophieTxCmdError -> SophieClientCmdError)
-> ExceptT SophieTxCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieTxCmdError -> SophieClientCmdError
SophieCmdTransactionError (ExceptT SophieTxCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieTxCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ TransactionCmd -> ExceptT SophieTxCmdError IO ()
runTransactionCmd  TransactionCmd
cmd
runSophieClientCommand (NodeCmd         NodeCmd
cmd) = (SophieNodeCmdError -> SophieClientCmdError)
-> ExceptT SophieNodeCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieNodeCmdError -> SophieClientCmdError
SophieCmdNodeError (ExceptT SophieNodeCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieNodeCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ NodeCmd -> ExceptT SophieNodeCmdError IO ()
runNodeCmd NodeCmd
cmd
runSophieClientCommand (PoolCmd         PoolCmd
cmd) = (SophiePoolCmdError -> SophieClientCmdError)
-> ExceptT SophiePoolCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophiePoolCmdError -> SophieClientCmdError
SophieCmdPoolError (ExceptT SophiePoolCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophiePoolCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ PoolCmd -> ExceptT SophiePoolCmdError IO ()
runPoolCmd PoolCmd
cmd
runSophieClientCommand (QueryCmd        QueryCmd
cmd) = (SophieQueryCmdError -> SophieClientCmdError)
-> ExceptT SophieQueryCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieQueryCmdError -> SophieClientCmdError
SophieCmdQueryError (ExceptT SophieQueryCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieQueryCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ QueryCmd -> ExceptT SophieQueryCmdError IO ()
runQueryCmd QueryCmd
cmd
runSophieClientCommand (GovernanceCmd   GovernanceCmd
cmd) = (SophieGovernanceCmdError -> SophieClientCmdError)
-> ExceptT SophieGovernanceCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieGovernanceCmdError -> SophieClientCmdError
SophieCmdGovernanceError (ExceptT SophieGovernanceCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieGovernanceCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ GovernanceCmd -> ExceptT SophieGovernanceCmdError IO ()
runGovernanceCmd GovernanceCmd
cmd
runSophieClientCommand (GenesisCmd      GenesisCmd
cmd) = (SophieGenesisCmdError -> SophieClientCmdError)
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieGenesisCmdError -> SophieClientCmdError
SophieCmdGenesisError (ExceptT SophieGenesisCmdError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ GenesisCmd -> ExceptT SophieGenesisCmdError IO ()
runGenesisCmd GenesisCmd
cmd
runSophieClientCommand (TextViewCmd     TextViewCmd
cmd) = (SophieTextViewFileError -> SophieClientCmdError)
-> ExceptT SophieTextViewFileError IO ()
-> ExceptT SophieClientCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT SophieTextViewFileError -> SophieClientCmdError
SophieCmdTextViewError (ExceptT SophieTextViewFileError IO ()
 -> ExceptT SophieClientCmdError IO ())
-> ExceptT SophieTextViewFileError IO ()
-> ExceptT SophieClientCmdError IO ()
forall a b. (a -> b) -> a -> b
$ TextViewCmd -> ExceptT SophieTextViewFileError IO ()
runTextViewCmd TextViewCmd
cmd