module DBSynthesizer.Parsers
  ( Options (..)
  , parseCommandLine
  ) where

import qualified Cardano.Configuration.CliArgs as CLI
import Cardano.Tools.DBSynthesizer.Types
import Data.Word (Word64)
import Options.Applicative as Opt
import Ouroboros.Consensus.Block.Abstract (SlotNo (..))

-- | What db-synthesizer was asked to do.
data Options = Options
  { Options -> FilePath
configFile :: FilePath
  , Options -> FilePath
chainDBDir :: FilePath
  , Options -> Credentials
credentials :: CLI.Credentials
  , Options -> DBSynthesizerOptions
synthOptions :: DBSynthesizerOptions
  }

parseCommandLine :: IO Options
parseCommandLine :: IO Options
parseCommandLine =
  ParserPrefs -> ParserInfo Options -> IO Options
forall a. ParserPrefs -> ParserInfo a -> IO a
Opt.customExecParser ParserPrefs
p ParserInfo Options
opts
 where
  p :: ParserPrefs
p = PrefsMod -> ParserPrefs
Opt.prefs PrefsMod
Opt.showHelpOnEmpty
  opts :: ParserInfo Options
opts = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info Parser Options
parserCommandLine InfoMod Options
forall a. Monoid a => a
mempty

parserCommandLine :: Parser Options
parserCommandLine :: Parser Options
parserCommandLine =
  FilePath
-> FilePath -> Credentials -> DBSynthesizerOptions -> Options
Options
    (FilePath
 -> FilePath -> Credentials -> DBSynthesizerOptions -> Options)
-> Parser FilePath
-> Parser
     (FilePath -> Credentials -> DBSynthesizerOptions -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
parseNodeConfigFilePath
    Parser (FilePath -> Credentials -> DBSynthesizerOptions -> Options)
-> Parser FilePath
-> Parser (Credentials -> DBSynthesizerOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser FilePath
parseChainDBFilePath
    -- The credential flags are cardano-config's own, so that they are spelled
    -- and documented exactly as they are for a node.
    Parser (Credentials -> DBSynthesizerOptions -> Options)
-> Parser Credentials -> Parser (DBSynthesizerOptions -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Credentials
CLI.parseCredentials
    Parser (DBSynthesizerOptions -> Options)
-> Parser DBSynthesizerOptions -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DBSynthesizerOptions
parseDBSynthesizerOptions

parseDBSynthesizerOptions :: Parser DBSynthesizerOptions
parseDBSynthesizerOptions :: Parser DBSynthesizerOptions
parseDBSynthesizerOptions =
  ForgeLimit -> DBSynthesizerOpenMode -> DBSynthesizerOptions
DBSynthesizerOptions
    (ForgeLimit -> DBSynthesizerOpenMode -> DBSynthesizerOptions)
-> Parser ForgeLimit
-> Parser (DBSynthesizerOpenMode -> DBSynthesizerOptions)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ForgeLimit
parseForgeOptions
    Parser (DBSynthesizerOpenMode -> DBSynthesizerOptions)
-> Parser DBSynthesizerOpenMode -> Parser DBSynthesizerOptions
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser DBSynthesizerOpenMode
parseOpenMode

parseForgeOptions :: Parser ForgeLimit
parseForgeOptions :: Parser ForgeLimit
parseForgeOptions =
  SlotNo -> ForgeLimit
ForgeLimitSlot
    (SlotNo -> ForgeLimit) -> Parser SlotNo -> Parser ForgeLimit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SlotNo
parseSlotLimit
      Parser ForgeLimit -> Parser ForgeLimit -> Parser ForgeLimit
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word64 -> ForgeLimit
ForgeLimitBlock
    (Word64 -> ForgeLimit) -> Parser Word64 -> Parser ForgeLimit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word64
parseBlockLimit
      Parser ForgeLimit -> Parser ForgeLimit -> Parser ForgeLimit
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word64 -> ForgeLimit
ForgeLimitEpoch
    (Word64 -> ForgeLimit) -> Parser Word64 -> Parser ForgeLimit
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Word64
parseEpochLimit

parseChainDBFilePath :: Parser FilePath
parseChainDBFilePath :: Parser FilePath
parseChainDBFilePath =
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"db"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to the Chain DB"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"directory")
    )

parseNodeConfigFilePath :: Parser FilePath
parseNodeConfigFilePath :: Parser FilePath
parseNodeConfigFilePath =
  Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    ( FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"config"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path to the node's config.json"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> Completer -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasCompleter f => Completer -> Mod f a
completer (FilePath -> Completer
bashCompleter FilePath
"file")
    )

parseSlotLimit :: Parser SlotNo
parseSlotLimit :: Parser SlotNo
parseSlotLimit =
  Word64 -> SlotNo
SlotNo
    (Word64 -> SlotNo) -> Parser Word64 -> Parser SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
      ReadM Word64
forall a. Read a => ReadM a
auto
      ( Char -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
's'
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"slots"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUMBER"
          Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Amount of slots to process"
      )

parseBlockLimit :: Parser Word64
parseBlockLimit :: Parser Word64
parseBlockLimit =
  ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Word64
forall a. Read a => ReadM a
auto
    ( Char -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'b'
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"blocks"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUMBER"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Amount of blocks to forge"
    )

parseEpochLimit :: Parser Word64
parseEpochLimit :: Parser Word64
parseEpochLimit =
  ReadM Word64 -> Mod OptionFields Word64 -> Parser Word64
forall a. ReadM a -> Mod OptionFields a -> Parser a
option
    ReadM Word64
forall a. Read a => ReadM a
auto
    ( Char -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'e'
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"epochs"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"NUMBER"
        Mod OptionFields Word64
-> Mod OptionFields Word64 -> Mod OptionFields Word64
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Word64
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Amount of epochs to process"
    )

-- | @-f@ and @-a@ pick the open mode; without either of them, the ChainDB
-- directory is expected not to exist yet.
--
-- These have to be 'flag'' rather than 'switch': a 'switch' succeeds whether or
-- not its flag is present, so the first alternative would always win and every
-- run would force-overwrite.
parseOpenMode :: Parser DBSynthesizerOpenMode
parseOpenMode :: Parser DBSynthesizerOpenMode
parseOpenMode =
  DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
-> Parser DBSynthesizerOpenMode
forall a. a -> Mod FlagFields a -> Parser a
flag'
    DBSynthesizerOpenMode
OpenCreateForce
    ( Char -> Mod FlagFields DBSynthesizerOpenMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
        Mod FlagFields DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields DBSynthesizerOpenMode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Force overwrite an existing Chain DB"
    )
    Parser DBSynthesizerOpenMode
-> Parser DBSynthesizerOpenMode -> Parser DBSynthesizerOpenMode
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
-> Parser DBSynthesizerOpenMode
forall a. a -> Mod FlagFields a -> Parser a
flag'
      DBSynthesizerOpenMode
OpenAppend
      ( Char -> Mod FlagFields DBSynthesizerOpenMode
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'a'
          Mod FlagFields DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
-> Mod FlagFields DBSynthesizerOpenMode
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields DBSynthesizerOpenMode
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Append to an existing Chain DB"
      )
    Parser DBSynthesizerOpenMode
-> Parser DBSynthesizerOpenMode -> Parser DBSynthesizerOpenMode
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> DBSynthesizerOpenMode -> Parser DBSynthesizerOpenMode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DBSynthesizerOpenMode
OpenCreate