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

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

import           Bcc.Prelude
import           Bcc.CLI.Cole.Parsers (backwardsCompatibilityCommands, parseColeCommands)
import           Bcc.CLI.Render (customRenderHelp)
import           Bcc.CLI.Run (ClientCommand (..))
import           Bcc.CLI.Sophie.Parsers (parseSophieCommands)
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
"bcc-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 Sophie commands and the Cole backwards
    -- compat commands (e.g. "genesis"), and we need to prefer the Sophie ones
    -- so we list it first.
    [ Parser ClientCommand
parseSophie
    , Parser ClientCommand
parseCole
    , Parser ClientCommand
parseDeprecatedSophieSubcommand
    , Parser ClientCommand
backwardsCompatibilityCommands
    , ParserInfo ClientCommand -> Parser ClientCommand
forall a. ParserInfo a -> Parser ClientCommand
parseDisplayVersion ParserInfo ClientCommand
opts
    ]

parseCole :: Parser ClientCommand
parseCole :: Parser ClientCommand
parseCole =
  (ColeCommand -> ClientCommand)
-> Parser ColeCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ColeCommand -> ClientCommand
ColeCommand (Parser ColeCommand -> Parser ClientCommand)
-> Parser ColeCommand -> Parser ClientCommand
forall a b. (a -> b) -> a -> b
$
  Mod CommandFields ColeCommand -> Parser ColeCommand
forall a. Mod CommandFields a -> Parser a
subparser (Mod CommandFields ColeCommand -> Parser ColeCommand)
-> Mod CommandFields ColeCommand -> Parser ColeCommand
forall a b. (a -> b) -> a -> b
$ [Mod CommandFields ColeCommand] -> Mod CommandFields ColeCommand
forall a. Monoid a => [a] -> a
mconcat
    [ String -> Mod CommandFields ColeCommand
forall a. String -> Mod CommandFields a
commandGroup String
"Cole specific commands"
    , String -> Mod CommandFields ColeCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Cole specific commands"
    , String
-> String -> Parser ColeCommand -> Mod CommandFields ColeCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
        String
"cole"
        String
"Cole specific commands"
         Parser ColeCommand
parseColeCommands
    ]

-- | Parse Sophie-related commands at the top level of the CLI.
parseSophie :: Parser ClientCommand
parseSophie :: Parser ClientCommand
parseSophie = SophieCommand -> ClientCommand
SophieCommand (SophieCommand -> ClientCommand)
-> Parser SophieCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SophieCommand
parseSophieCommands

-- | Parse Sophie-related commands under the now-deprecated \"sophie\"
-- subcommand.
--
-- Note that this subcommand is 'internal' and is therefore hidden from the
-- help text.
parseDeprecatedSophieSubcommand :: Parser ClientCommand
parseDeprecatedSophieSubcommand :: Parser ClientCommand
parseDeprecatedSophieSubcommand =
  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
"Sophie specific commands (deprecated)"
    , String -> Mod CommandFields ClientCommand
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"Sophie specific commands"
    , String
-> String
-> Parser ClientCommand
-> Mod CommandFields ClientCommand
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
        String
"sophie"
        String
"Sophie specific commands (deprecated)"
        (SophieCommand -> ClientCommand
DeprecatedSophieSubcommand (SophieCommand -> ClientCommand)
-> Parser SophieCommand -> Parser ClientCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SophieCommand
parseSophieCommands)
    , 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 bcc-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 bcc-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
        )