{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}

import           Bcc.Prelude hiding (option)
import qualified Data.Text as Text
import           Prelude (String)

import           Options.Applicative
import qualified Options.Applicative as Opt
import           Options.Applicative.Help ((<$$>))

import           Bcc.Config.Git.Rev (gitRev)
import           Data.Version (showVersion)
import           Paths_bcc_node (version)
import           System.Info (arch, compilerName, compilerVersion, os)

import           Bcc.Node.Configuration.POM (PartialNodeConfiguration)
import           Bcc.Node.Handlers.TopLevel
import           Bcc.Node.Parsers (nodeCLIParser, parserHelpHeader, parserHelpOptions,
                   renderHelpDoc)
import           Bcc.Node.Run (runNode)

main :: IO ()
main :: IO ()
main = IO () -> IO ()
forall a. IO a -> IO a
toplevelExceptionHandler (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do

    Command
cmd <- ParserPrefs -> ParserInfo Command -> IO Command
forall a. ParserPrefs -> ParserInfo a -> IO a
Opt.customExecParser ParserPrefs
p ParserInfo Command
opts

    case Command
cmd of
      RunCmd PartialNodeConfiguration
args -> PartialNodeConfiguration -> IO ()
runRunCommand PartialNodeConfiguration
args
      Command
VersionCmd  -> IO ()
runVersionCommand

    where
      p :: ParserPrefs
p = PrefsMod -> ParserPrefs
Opt.prefs PrefsMod
Opt.showHelpOnEmpty

      opts :: Opt.ParserInfo Command
      opts :: ParserInfo Command
opts =
        Parser Command -> InfoMod Command -> ParserInfo Command
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info ((PartialNodeConfiguration -> Command)
-> Parser PartialNodeConfiguration -> Parser Command
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PartialNodeConfiguration -> Command
RunCmd Parser PartialNodeConfiguration
nodeCLIParser Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Command
parseVersionCmd
                    Parser Command -> Parser (Command -> Command) -> Parser Command
forall (f :: * -> *) a b. Applicative f => f a -> f (a -> b) -> f b
<**> String -> String -> String -> Parser (Command -> Command)
forall a. String -> String -> String -> Parser (a -> a)
helperBrief String
"help" String
"Show this help text" String
nodeCliHelpMain)

          ( InfoMod Command
forall a. InfoMod a
Opt.fullDesc InfoMod Command -> InfoMod Command -> InfoMod Command
forall a. Semigroup a => a -> a -> a
<>
            String -> InfoMod Command
forall a. String -> InfoMod a
Opt.progDesc String
"Start node of the Bcc blockchain."
          )

      helperBrief :: String -> String -> String -> Parser (a -> a)
      helperBrief :: String -> String -> String -> Parser (a -> a)
helperBrief String
l String
d String
helpText = ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a.
ParseError -> Mod OptionFields (a -> a) -> Parser (a -> a)
Opt.abortOption (String -> ParseError
Opt.InfoMsg String
helpText) (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields (a -> a)] -> Mod OptionFields (a -> a)
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
l
        , String -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
d ]

      nodeCliHelpMain :: String
      nodeCliHelpMain :: String
nodeCliHelpMain = Int -> Doc -> String
renderHelpDoc Int
80 (Doc -> String) -> Doc -> String
forall a b. (a -> b) -> a -> b
$
        String -> Parser PartialNodeConfiguration -> Doc
forall a. String -> Parser a -> Doc
parserHelpHeader String
"bcc-node" Parser PartialNodeConfiguration
nodeCLIParser
        Doc -> Doc -> Doc
<$$> Doc
""
        Doc -> Doc -> Doc
<$$> Parser PartialNodeConfiguration -> Doc
forall a. Parser a -> Doc
parserHelpOptions Parser PartialNodeConfiguration
nodeCLIParser


data Command = RunCmd PartialNodeConfiguration
             | VersionCmd

-- Yes! A --version flag or version command. Either guess is right!
parseVersionCmd :: Parser Command
parseVersionCmd :: Parser Command
parseVersionCmd =
      Mod CommandFields Command -> Parser Command
forall a. Mod CommandFields a -> Parser a
Opt.subparser
        ([Mod CommandFields Command] -> Mod CommandFields Command
forall a. Monoid a => [a] -> a
mconcat
         [ String -> Mod CommandFields Command
forall a. String -> Mod CommandFields a
Opt.commandGroup String
"Miscellaneous commands"
         , String -> Mod CommandFields Command
forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
Opt.metavar String
"version"
         , Mod CommandFields Command
forall (f :: * -> *) a. Mod f a
Opt.hidden
         , String -> String -> Parser Command -> Mod CommandFields Command
forall a. String -> String -> Parser a -> Mod CommandFields a
command'
           String
"version"
           String
"Show the bcc-node version"
           (Command -> Parser Command
forall (f :: * -> *) a. Applicative f => a -> f a
pure Command
VersionCmd)
         ]
        )
  Parser Command -> Parser Command -> Parser Command
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Command -> Mod FlagFields Command -> Parser Command
forall a. a -> Mod FlagFields a -> Parser a
Opt.flag' Command
VersionCmd
        (  String -> Mod FlagFields Command
forall (f :: * -> *) a. HasName f => String -> Mod f a
Opt.long String
"version"
        Mod FlagFields Command
-> Mod FlagFields Command -> Mod FlagFields Command
forall a. Semigroup a => a -> a -> a
<> String -> Mod FlagFields Command
forall (f :: * -> *) a. String -> Mod f a
Opt.help String
"Show the bcc-node version"
        Mod FlagFields Command
-> Mod FlagFields Command -> Mod FlagFields Command
forall a. Semigroup a => a -> a -> a
<> Mod FlagFields Command
forall (f :: * -> *) a. Mod f a
Opt.hidden
        )

runVersionCommand :: IO ()
runVersionCommand :: IO ()
runVersionCommand =
    Text -> IO ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"bcc-node ", 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 (String -> Text) -> (Version -> String) -> Version -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Version -> String
showVersion


runRunCommand :: PartialNodeConfiguration -> IO ()
runRunCommand :: PartialNodeConfiguration -> IO ()
runRunCommand PartialNodeConfiguration
pnc = IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ PartialNodeConfiguration -> IO ()
runNode PartialNodeConfiguration
pnc

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 ]