{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}

{- HLINT ignore "Monoid law, left identity" -}

module Cardano.CLI.Options
  ( opts
  , pref
  )
where

import           Cardano.CLI.Byron.Parsers (backwardsCompatibilityCommands, parseByronCommands)
import           Cardano.CLI.Compatible.Commands
import           Cardano.CLI.Environment (EnvCli)
import           Cardano.CLI.EraBased.Options.Common
import           Cardano.CLI.EraBased.Options.Era
import           Cardano.CLI.EraBased.Options.Query (pQueryCmdsTopLevel)
import           Cardano.CLI.Legacy.Options (parseLegacyCmds)
import           Cardano.CLI.Options.Address
import           Cardano.CLI.Options.Debug
import           Cardano.CLI.Options.Hash
import           Cardano.CLI.Options.Key
import           Cardano.CLI.Options.Node
import           Cardano.CLI.Options.Ping (parsePingCmd)
import           Cardano.CLI.Parser
import           Cardano.CLI.Render (customRenderHelp)
import           Cardano.CLI.Run (ClientCommand (..))

import           Data.Foldable
import           Options.Applicative
import qualified Options.Applicative as Opt
import qualified Prettyprinter as PP

opts :: EnvCli -> ParserInfo ClientCommand
opts :: EnvCli -> ParserInfo ClientCommand
opts EnvCli
envCli =
  Parser ClientCommand
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (EnvCli -> Parser ClientCommand
parseClientCommand EnvCli
envCli Parser ClientCommand
-> Parser (ClientCommand -> ClientCommand) -> Parser ClientCommand
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (ClientCommand -> ClientCommand)
forall a. Parser (a -> a)
Opt.helper) (InfoMod ClientCommand -> ParserInfo ClientCommand)
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a b. (a -> b) -> a -> b
$
    [InfoMod ClientCommand] -> InfoMod ClientCommand
forall a. Monoid a => [a] -> a
mconcat
      [ InfoMod ClientCommand
forall a. InfoMod a
Opt.fullDesc
      , String -> InfoMod ClientCommand
forall a. String -> InfoMod a
Opt.header (String -> InfoMod ClientCommand)
-> String -> InfoMod ClientCommand
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"cardano-cli - General purpose command-line utility to interact with cardano-node."
            , String
" Provides specific commands to manage keys, addresses, build & submit transactions,"
            , String
" certificates, etc."
            ]
      ]

pref :: ParserPrefs
pref :: ParserPrefs
pref =
  PrefsMod -> ParserPrefs
Opt.prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$
    [PrefsMod] -> PrefsMod
forall a. Monoid a => [a] -> a
mconcat
      [ PrefsMod
showHelpOnEmpty
      , (Doc -> Doc) -> PrefsMod
helpEmbedBriefDesc Doc -> Doc
forall ann. Doc ann -> Doc ann
PP.align
      , (Int -> ParserHelp -> String) -> PrefsMod
helpRenderHelp Int -> ParserHelp -> String
customRenderHelp
      ]

addressCmdsTopLevel :: EnvCli -> Parser ClientCommand
addressCmdsTopLevel :: EnvCli -> Parser ClientCommand
addressCmdsTopLevel EnvCli
envCli = AddressCmds -> ClientCommand
AddressCommand (AddressCmds -> ClientCommand)
-> Parser AddressCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser AddressCmds
pAddressCmds EnvCli
envCli

-- The node related commands are shelley era agnostic for the time being.
-- There is no need to guard them by the era argument.
nodeCmdsTopLevel :: Parser ClientCommand
nodeCmdsTopLevel :: Parser ClientCommand
nodeCmdsTopLevel = NodeCmds -> ClientCommand
NodeCommands (NodeCmds -> ClientCommand)
-> Parser NodeCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser NodeCmds
pNodeCmds

-- Queries actually depend on the node to client version which may coincide
-- with a hardfork but not necessarily. We will expose commands at the top level
-- regardless if they are compatible with the era or not. The help text should be
-- updated to make this clear. Gating commands behind eras
queryCmdsTopLevel :: EnvCli -> Parser ClientCommand
queryCmdsTopLevel :: EnvCli -> Parser ClientCommand
queryCmdsTopLevel EnvCli
envCli = QueryCmds ConwayEra -> ClientCommand
forall era. QueryCmds era -> ClientCommand
QueryCommands (QueryCmds ConwayEra -> ClientCommand)
-> Parser (QueryCmds ConwayEra) -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser (QueryCmds ConwayEra)
pQueryCmdsTopLevel EnvCli
envCli

keyCmdsTopLevel :: Parser ClientCommand
keyCmdsTopLevel :: Parser ClientCommand
keyCmdsTopLevel = KeyCmds -> ClientCommand
KeyCommands (KeyCmds -> ClientCommand)
-> Parser KeyCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser KeyCmds
pKeyCmds

parseClientCommand :: EnvCli -> Parser ClientCommand
parseClientCommand :: EnvCli -> Parser ClientCommand
parseClientCommand EnvCli
envCli =
  [Parser ClientCommand] -> Parser ClientCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    -- There are name clashes between Shelley commands and the Byron backwards
    -- compat commands (e.g. "genesis"), and we need to prefer the Shelley ones
    -- so we list it first.
    [ EnvCli -> Parser ClientCommand
addressCmdsTopLevel EnvCli
envCli
    , Parser ClientCommand
keyCmdsTopLevel
    , Parser ClientCommand
nodeCmdsTopLevel
    , EnvCli -> Parser ClientCommand
queryCmdsTopLevel EnvCli
envCli
    , EnvCli -> Parser ClientCommand
parseLegacy EnvCli
envCli
    , EnvCli -> Parser ClientCommand
parseByron EnvCli
envCli
    , EnvCli -> Parser ClientCommand
parseAnyEra EnvCli
envCli
    , Parser ClientCommand
parseHash
    , Parser ClientCommand
parsePing
    , EnvCli -> Parser ClientCommand
parseDebug EnvCli
envCli
    , EnvCli -> Parser ClientCommand
backwardsCompatibilityCommands EnvCli
envCli
    , ParserInfo ClientCommand -> Parser ClientCommand
forall a. ParserInfo a -> Parser ClientCommand
parseDisplayVersion (EnvCli -> ParserInfo ClientCommand
opts EnvCli
envCli)
    , EnvCli -> Parser ClientCommand
parseCompatibilityCommands EnvCli
envCli
    ]

parseByron :: EnvCli -> Parser ClientCommand
parseByron :: EnvCli -> Parser ClientCommand
parseByron EnvCli
mNetworkId =
  (ByronCommand -> ClientCommand)
-> Parser ByronCommand -> Parser ClientCommand
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByronCommand -> ClientCommand
ByronCommand (Parser ByronCommand -> Parser ClientCommand)
-> Parser ByronCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
    Mod CommandFields ByronCommand -> Parser ByronCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields ByronCommand -> Parser ByronCommand)
-> Mod CommandFields ByronCommand -> Parser ByronCommand
forall a b. (a -> b) -> a -> b
$
      [Mod CommandFields ByronCommand] -> Mod CommandFields ByronCommand
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod CommandFields ByronCommand
forall a. String -> Mod CommandFields a
commandGroup String
"Byron specific commands"
        , String -> Mod CommandFields ByronCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Byron specific commands"
        , String
-> String -> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command' String
"byron" String
"Byron specific commands" (Parser ByronCommand -> Mod CommandFields ByronCommand)
-> Parser ByronCommand -> Mod CommandFields ByronCommand
forall a b. (a -> b) -> a -> b
$ EnvCli -> Parser ByronCommand
parseByronCommands EnvCli
mNetworkId
        ]

parseHash :: Parser ClientCommand
parseHash :: Parser ClientCommand
parseHash = HashCmds -> ClientCommand
HashCmds (HashCmds -> ClientCommand)
-> Parser HashCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser HashCmds
pHashCmds

parsePing :: Parser ClientCommand
parsePing :: Parser ClientCommand
parsePing = PingCmd -> ClientCommand
CliPingCommand (PingCmd -> ClientCommand)
-> Parser PingCmd -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser PingCmd
parsePingCmd

parseCompatibilityCommands :: EnvCli -> Parser ClientCommand
parseCompatibilityCommands :: EnvCli -> Parser ClientCommand
parseCompatibilityCommands EnvCli
envCli =
  String -> ParserInfo ClientCommand -> Parser ClientCommand
forall a. String -> ParserInfo a -> Parser a
subParser String
"compatible" (ParserInfo ClientCommand -> Parser ClientCommand)
-> ParserInfo ClientCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
    Parser ClientCommand
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (AnyCompatibleCommand -> ClientCommand
CompatibleCommands (AnyCompatibleCommand -> ClientCommand)
-> Parser AnyCompatibleCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser AnyCompatibleCommand
pAnyCompatibleCommand EnvCli
envCli) (InfoMod ClientCommand -> ParserInfo ClientCommand)
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a b. (a -> b) -> a -> b
$
      String -> InfoMod ClientCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Limited backward compatible commands for testing only."

parseDebug :: EnvCli -> Parser ClientCommand
parseDebug :: EnvCli -> Parser ClientCommand
parseDebug EnvCli
envCli = DebugCmds -> ClientCommand
CliDebugCmds (DebugCmds -> ClientCommand)
-> Parser DebugCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser DebugCmds
parseDebugCmds EnvCli
envCli

parseAnyEra :: EnvCli -> Parser ClientCommand
parseAnyEra :: EnvCli -> Parser ClientCommand
parseAnyEra EnvCli
envCli = AnyEraCommand -> ClientCommand
AnyEraCommand (AnyEraCommand -> ClientCommand)
-> Parser AnyEraCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser AnyEraCommand
pAnyEraCommand EnvCli
envCli

parseLegacy :: EnvCli -> Parser ClientCommand
parseLegacy :: EnvCli -> Parser ClientCommand
parseLegacy EnvCli
envCli =
  String -> ParserInfo ClientCommand -> Parser ClientCommand
forall a. String -> ParserInfo a -> Parser a
subParser String
"legacy" (ParserInfo ClientCommand -> Parser ClientCommand)
-> ParserInfo ClientCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
    Parser ClientCommand
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (LegacyCmds -> ClientCommand
LegacyCmds (LegacyCmds -> ClientCommand)
-> Parser LegacyCmds -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EnvCli -> Parser LegacyCmds
parseLegacyCmds EnvCli
envCli) (InfoMod ClientCommand -> ParserInfo ClientCommand)
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a b. (a -> b) -> a -> b
$
      String -> InfoMod ClientCommand
forall a. String -> InfoMod a
Opt.progDesc String
"Legacy commands"

-- | Parse Legacy commands at the top level of the CLI.
-- Yes! A --version flag or version command. Either guess is right!
parseDisplayVersion :: ParserInfo a -> Parser ClientCommand
parseDisplayVersion :: forall a. ParserInfo a -> Parser ClientCommand
parseDisplayVersion ParserInfo a
allParserInfo =
  [Parser ClientCommand] -> Parser ClientCommand
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Mod CommandFields ClientCommand -> Parser ClientCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields ClientCommand -> Parser ClientCommand)
-> Mod CommandFields ClientCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
        [Mod CommandFields ClientCommand]
-> Mod CommandFields ClientCommand
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod CommandFields ClientCommand
forall a. String -> Mod CommandFields a
commandGroup String
"Miscellaneous commands"
          , String -> Mod CommandFields ClientCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Miscellaneous commands"
          , String
-> String
-> Parser ClientCommand
-> Mod CommandFields ClientCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
              String
"help"
              String
"Show all help"
              (ClientCommand -> Parser ClientCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParserPrefs -> ParserInfo a -> ClientCommand
forall a. ParserPrefs -> ParserInfo a -> ClientCommand
Help ParserPrefs
pref ParserInfo a
allParserInfo))
          , String
-> String
-> Parser ClientCommand
-> Mod CommandFields ClientCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
              String
"version"
              String
"Show the cardano-cli version"
              (ClientCommand -> Parser ClientCommand
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientCommand
DisplayVersion)
          ]
    , ClientCommand
-> Mod FlagFields ClientCommand -> Parser ClientCommand
forall a. a -> Mod FlagFields a -> Parser a
flag' ClientCommand
DisplayVersion (Mod FlagFields ClientCommand -> Parser ClientCommand)
-> Mod FlagFields ClientCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
        [Mod FlagFields ClientCommand] -> Mod FlagFields ClientCommand
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod FlagFields ClientCommand
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
          , String -> Mod FlagFields ClientCommand
forall (f :: * -> *) a. String -> Mod f a
help String
"Show the cardano-cli version"
          , Mod FlagFields ClientCommand
forall (f :: * -> *) a. Mod f a
hidden
          ]
    ]