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

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

import           Cardano.Prelude
import           Cardano.CLI.Byron.Parsers (backwardsCompatibilityCommands, parseByronCommands)
import           Cardano.CLI.Render (customRenderHelp)
import           Cardano.CLI.Run (ClientCommand (..))
import           Cardano.CLI.Shelley.Parsers (parseShelleyCommands)
import           Options.Applicative
import           Prelude (String)

import qualified Options.Applicative as Opt

command' :: String -> String -> Parser a -> Mod CommandFields a
command' :: String -> String -> Parser a -> Mod CommandFields a
command' String
c String
descr Parser a
p =
    String -> ParserInfo a -> Mod CommandFields a
forall a. String -> ParserInfo a -> Mod CommandFields a
command String
c (ParserInfo a -> Mod CommandFields a)
-> ParserInfo a -> Mod CommandFields a
forall a b. (a -> b) -> a -> b
$ Parser a -> InfoMod a -> ParserInfo a
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser a
p Parser a -> Parser (a -> a) -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> Parser (a -> a)
forall a. Parser (a -> a)
helper)
              (InfoMod a -> ParserInfo a) -> InfoMod a -> ParserInfo a
forall a b. (a -> b) -> a -> b
$ [InfoMod a] -> InfoMod a
forall a. Monoid a => [a] -> a
mconcat [ String -> InfoMod a
forall a. String -> InfoMod a
progDesc String
descr ]

opts :: ParserInfo ClientCommand
opts :: ParserInfo ClientCommand
opts =
  Parser ClientCommand
-> InfoMod ClientCommand -> ParserInfo ClientCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (Parser ClientCommand
parseClientCommand 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
forall a. InfoMod a
Opt.fullDesc
      InfoMod ClientCommand
-> InfoMod ClientCommand -> InfoMod ClientCommand
forall a. Semigroup a => a -> a -> a
<> String -> InfoMod ClientCommand
forall a. String -> InfoMod a
Opt.header
      String
"cardano-cli - utility to support a variety of key\
      \ operations (genesis generation, migration,\
      \ pretty-printing..) for different system generations."
    )

pref :: ParserPrefs
pref :: ParserPrefs
pref = PrefsMod -> ParserPrefs
Opt.prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ PrefsMod
forall a. Monoid a => a
mempty
  PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> PrefsMod
showHelpOnEmpty
  PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> Int -> PrefsMod
helpHangUsageOverflow Int
10
  PrefsMod -> PrefsMod -> PrefsMod
forall a. Semigroup a => a -> a -> a
<> (Int -> ParserHelp -> String) -> PrefsMod
helpRenderHelp Int -> ParserHelp -> String
customRenderHelp

parseClientCommand :: Parser ClientCommand
parseClientCommand :: Parser ClientCommand
parseClientCommand =
  [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.
    [ Parser ClientCommand
parseShelley
    , Parser ClientCommand
parseByron
    , Parser ClientCommand
parseDeprecatedShelleySubcommand
    , Parser ClientCommand
backwardsCompatibilityCommands
    , ParserInfo ClientCommand -> Parser ClientCommand
forall a. ParserInfo a -> Parser ClientCommand
parseDisplayVersion ParserInfo ClientCommand
opts
    ]

parseByron :: Parser ClientCommand
parseByron :: Parser ClientCommand
parseByron =
  (ByronCommand -> ClientCommand)
-> Parser ByronCommand -> Parser ClientCommand
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
parseByronCommands
    ]

-- | Parse Shelley-related commands at the top level of the CLI.
parseShelley :: Parser ClientCommand
parseShelley :: Parser ClientCommand
parseShelley = ShelleyCommand -> ClientCommand
ShelleyCommand (ShelleyCommand -> ClientCommand)
-> Parser ShelleyCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShelleyCommand
parseShelleyCommands

-- | Parse Shelley-related commands under the now-deprecated \"shelley\"
-- subcommand.
--
-- Note that this subcommand is 'internal' and is therefore hidden from the
-- help text.
parseDeprecatedShelleySubcommand :: Parser ClientCommand
parseDeprecatedShelleySubcommand :: Parser ClientCommand
parseDeprecatedShelleySubcommand =
  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
"Shelley specific commands (deprecated)"
    , String -> Mod CommandFields ClientCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Shelley specific commands"
    , String
-> String
-> Parser ClientCommand
-> Mod CommandFields ClientCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
        String
"shelley"
        String
"Shelley specific commands (deprecated)"
        (ShelleyCommand -> ClientCommand
DeprecatedShelleySubcommand (ShelleyCommand -> ClientCommand)
-> Parser ShelleyCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ShelleyCommand
parseShelleyCommands)
    , Mod CommandFields ClientCommand
forall (f :: * -> *) a. Mod f a
internal
    ]

-- Yes! A --version flag or version command. Either guess is right!
parseDisplayVersion :: ParserInfo a -> Parser ClientCommand
parseDisplayVersion :: ParserInfo a -> Parser ClientCommand
parseDisplayVersion ParserInfo a
allParserInfo =
      Mod CommandFields ClientCommand -> Parser ClientCommand
forall a. Mod CommandFields a -> Parser a
subparser
        ([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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure ClientCommand
DisplayVersion)
         ]
        )
  Parser ClientCommand
-> Parser ClientCommand -> Parser ClientCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ClientCommand
-> Mod FlagFields ClientCommand -> Parser ClientCommand
forall a. a -> Mod FlagFields a -> Parser a
flag' ClientCommand
DisplayVersion
        (  String -> Mod FlagFields ClientCommand
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"version"
        Mod FlagFields ClientCommand
-> Mod FlagFields ClientCommand -> Mod FlagFields ClientCommand
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields ClientCommand
forall (f :: * -> *) a. String -> Mod f a
help String
"Show the cardano-cli version"
        Mod FlagFields ClientCommand
-> Mod FlagFields ClientCommand -> Mod FlagFields ClientCommand
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields ClientCommand
forall (f :: * -> *) a. Mod f a
hidden
        )