{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}

module Cardano.CLI.EraBased.Governance.Vote.Option
  ( pGovernanceVoteCmds
  )
where

import Cardano.Api.Experimental qualified as Exp

import Cardano.CLI.EraBased.Common.Option
import Cardano.CLI.EraBased.Governance.Vote.Command
  ( GovernanceVoteCmds (..)
  , GovernanceVoteCreateCmdArgs (GovernanceVoteCreateCmdArgs)
  , GovernanceVoteViewCmdArgs (GovernanceVoteViewCmdArgs)
  )
import Cardano.CLI.Option.Flag (setDefault)
import Cardano.CLI.Parser
import Cardano.CLI.Type.Governance

import Control.Applicative (optional)
import Data.Foldable
import Data.Function ((&))
import Options.Applicative (Parser)
import Options.Applicative qualified as Opt

pGovernanceVoteCmds
  :: Exp.IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteCmds :: forall era. IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteCmds =
  String
-> InfoMod (GovernanceVoteCmds era)
-> [Maybe (Parser (GovernanceVoteCmds era))]
-> Maybe (Parser (GovernanceVoteCmds era))
forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
    String
"vote"
    (String -> InfoMod (GovernanceVoteCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Vote commands.")
    [ Maybe (Parser (GovernanceVoteCmds era))
forall era. IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteCreateCmd
    , Maybe (Parser (GovernanceVoteCmds era))
forall era. IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteViewCmd
    ]

pGovernanceVoteCreateCmd
  :: Exp.IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteCreateCmd :: forall era. IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteCreateCmd = do
  Parser (GovernanceVoteCmds era)
-> Maybe (Parser (GovernanceVoteCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceVoteCmds era)
 -> Maybe (Parser (GovernanceVoteCmds era)))
-> Parser (GovernanceVoteCmds era)
-> Maybe (Parser (GovernanceVoteCmds era))
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (GovernanceVoteCmds era)
-> Parser (GovernanceVoteCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
    (Mod CommandFields (GovernanceVoteCmds era)
 -> Parser (GovernanceVoteCmds era))
-> Mod CommandFields (GovernanceVoteCmds era)
-> Parser (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceVoteCmds era)
-> Mod CommandFields (GovernanceVoteCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"create"
    (ParserInfo (GovernanceVoteCmds era)
 -> Mod CommandFields (GovernanceVoteCmds era))
-> ParserInfo (GovernanceVoteCmds era)
-> Mod CommandFields (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceVoteCmds era)
-> InfoMod (GovernanceVoteCmds era)
-> ParserInfo (GovernanceVoteCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      ( GovernanceVoteCreateCmdArgs era -> GovernanceVoteCmds era
forall era.
GovernanceVoteCreateCmdArgs era -> GovernanceVoteCmds era
GovernanceVoteCreateCmd
          (GovernanceVoteCreateCmdArgs era -> GovernanceVoteCmds era)
-> Parser (GovernanceVoteCreateCmdArgs era)
-> Parser (GovernanceVoteCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (GovernanceVoteCreateCmdArgs era)
forall era. IsEra era => Parser (GovernanceVoteCreateCmdArgs era)
pGovernanceVoteCreateCmdArgs
      )
    (InfoMod (GovernanceVoteCmds era)
 -> ParserInfo (GovernanceVoteCmds era))
-> InfoMod (GovernanceVoteCmds era)
-> ParserInfo (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceVoteCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Vote creation."

pGovernanceVoteCreateCmdArgs
  :: Exp.IsEra era => Parser (GovernanceVoteCreateCmdArgs era)
pGovernanceVoteCreateCmdArgs :: forall era. IsEra era => Parser (GovernanceVoteCreateCmdArgs era)
pGovernanceVoteCreateCmdArgs =
  Era era
-> Vote
-> GovActionId
-> AnyVotingStakeVerificationKeyOrHashOrFile
-> Maybe
     (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
-> VoteFile 'Out
-> GovernanceVoteCreateCmdArgs era
forall era.
Era era
-> Vote
-> GovActionId
-> AnyVotingStakeVerificationKeyOrHashOrFile
-> Maybe
     (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
-> VoteFile 'Out
-> GovernanceVoteCreateCmdArgs era
GovernanceVoteCreateCmdArgs Era era
forall era. IsEra era => Era era
Exp.useEra
    (Vote
 -> GovActionId
 -> AnyVotingStakeVerificationKeyOrHashOrFile
 -> Maybe
      (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
 -> VoteFile 'Out
 -> GovernanceVoteCreateCmdArgs era)
-> Parser Vote
-> Parser
     (GovActionId
      -> AnyVotingStakeVerificationKeyOrHashOrFile
      -> Maybe
           (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
      -> VoteFile 'Out
      -> GovernanceVoteCreateCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Vote
pVoteChoice
    Parser
  (GovActionId
   -> AnyVotingStakeVerificationKeyOrHashOrFile
   -> Maybe
        (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
   -> VoteFile 'Out
   -> GovernanceVoteCreateCmdArgs era)
-> Parser GovActionId
-> Parser
     (AnyVotingStakeVerificationKeyOrHashOrFile
      -> Maybe
           (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
      -> VoteFile 'Out
      -> GovernanceVoteCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser GovActionId
pGovernanceActionId
    Parser
  (AnyVotingStakeVerificationKeyOrHashOrFile
   -> Maybe
        (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
   -> VoteFile 'Out
   -> GovernanceVoteCreateCmdArgs era)
-> Parser AnyVotingStakeVerificationKeyOrHashOrFile
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
      -> VoteFile 'Out -> GovernanceVoteCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser AnyVotingStakeVerificationKeyOrHashOrFile
pAnyVotingStakeVerificationKeyOrHashOrFile
    Parser
  (Maybe
     (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
   -> VoteFile 'Out -> GovernanceVoteCreateCmdArgs era)
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData)))
-> Parser (VoteFile 'Out -> GovernanceVoteCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser
  (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
-> Parser
     (Maybe
        (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData)))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
      ( Parser (MustCheckHash VoteUrl)
-> Parser (VoteUrl, SafeHash AnchorData)
-> Parser
     (PotentiallyCheckedAnchor VoteUrl (VoteUrl, SafeHash AnchorData))
forall anchorType anchor.
Parser (MustCheckHash anchorType)
-> Parser anchor
-> Parser (PotentiallyCheckedAnchor anchorType anchor)
pPotentiallyCheckedAnchorData
          Parser (MustCheckHash VoteUrl)
pMustCheckVoteUrl
          Parser (VoteUrl, SafeHash AnchorData)
pVoteAnchor
      )
    Parser (VoteFile 'Out -> GovernanceVoteCreateCmdArgs era)
-> Parser (VoteFile 'Out)
-> Parser (GovernanceVoteCreateCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> String -> Parser (VoteFile 'Out)
forall a. String -> String -> Parser (File a 'Out)
pFileOutDirection String
"out-file" String
"Output filepath of the vote."

pAnyVotingStakeVerificationKeyOrHashOrFile :: Parser AnyVotingStakeVerificationKeyOrHashOrFile
pAnyVotingStakeVerificationKeyOrHashOrFile :: Parser AnyVotingStakeVerificationKeyOrHashOrFile
pAnyVotingStakeVerificationKeyOrHashOrFile =
  [Parser AnyVotingStakeVerificationKeyOrHashOrFile]
-> Parser AnyVotingStakeVerificationKeyOrHashOrFile
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ VerificationKeyOrHashOrFileOrScriptHash DRepKey
-> AnyVotingStakeVerificationKeyOrHashOrFile
AnyDRepVerificationKeyOrHashOrFileOrScriptHash (VerificationKeyOrHashOrFileOrScriptHash DRepKey
 -> AnyVotingStakeVerificationKeyOrHashOrFile)
-> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
-> Parser AnyVotingStakeVerificationKeyOrHashOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFileOrScriptHash DRepKey)
pDRepVerificationKeyOrHashOrFileOrScriptHash
    , StakePoolKeyHashSource -> AnyVotingStakeVerificationKeyOrHashOrFile
AnyStakePoolVerificationKeyOrHashOrFile (StakePoolKeyHashSource
 -> AnyVotingStakeVerificationKeyOrHashOrFile)
-> Parser StakePoolKeyHashSource
-> Parser AnyVotingStakeVerificationKeyOrHashOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String -> Parser StakePoolKeyHashSource
pStakePoolVerificationKeyOrHashOrFile Maybe String
forall a. Maybe a
Nothing
    , VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
-> AnyVotingStakeVerificationKeyOrHashOrFile
AnyCommitteeHotVerificationKeyOrHashOrFileOrScriptHash
        (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey
 -> AnyVotingStakeVerificationKeyOrHashOrFile)
-> Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
-> Parser AnyVotingStakeVerificationKeyOrHashOrFile
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (VerificationKeyOrHashOrFileOrScriptHash CommitteeHotKey)
pCommitteeHotVerificationKeyOrHashOrVerificationFileOrScriptHash
    ]

pGovernanceVoteViewCmd
  :: Exp.IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteViewCmd :: forall era. IsEra era => Maybe (Parser (GovernanceVoteCmds era))
pGovernanceVoteViewCmd = do
  Parser (GovernanceVoteCmds era)
-> Maybe (Parser (GovernanceVoteCmds era))
forall a. a -> Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Parser (GovernanceVoteCmds era)
 -> Maybe (Parser (GovernanceVoteCmds era)))
-> Parser (GovernanceVoteCmds era)
-> Maybe (Parser (GovernanceVoteCmds era))
forall a b. (a -> b) -> a -> b
$ Mod CommandFields (GovernanceVoteCmds era)
-> Parser (GovernanceVoteCmds era)
forall a. Mod CommandFields a -> Parser a
Opt.hsubparser
    (Mod CommandFields (GovernanceVoteCmds era)
 -> Parser (GovernanceVoteCmds era))
-> Mod CommandFields (GovernanceVoteCmds era)
-> Parser (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ String
-> ParserInfo (GovernanceVoteCmds era)
-> Mod CommandFields (GovernanceVoteCmds era)
forall a. String -> ParserInfo a -> Mod CommandFields a
commandWithMetavar String
"view"
    (ParserInfo (GovernanceVoteCmds era)
 -> Mod CommandFields (GovernanceVoteCmds era))
-> ParserInfo (GovernanceVoteCmds era)
-> Mod CommandFields (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ Parser (GovernanceVoteCmds era)
-> InfoMod (GovernanceVoteCmds era)
-> ParserInfo (GovernanceVoteCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info
      (GovernanceVoteViewCmdArgs era -> GovernanceVoteCmds era
forall era. GovernanceVoteViewCmdArgs era -> GovernanceVoteCmds era
GovernanceVoteViewCmd (GovernanceVoteViewCmdArgs era -> GovernanceVoteCmds era)
-> Parser (GovernanceVoteViewCmdArgs era)
-> Parser (GovernanceVoteCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (GovernanceVoteViewCmdArgs era)
forall era. IsEra era => Parser (GovernanceVoteViewCmdArgs era)
pGovernanceVoteViewCmdArgs)
    (InfoMod (GovernanceVoteCmds era)
 -> ParserInfo (GovernanceVoteCmds era))
-> InfoMod (GovernanceVoteCmds era)
-> ParserInfo (GovernanceVoteCmds era)
forall a b. (a -> b) -> a -> b
$ String -> InfoMod (GovernanceVoteCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Vote viewing."

pGovernanceVoteViewCmdArgs :: Exp.IsEra era => Parser (GovernanceVoteViewCmdArgs era)
pGovernanceVoteViewCmdArgs :: forall era. IsEra era => Parser (GovernanceVoteViewCmdArgs era)
pGovernanceVoteViewCmdArgs =
  Era era
-> VoteFile 'In
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> GovernanceVoteViewCmdArgs era
forall era.
Era era
-> VoteFile 'In
-> Vary '[FormatJson, FormatYaml]
-> Maybe (File () 'Out)
-> GovernanceVoteViewCmdArgs era
GovernanceVoteViewCmdArgs Era era
forall era. IsEra era => Era era
Exp.useEra
    (VoteFile 'In
 -> Vary '[FormatJson, FormatYaml]
 -> Maybe (File () 'Out)
 -> GovernanceVoteViewCmdArgs era)
-> Parser (VoteFile 'In)
-> Parser
     (Vary '[FormatJson, FormatYaml]
      -> Maybe (File () 'Out) -> GovernanceVoteViewCmdArgs era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> Parser (VoteFile 'In)
forall a. String -> String -> Parser (File a 'In)
pFileInDirection String
"vote-file" String
"Input filepath of the vote."
    Parser
  (Vary '[FormatJson, FormatYaml]
   -> Maybe (File () 'Out) -> GovernanceVoteViewCmdArgs era)
-> Parser (Vary '[FormatJson, FormatYaml])
-> Parser (Maybe (File () 'Out) -> GovernanceVoteViewCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String
-> [Flag (Vary '[FormatJson, FormatYaml])]
-> Parser (Vary '[FormatJson, FormatYaml])
forall (fs :: [*]). String -> [Flag (Vary fs)] -> Parser (Vary fs)
pFormatFlags
      String
"governance vote view output"
      [ Flag (Vary '[FormatJson, FormatYaml])
forall (fs :: [*]). (FormatJson :| fs) => Flag (Vary fs)
flagFormatJson Flag (Vary '[FormatJson, FormatYaml])
-> (Flag (Vary '[FormatJson, FormatYaml])
    -> Flag (Vary '[FormatJson, FormatYaml]))
-> Flag (Vary '[FormatJson, FormatYaml])
forall a b. a -> (a -> b) -> b
& Flag (Vary '[FormatJson, FormatYaml])
-> Flag (Vary '[FormatJson, FormatYaml])
forall a. Flag a -> Flag a
setDefault
      , Flag (Vary '[FormatJson, FormatYaml])
forall (fs :: [*]). (FormatYaml :| fs) => Flag (Vary fs)
flagFormatYaml
      ]
    Parser (Maybe (File () 'Out) -> GovernanceVoteViewCmdArgs era)
-> Parser (Maybe (File () 'Out))
-> Parser (GovernanceVoteViewCmdArgs era)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Maybe (File () 'Out))
forall content. Parser (Maybe (File content 'Out))
pMaybeOutputFile