{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Cardano.CLI.EraBased.Options.TextView
  ( pTextViewCmds
  )
where

import           Cardano.CLI.EraBased.Commands.TextView
import           Cardano.CLI.EraBased.Options.Common

import           Options.Applicative hiding (help, str)
import qualified Options.Applicative as Opt

{- HLINT ignore "Use <$>" -}
{- HLINT ignore "Move brackets to avoid $" -}

pTextViewCmds :: Maybe (Parser (TextViewCmds era))
pTextViewCmds :: forall era. Maybe (Parser (TextViewCmds era))
pTextViewCmds =
  String
-> InfoMod (TextViewCmds era)
-> [Maybe (Parser (TextViewCmds era))]
-> Maybe (Parser (TextViewCmds era))
forall a.
String -> InfoMod a -> [Maybe (Parser a)] -> Maybe (Parser a)
subInfoParser
    String
"text-view"
    ( String -> InfoMod (TextViewCmds era)
forall a. String -> InfoMod a
Opt.progDesc (String -> InfoMod (TextViewCmds era))
-> String -> InfoMod (TextViewCmds era)
forall a b. (a -> b) -> a -> b
$
        [String] -> String
forall a. Monoid a => [a] -> a
mconcat
          [ String
"Commands for dealing with Shelley TextView files. Transactions, addresses etc "
          , String
"are stored on disk as TextView files."
          ]
    )
    [ Parser (TextViewCmds era) -> Maybe (Parser (TextViewCmds era))
forall a. a -> Maybe a
Just (Parser (TextViewCmds era) -> Maybe (Parser (TextViewCmds era)))
-> Parser (TextViewCmds era) -> Maybe (Parser (TextViewCmds era))
forall a b. (a -> b) -> a -> b
$
        String
-> ParserInfo (TextViewCmds era) -> Parser (TextViewCmds era)
forall a. String -> ParserInfo a -> Parser a
subParser String
"decode-cbor" (ParserInfo (TextViewCmds era) -> Parser (TextViewCmds era))
-> ParserInfo (TextViewCmds era) -> Parser (TextViewCmds era)
forall a b. (a -> b) -> a -> b
$
          Parser (TextViewCmds era)
-> InfoMod (TextViewCmds era) -> ParserInfo (TextViewCmds era)
forall a. Parser a -> InfoMod a -> ParserInfo a
Opt.info (String -> Maybe (File () 'Out) -> TextViewCmds era
forall era. String -> Maybe (File () 'Out) -> TextViewCmds era
TextViewInfo (String -> Maybe (File () 'Out) -> TextViewCmds era)
-> Parser String
-> Parser (Maybe (File () 'Out) -> TextViewCmds era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
pCBORInFile Parser (Maybe (File () 'Out) -> TextViewCmds era)
-> Parser (Maybe (File () 'Out)) -> Parser (TextViewCmds 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) (InfoMod (TextViewCmds era) -> ParserInfo (TextViewCmds era))
-> InfoMod (TextViewCmds era) -> ParserInfo (TextViewCmds era)
forall a b. (a -> b) -> a -> b
$
            String -> InfoMod (TextViewCmds era)
forall a. String -> InfoMod a
Opt.progDesc String
"Print a TextView file as decoded CBOR."
    ]