{-# LANGUAGE GADTs #-}

-- | Dispatch for running all the CLI commands
module Cardano.CLI.Run
  ( ClientCommand(..)
  , ClientCommandErrors
  , renderClientCommandError
  , runClientCommand
  ) where

import           Control.Monad (forM_)
import           Control.Monad.IO.Unlift (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT)
import           Control.Monad.Trans.Except.Extra (firstExceptT)
import qualified Data.List as L
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified System.IO as IO

import           Cardano.CLI.Byron.Commands (ByronCommand)
import           Cardano.CLI.Byron.Run (ByronClientCmdError, renderByronClientCmdError,
                   runByronClientCommand)
import           Cardano.CLI.Shelley.Commands (ShelleyCommand)
import           Cardano.CLI.Shelley.Run (ShelleyClientCmdError, renderShelleyClientCmdError,
                   runShelleyClientCommand)

import           Cardano.CLI.Render (customRenderHelp)

import           Cardano.Git.Rev (gitRev)
import           Data.Version (showVersion)
import           Options.Applicative.Help.Core
import           Options.Applicative.Types (OptReader (..), Option (..), Parser (..),
                   ParserInfo (..), ParserPrefs (..))
import           Paths_cardano_cli (version)
import           System.Info (arch, compilerName, compilerVersion, os)

-- | Sub-commands of 'cardano-cli'.
data ClientCommand =

    -- | Byron Related Commands
    ByronCommand ByronCommand

    -- | Shelley Related Commands
  | ShelleyCommand ShelleyCommand

    -- | Shelley-related commands that have been parsed under the
    -- now-deprecated \"shelley\" subcommand.
  | DeprecatedShelleySubcommand ShelleyCommand

  | forall a. Help ParserPrefs (ParserInfo a)
  | DisplayVersion

data ClientCommandErrors
  = ByronClientError ByronClientCmdError
  | ShelleyClientError ShelleyCommand ShelleyClientCmdError

runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO ()
runClientCommand :: ClientCommand -> ExceptT ClientCommandErrors IO ()
runClientCommand (ByronCommand ByronCommand
c) = forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronClientCmdError -> ClientCommandErrors
ByronClientError forall a b. (a -> b) -> a -> b
$ ByronCommand -> ExceptT ByronClientCmdError IO ()
runByronClientCommand ByronCommand
c
runClientCommand (ShelleyCommand ShelleyCommand
c) = forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyCommand -> ShelleyClientCmdError -> ClientCommandErrors
ShelleyClientError ShelleyCommand
c) forall a b. (a -> b) -> a -> b
$ ShelleyCommand -> ExceptT ShelleyClientCmdError IO ()
runShelleyClientCommand ShelleyCommand
c
runClientCommand (DeprecatedShelleySubcommand ShelleyCommand
c) =
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyCommand -> ShelleyClientCmdError -> ClientCommandErrors
ShelleyClientError ShelleyCommand
c)
    forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) e.
MonadIO m =>
ExceptT e m () -> ExceptT e m ()
runShelleyClientCommandWithDeprecationWarning
    forall a b. (a -> b) -> a -> b
$ ShelleyCommand -> ExceptT ShelleyClientCmdError IO ()
runShelleyClientCommand ShelleyCommand
c
runClientCommand (Help ParserPrefs
pprefs ParserInfo a
allParserInfo) = forall a.
ParserPrefs -> ParserInfo a -> ExceptT ClientCommandErrors IO ()
runHelp ParserPrefs
pprefs ParserInfo a
allParserInfo
runClientCommand ClientCommand
DisplayVersion = ExceptT ClientCommandErrors IO ()
runDisplayVersion

renderClientCommandError :: ClientCommandErrors -> Text
renderClientCommandError :: ClientCommandErrors -> Text
renderClientCommandError (ByronClientError ByronClientCmdError
err) =
  ByronClientCmdError -> Text
renderByronClientCmdError ByronClientCmdError
err
renderClientCommandError (ShelleyClientError ShelleyCommand
cmd ShelleyClientCmdError
err) =
  ShelleyCommand -> ShelleyClientCmdError -> Text
renderShelleyClientCmdError ShelleyCommand
cmd ShelleyClientCmdError
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 :: forall (m :: * -> *) e.
MonadIO m =>
Text -> ExceptT e m () -> ExceptT e m ()
ioExceptTWithWarning Text
warningMsg ExceptT e m ()
e =
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr Text
warningMsg) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ExceptT e m ()
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 :: forall (m :: * -> *) e.
MonadIO m =>
ExceptT e m () -> ExceptT e m ()
runShelleyClientCommandWithDeprecationWarning =
    forall (m :: * -> *) e.
MonadIO m =>
Text -> ExceptT e m () -> ExceptT e m ()
ioExceptTWithWarning Text
warningMsg
  where
    warningMsg :: Text
    warningMsg :: Text
warningMsg =
      Text
"WARNING: The \"shelley\" subcommand is now deprecated and will be "
        forall a. Semigroup a => a -> a -> a
<> Text
"removed in the future. Please use the top-level commands instead."

runDisplayVersion :: ExceptT ClientCommandErrors IO ()
runDisplayVersion :: ExceptT ClientCommandErrors IO ()
runDisplayVersion = do
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
                [ Text
"cardano-cli ", Version -> Text
renderVersion Version
version
                , Text
" - ", String -> Text
Text.pack String
os, Text
"-", String -> Text
Text.pack String
arch
                , Text
" - ", String -> Text
Text.pack String
compilerName, Text
"-", Version -> Text
renderVersion Version
compilerVersion
                , Text
"\ngit rev ", Text
gitRev
                ]
  where
    renderVersion :: Version -> Text
renderVersion = String -> Text
Text.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
showVersion


helpAll :: ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
helpAll :: forall a.
ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
helpAll ParserPrefs
pprefs String
progn [String]
rnames ParserInfo a
parserInfo = do
  String -> IO ()
IO.putStrLn forall a b. (a -> b) -> a -> b
$ Int -> ParserHelp -> String
customRenderHelp Int
80 (ParserInfo a -> ParserHelp
usage_help ParserInfo a
parserInfo)
  String -> IO ()
IO.putStrLn String
""
  forall a. Parser a -> IO ()
go (forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
parserInfo)
  where go :: Parser a -> IO ()
        go :: forall a. Parser a -> IO ()
go Parser a
p = case Parser a
p of
          NilP Maybe a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          OptP Option a
optP -> case forall a. Option a -> OptReader a
optMain Option a
optP of
            CmdReader Maybe String
_ [String]
cs String -> Maybe (ParserInfo a)
f -> do
              forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [String]
cs forall a b. (a -> b) -> a -> b
$ \String
c ->
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (String -> Maybe (ParserInfo a)
f String
c) forall a b. (a -> b) -> a -> b
$ \ParserInfo a
subParserInfo ->
                  forall a.
ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
helpAll ParserPrefs
pprefs String
progn (String
cforall a. a -> [a] -> [a]
:[String]
rnames) ParserInfo a
subParserInfo
            OptReader a
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
          AltP Parser a
pa Parser a
pb -> forall a. Parser a -> IO ()
go Parser a
pa forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Parser a -> IO ()
go Parser a
pb
          MultP Parser (x -> a)
pf Parser x
px -> forall a. Parser a -> IO ()
go Parser (x -> a)
pf forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Parser a -> IO ()
go Parser x
px
          BindP Parser x
pa x -> Parser a
_ -> forall a. Parser a -> IO ()
go Parser x
pa
        usage_help :: ParserInfo a -> ParserHelp
usage_help ParserInfo a
i =
              forall a. Monoid a => [a] -> a
mconcat
              [ Chunk Doc -> ParserHelp
usageHelp (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ParserPrefs -> Parser a -> String -> Doc
parserUsage ParserPrefs
pprefs (forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
i) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
L.unwords forall a b. (a -> b) -> a -> b
$ String
progn forall a. a -> [a] -> [a]
: forall a. [a] -> [a]
reverse [String]
rnames)
              , Chunk Doc -> ParserHelp
descriptionHelp (forall a. ParserInfo a -> Chunk Doc
infoProgDesc ParserInfo a
i)
              ]

runHelp :: ParserPrefs -> ParserInfo a -> ExceptT ClientCommandErrors IO ()
runHelp :: forall a.
ParserPrefs -> ParserInfo a -> ExceptT ClientCommandErrors IO ()
runHelp ParserPrefs
pprefs ParserInfo a
allParserInfo = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
helpAll ParserPrefs
pprefs String
"cardano-cli" [] ParserInfo a
allParserInfo