module DBTruncater.Parsers (commandLineParser) where

import           Cardano.Tools.DBTruncater.Types
import           DBAnalyser.Parsers
import           Options.Applicative
import           Ouroboros.Consensus.Block.Abstract

commandLineParser :: Parser (DBTruncaterConfig, BlockType)
commandLineParser :: Parser (DBTruncaterConfig, BlockType)
commandLineParser = (,) (DBTruncaterConfig -> BlockType -> (DBTruncaterConfig, BlockType))
-> Parser DBTruncaterConfig
-> Parser (BlockType -> (DBTruncaterConfig, BlockType))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser DBTruncaterConfig
parseDBTruncaterConfig Parser (BlockType -> (DBTruncaterConfig, BlockType))
-> Parser BlockType -> Parser (DBTruncaterConfig, BlockType)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser BlockType
blockTypeParser

parseDBTruncaterConfig :: Parser DBTruncaterConfig
parseDBTruncaterConfig :: Parser DBTruncaterConfig
parseDBTruncaterConfig = FilePath -> TruncateAfter -> Bool -> DBTruncaterConfig
DBTruncaterConfig
    (FilePath -> TruncateAfter -> Bool -> DBTruncaterConfig)
-> Parser FilePath
-> Parser (TruncateAfter -> Bool -> DBTruncaterConfig)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath
parseChainDBPath
    Parser (TruncateAfter -> Bool -> DBTruncaterConfig)
-> Parser TruncateAfter -> Parser (Bool -> DBTruncaterConfig)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser TruncateAfter
parseTruncateAfter
    Parser (Bool -> DBTruncaterConfig)
-> Parser Bool -> Parser DBTruncaterConfig
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Bool
parseVerbose
  where
    parseChainDBPath :: Parser FilePath
parseChainDBPath = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$
      [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
        [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"db"
        , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Path of the chain DB"
        , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"PATH"
        ]
    parseVerbose :: Parser Bool
parseVerbose = Mod FlagFields Bool -> Parser Bool
switch (FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verbose" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Enable verbose logging")
parseTruncateAfter :: Parser TruncateAfter
parseTruncateAfter :: Parser TruncateAfter
parseTruncateAfter =
  (SlotNo -> TruncateAfter) -> Parser SlotNo -> Parser TruncateAfter
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SlotNo -> TruncateAfter
TruncateAfterSlot Parser SlotNo
slotNoOption Parser TruncateAfter
-> Parser TruncateAfter -> Parser TruncateAfter
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (BlockNo -> TruncateAfter)
-> Parser BlockNo -> Parser TruncateAfter
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BlockNo -> TruncateAfter
TruncateAfterBlock Parser BlockNo
blockNoOption

slotNoOption :: Parser SlotNo
slotNoOption :: Parser SlotNo
slotNoOption =
    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 Mod OptionFields Word64
forall {a}. Mod OptionFields a
mods
  where
    mods :: Mod OptionFields a
mods = [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"truncate-after-slot"
      , FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"SLOT_NUMBER"
      , FilePath -> Mod OptionFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Remove all blocks with a higher slot number"
      ]

blockNoOption :: Parser BlockNo
blockNoOption :: Parser BlockNo
blockNoOption =
    Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Parser Word64 -> Parser BlockNo
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 Mod OptionFields Word64
forall {a}. Mod OptionFields a
mods
  where
    mods :: Mod OptionFields a
mods = [Mod OptionFields a] -> Mod OptionFields a
forall a. Monoid a => [a] -> a
mconcat
      [ FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"truncate-after-block"
      , FilePath -> Mod OptionFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"BLOCK_NUMBER"
      , FilePath -> Mod OptionFields a
forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The block number of the intended new tip of the chain after truncation"
      ]