{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}

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

import Cardano.Api

import Cardano.CLI.Byron.Run
import Cardano.CLI.Command
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Compatible.Run
import Cardano.CLI.EraBased.Query.Run
import Cardano.CLI.EraBased.Run
import Cardano.CLI.EraIndependent.Address.Run
import Cardano.CLI.EraIndependent.Cip.Run
import Cardano.CLI.EraIndependent.Debug.Run
import Cardano.CLI.EraIndependent.Hash.Run (runHashCmds)
import Cardano.CLI.EraIndependent.Key.Run
import Cardano.CLI.EraIndependent.Node.Run
import Cardano.CLI.EraIndependent.Ping.Run
  ( runPingCmd
  )
import Cardano.CLI.Legacy.Run (runLegacyCmds)
import Cardano.CLI.Render (customRenderHelp)
import Cardano.Git.Rev (gitRev)

import RIO

import Data.List qualified as L
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Version (showVersion)
import Options.Applicative.Help.Core
import Options.Applicative.Types
  ( OptReader (..)
  , Option (..)
  , Parser (..)
  , ParserInfo (..)
  , ParserPrefs (..)
  )
import System.IO qualified as IO
import System.Info (arch, compilerName, compilerVersion, os)

import Paths_cardano_cli (version)

runClientCommand :: ClientCommand -> CIO e ()
runClientCommand :: forall e. ClientCommand -> CIO e ()
runClientCommand = \case
  AnyEraCommand AnyEraCommand
cmds ->
    AnyEraCommand -> CIO e ()
forall e. AnyEraCommand -> CIO e ()
runAnyEraCommand AnyEraCommand
cmds
  AddressCommand AddressCmds
cmds ->
    AddressCmds -> CIO e ()
forall e. AddressCmds -> CIO e ()
runAddressCmds AddressCmds
cmds
  NodeCommands NodeCmds
cmds ->
    NodeCmds -> CIO e ()
forall e. NodeCmds -> CIO e ()
runNodeCmds NodeCmds
cmds
  ByronCommand ByronCommand
cmds ->
    ByronCommand -> CIO e ()
forall e. ByronCommand -> CIO e ()
runByronClientCommand ByronCommand
cmds
  CompatibleCommands AnyCompatibleCommand
cmd ->
    AnyCompatibleCommand -> CIO e ()
forall e. AnyCompatibleCommand -> CIO e ()
runAnyCompatibleCommand AnyCompatibleCommand
cmd
  HashCmds HashCmds
cmds ->
    HashCmds -> CIO e ()
forall e. HashCmds -> CIO e ()
runHashCmds HashCmds
cmds
  KeyCommands KeyCmds
cmds ->
    KeyCmds -> CIO e ()
forall e. KeyCmds -> CIO e ()
runKeyCmds KeyCmds
cmds
  LegacyCmds LegacyCmds
cmds ->
    LegacyCmds -> CIO e ()
forall e. LegacyCmds -> CIO e ()
runLegacyCmds LegacyCmds
cmds
  QueryCommands QueryCmds era
cmds ->
    QueryCmds era -> CIO e ()
forall era e. QueryCmds era -> CIO e ()
runQueryCmds QueryCmds era
cmds
  CipFormatCmds CipFormatCmds
cmds ->
    CipFormatCmds -> CIO e ()
forall e. CipFormatCmds -> CIO e ()
runCipFormat CipFormatCmds
cmds
  CliPingCommand PingCmd
cmds ->
    PingCmd -> CIO e ()
forall e. PingCmd -> CIO e ()
runPingCmd PingCmd
cmds
  CliDebugCmds DebugCmds
cmds ->
    DebugCmds -> CIO e ()
forall e. DebugCmds -> CIO e ()
runDebugCmds DebugCmds
cmds
  Help ParserPrefs
pprefs ParserInfo a
allParserInfo ->
    ParserPrefs -> ParserInfo a -> CIO e ()
forall a e. ParserPrefs -> ParserInfo a -> CIO e ()
runHelp ParserPrefs
pprefs ParserInfo a
allParserInfo
  ClientCommand
DisplayVersion ->
    RIO e ()
forall e. CIO e ()
runDisplayVersion

runDisplayVersion :: CIO e ()
runDisplayVersion :: forall e. CIO e ()
runDisplayVersion = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> (Text -> IO ()) -> Text -> RIO e ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> IO ()
Text.putStrLn (Text -> RIO e ()) -> Text -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    [Text] -> Text
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 "
      , $(gitRev)
      ]
 where
  renderVersion :: Version -> Text
renderVersion = String -> Text
Text.pack (String -> Text) -> (Version -> String) -> Version -> Text
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 (String -> IO ()) -> String -> IO ()
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
""
  Parser a -> IO ()
forall a. Parser a -> IO ()
go (ParserInfo a -> Parser a
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
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    OptP Option a
optP -> case Option a -> OptReader a
forall a. Option a -> OptReader a
optMain Option a
optP of
      CmdReader Maybe String
_ [(String, ParserInfo a)]
cs -> do
        [(String, ParserInfo a)]
-> ((String, ParserInfo a) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, ParserInfo a)]
cs (((String, ParserInfo a) -> IO ()) -> IO ())
-> ((String, ParserInfo a) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(String
c, ParserInfo a
subParserInfo) ->
          ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
forall a.
ParserPrefs -> String -> [String] -> ParserInfo a -> IO ()
helpAll ParserPrefs
pprefs String
progn (String
c String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
rnames) ParserInfo a
subParserInfo
      OptReader a
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    AltP Parser a
pa Parser a
pb -> Parser a -> IO ()
forall a. Parser a -> IO ()
go Parser a
pa IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser a -> IO ()
forall a. Parser a -> IO ()
go Parser a
pb
    MultP Parser (x -> a)
pf Parser x
px -> Parser (x -> a) -> IO ()
forall a. Parser a -> IO ()
go Parser (x -> a)
pf IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser x -> IO ()
forall a. Parser a -> IO ()
go Parser x
px
    BindP Parser x
pa x -> Parser a
_ -> Parser x -> IO ()
forall a. Parser a -> IO ()
go Parser x
pa
  usage_help :: ParserInfo a -> ParserHelp
usage_help ParserInfo a
i =
    [ParserHelp] -> ParserHelp
forall a. Monoid a => [a] -> a
mconcat
      [ Chunk Doc -> ParserHelp
usageHelp (Doc -> Chunk Doc
forall a. a -> Chunk a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Doc -> Chunk Doc) -> ([String] -> Doc) -> [String] -> Chunk Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParserPrefs -> Parser a -> String -> Doc
forall a. ParserPrefs -> Parser a -> String -> Doc
parserUsage ParserPrefs
pprefs (ParserInfo a -> Parser a
forall a. ParserInfo a -> Parser a
infoParser ParserInfo a
i) (String -> Doc) -> ([String] -> String) -> [String] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
L.unwords ([String] -> Chunk Doc) -> [String] -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ String
progn String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
forall a. [a] -> [a]
reverse [String]
rnames)
      , Chunk Doc -> ParserHelp
descriptionHelp (ParserInfo a -> Chunk Doc
forall a. ParserInfo a -> Chunk Doc
infoProgDesc ParserInfo a
i)
      ]

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