A more precise way to specify flags

cardano-cli/cardano-cli.cabal

@@ -176,6 +176,8 @@ library
     Cardano.CLI.Legacy.Run
     Cardano.CLI.OS.Posix
     Cardano.CLI.Option
+    Cardano.CLI.Option.Flag
+    Cardano.CLI.Option.Flag.Type
     Cardano.CLI.Orphan
     Cardano.CLI.Parser
     Cardano.CLI.Read
@@ -264,6 +266,7 @@ library
     exceptions,
     filepath,
     formatting,
+    generic-lens,
     haskeline,
     http-client,
     http-client-tls,

cardano-cli/src/Cardano/CLI/EraBased/Common/Option.hs

@@ -6,11 +6,9 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeOperators #-}
-{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
-
-{-# HLINT ignore "Redundant id" #-}
 
 {- HLINT ignore "Move brackets to avoid $" -}
+{- HLINT ignore "Redundant id" -}
 {- HLINT ignore "Use <$>" -}
 
 module Cardano.CLI.EraBased.Common.Option where
@@ -32,6 +30,8 @@ import Cardano.CLI.EraBased.Script.Vote.Type (CliVoteScriptRequirements)
 import Cardano.CLI.EraBased.Script.Vote.Type qualified as Voting
 import Cardano.CLI.EraBased.Script.Withdrawal.Type (CliWithdrawalScriptRequirements)
 import Cardano.CLI.EraBased.Script.Withdrawal.Type qualified as Withdrawal
+import Cardano.CLI.Option.Flag
+import Cardano.CLI.Option.Flag.Type qualified as Z
 import Cardano.CLI.Parser
 import Cardano.CLI.Read
 import Cardano.CLI.Type.Common
@@ -63,6 +63,7 @@ import Data.Type.Equality
 import Data.Word
 import GHC.Exts (IsList (..))
 import GHC.Natural (Natural)
+import Lens.Micro
 import Network.Socket (PortNumber)
 import Options.Applicative hiding (help, str)
 import Options.Applicative qualified as Opt
@@ -1803,26 +1804,46 @@ make' format desc flag_ extraHelp kind =
       , Opt.long ("output-" <> flag_)
       ]
 
-pFormatCBOR
-  :: FormatCBOR :| fs
-  => String
+pFormatFlags
+  :: String
+  -> [Flag (Vary fs)]
   -> Parser (Vary fs)
-pFormatCBOR =
-  make' FormatCBOR "BASE16 CBOR" "cbor" Nothing
-
-pFormatJsonFileDefault
+pFormatFlags content =
+  parserFromFlags $ \f ->
+    mconcat
+      [ "Format "
+      , content
+      , " to "
+      , f & Z.format
+      , case f & Z.options & Z.isDefault of
+          IsDefault -> " (default)"
+          NonDefault -> ""
+      , "."
+      ]
+
+flagFormatCbor
+  :: FormatCbor :| fs
+  => Flag (Vary fs)
+flagFormatCbor =
+  mkFlag "output-cbor" "BASE16 CBOR" FormatCbor
+
+flagFormatJson
   :: FormatJson :| fs
-  => String
-  -> Parser (Vary fs)
-pFormatJsonFileDefault =
-  make' FormatJson "JSON" "json" (Just " Default format when writing to a file")
+  => Flag (Vary fs)
+flagFormatJson =
+  mkFlag "output-json" "JSON" FormatJson
 
-pFormatTextStdoutDefault
+flagFormatText
   :: FormatText :| fs
-  => String
-  -> Parser (Vary fs)
-pFormatTextStdoutDefault =
-  make' FormatText "TEXT" "text" (Just " Default format when writing to stdout")
+  => Flag (Vary fs)
+flagFormatText =
+  mkFlag "output-text" "TEXT" FormatText
+
+flagFormatYaml
+  :: FormatYaml :| fs
+  => Flag (Vary fs)
+flagFormatYaml =
+  mkFlag "output-yaml" "YAML" FormatYaml
 
 -- | @pTxIdOutputFormatJsonOrText kind@ is a parser to specify in which format
 -- to write @transaction txid@'s output on standard output.

cardano-cli/src/Cardano/CLI/EraBased/Query/Command.hs

@@ -133,7 +133,7 @@ data QueryStakeAddressInfoCmdArgs = QueryStakeAddressInfoCmdArgs
 data QueryUTxOCmdArgs = QueryUTxOCmdArgs
   { commons :: !QueryCommons
   , queryFilter :: !QueryUTxOFilter
-  , format :: Maybe (Vary [FormatCBOR, FormatJson, FormatText])
+  , format :: Vary [FormatCbor, FormatJson, FormatText]
   , mOutFile :: !(Maybe (File () Out))
   }
   deriving (Generic, Show)

cardano-cli/src/Cardano/CLI/EraBased/Query/Option.hs

@@ -20,11 +20,13 @@ import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..))
 import Cardano.CLI.Environment (EnvCli (..))
 import Cardano.CLI.EraBased.Common.Option
 import Cardano.CLI.EraBased.Query.Command
+import Cardano.CLI.Option.Flag
 import Cardano.CLI.Parser
 import Cardano.CLI.Type.Common
 import Cardano.CLI.Type.Key
 
 import Data.Foldable
+import Data.Function
 import GHC.Exts (IsList (..))
 import Options.Applicative hiding (help, str)
 import Options.Applicative qualified as Opt
@@ -366,13 +368,12 @@ pQueryUTxOCmd era envCli =
     QueryUTxOCmdArgs
       <$> pQueryCommons era envCli
       <*> pQueryUTxOFilter
-      <*> ( optional $
-              asum
-                [ pFormatCBOR "utxo"
-                , pFormatJsonFileDefault "utxo"
-                , pFormatTextStdoutDefault "utxo"
-                ]
-          )
+      <*> pFormatFlags
+        "utxo query output"
+        [ flagFormatCbor
+        , flagFormatJson & setDefault
+        , flagFormatText
+        ]
       <*> pMaybeOutputFile
 
 pQueryStakePoolsCmd :: ShelleyBasedEra era -> EnvCli -> Parser (QueryCmds era)

cardano-cli/src/Cardano/CLI/EraBased/Query/Run.hs

@@ -1175,7 +1175,7 @@ writeProtocolState sbe mOutFile ps@(ProtocolState pstate) =
 
 writeFilteredUTxOs
   :: Api.ShelleyBasedEra era
-  -> Maybe (Vary [FormatCBOR, FormatJson, FormatText])
+  -> Vary [FormatCbor, FormatJson, FormatText]
   -> Maybe (File () Out)
   -> UTxO era
   -> ExceptT QueryCmdError IO ()
@@ -1184,9 +1184,9 @@ writeFilteredUTxOs sbe format mOutFile utxo =
     $ firstExceptT QueryCmdWriteFileError
       . newExceptT
       . writeLazyByteStringOutput mOutFile
-    $ allOutputFormats format mOutFile
+    $ format
       & ( id
-            . Vary.on (\FormatCBOR -> LBS.fromStrict . Base16.encode . CBOR.serialize' $ toLedgerUTxO sbe utxo)
+            . Vary.on (\FormatCbor -> LBS.fromStrict . Base16.encode . CBOR.serialize' $ toLedgerUTxO sbe utxo)
             . Vary.on (\FormatJson -> encodePretty utxo)
             . Vary.on (\FormatText -> strictTextToLazyBytestring $ filteredUTxOsToText sbe utxo)
             $ Vary.exhaustiveCase
@@ -2000,16 +2000,6 @@ newOutputFormat format mOutFile =
     (Nothing, Nothing) -> Vary.from FormatText -- No CLI flag, writing to stdout: write text
     (Nothing, Just _) -> Vary.from FormatJson -- No CLI flag, writing to a file: write JSON
 
-allOutputFormats
-  :: Maybe (Vary [FormatCBOR, FormatJson, FormatText])
-  -> Maybe a
-  -> Vary [FormatCBOR, FormatJson, FormatText]
-allOutputFormats format mOutFile =
-  case (format, mOutFile) of
-    (Just f, _) -> f -- Take flag from CLI if specified
-    (Nothing, Nothing) -> Vary.from FormatText -- No CLI flag, writing to stdout: write text
-    (Nothing, Just _) -> Vary.from FormatJson -- No CLI flag, writing to a file: write JSON
-
 strictTextToLazyBytestring :: Text -> LBS.ByteString
 strictTextToLazyBytestring t = BS.fromChunks [Text.encodeUtf8 t]
 

cardano-cli/src/Cardano/CLI/Option/Flag.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeOperators #-}
+
+module Cardano.CLI.Option.Flag
+  ( Flag (Flag)
+  , FlagOptions (FlagOptions)
+  , Defaultness (..)
+  , setDefault
+  , mkFlag
+  , parserFromFlags
+  )
+where
+
+import Cardano.CLI.Option.Flag.Type
+  ( Defaultness (IsDefault)
+  , Flag (Flag)
+  , FlagOptions (FlagOptions)
+  , defaultFlagOptions
+  )
+import Cardano.CLI.Option.Flag.Type qualified as Z
+import Cardano.CLI.Vary
+import Cardano.CLI.Vary qualified as Vary
+
+import Control.Applicative
+import Data.Function
+import Data.Generics.Product.Any
+import Lens.Micro
+import Options.Applicative (Parser)
+import Options.Applicative qualified as Opt
+
+-- | Create a parser from a help rendering function and list of flags.
+-- A default parser is included at the end of parser alternatives for
+-- the default flag (there should only be one default, but if more than
+-- one is specified, the first such one is used as the default).
+parserFromFlags :: (Flag a -> String) -> [Flag a] -> Parser a
+parserFromFlags _ [] = empty
+parserFromFlags mkHelp fs =
+  alternatives fs <|> defaults fs
+ where
+  alternatives [] = empty
+  alternatives (x : xs) =
+    parserFromFlag mkHelp x <|> alternatives xs
+
+  defaults :: [Flag a] -> Parser a
+  defaults = \case
+    [] -> empty
+    (x : xs) | flagIsDefault x -> parserFromFlagDefault x <|> defaults xs
+    (_ : xs) -> defaults xs
+
+flagIsDefault :: Flag a -> Bool
+flagIsDefault flag =
+  Z.isDefault (Z.options flag) == Z.IsDefault
+
+parserFromFlag :: (Flag a -> String) -> Flag a -> Parser a
+parserFromFlag mkHelp flag =
+  Opt.flag' (flag & Z.value) $
+    mconcat
+      [ Opt.long $ flag & Z.longName
+      , Opt.help $ mkHelp flag
+      ]
+
+parserFromFlagDefault :: Flag a -> Parser a
+parserFromFlagDefault flag =
+  pure $ flag & Z.value
+
+mkFlag
+  :: a :| fs
+  => String
+  -> String
+  -> a
+  -> Flag (Vary fs)
+mkFlag longName format value =
+  Flag longName format defaultFlagOptions (Vary.from value)
+
+setDefault :: Flag a -> Flag a
+setDefault flag =
+  flag & the @"options" . the @"isDefault" .~ IsDefault

cardano-cli/src/Cardano/CLI/Option/Flag/Type.hs

@@ -0,0 +1,54 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module Cardano.CLI.Option.Flag.Type
+  ( Flag (..)
+  , Defaultness (..)
+  , FlagOptions (..)
+  , defaultFlagOptions
+  )
+where
+
+import GHC.Generics
+
+data Defaultness
+  = IsDefault
+  | NonDefault
+  deriving (Show, Eq, Generic)
+
+-- | Options for a flag that control how it is rendered and parsed.
+newtype FlagOptions = FlagOptions
+  { isDefault :: Defaultness
+  -- ^ Whether the flag is a default value.
+  }
+  deriving (Show, Eq, Generic)
+
+-- instance Semigroup FlagOptions where
+--   FlagOptions IsDefault <> FlagOptions _ = FlagOptions IsDefault
+--   FlagOptions _ <> FlagOptions IsDefault = FlagOptions IsDefault
+--   FlagOptions _ <> FlagOptions _ = FlagOptions NonDefault
+
+-- instance Monoid FlagOptions where
+--   mempty = FlagOptions NonDefault
+--   mappend = (<>)
+
+-- | A flag that can be used in the command line interface.
+--
+-- It contains information about how to render the flag, its long name,
+-- its content, and its value.
+-- The type variable 'a' represents the type of the value that the flag holds.
+--
+-- The reason for this type instead of using 'Parser a' directly is to
+-- allow for more complex parsing logic, such as handling default values.
+data Flag a = Flag
+  { longName :: String
+  , format :: String
+  , options :: FlagOptions
+  , value :: a
+  }
+  deriving (Show, Eq, Generic)
+
+defaultFlagOptions :: FlagOptions
+defaultFlagOptions = FlagOptions NonDefault

cardano-cli/src/Cardano/CLI/Type/Common.hs

@@ -26,7 +26,7 @@ module Cardano.CLI.Type.Common
   , EpochLeadershipSchedule (..)
   , File (..)
   , FileDirection (..)
-  , FormatCBOR (..)
+  , FormatCbor (..)
   , FormatJson (..)
   , FormatText (..)
   , FormatYaml (..)
@@ -485,7 +485,7 @@ data TxMempoolQuery
   | TxMempoolQueryInfo
   deriving Show
 
-data FormatCBOR = FormatCBOR
+data FormatCbor = FormatCbor
   deriving (Enum, Eq, Ord, Show)
 
 data FormatJson = FormatJson

cardano-cli/test/cardano-cli-golden/files/golden/help/conway_query_utxo.cli

@@ -36,9 +36,7 @@ Available options:
   --address ADDRESS        Filter by Cardano address(es) (Bech32-encoded).
   --tx-in TX-IN            Filter by transaction input (TxId#TxIx).
   --output-cbor            Format utxo query output to BASE16 CBOR.
-  --output-json            Format utxo query output to JSON. Default format when
-                           writing to a file
-  --output-text            Format utxo query output to TEXT. Default format when
-                           writing to stdout
+  --output-json            Format utxo query output to JSON (default).
+  --output-text            Format utxo query output to TEXT.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/latest_query_utxo.cli

@@ -36,9 +36,7 @@ Available options:
   --address ADDRESS        Filter by Cardano address(es) (Bech32-encoded).
   --tx-in TX-IN            Filter by transaction input (TxId#TxIx).
   --output-cbor            Format utxo query output to BASE16 CBOR.
-  --output-json            Format utxo query output to JSON. Default format when
-                           writing to a file
-  --output-text            Format utxo query output to TEXT. Default format when
-                           writing to stdout
+  --output-json            Format utxo query output to JSON (default).
+  --output-text            Format utxo query output to TEXT.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text

cardano-cli/test/cardano-cli-golden/files/golden/help/query_utxo.cli

@@ -33,9 +33,7 @@ Available options:
   --address ADDRESS        Filter by Cardano address(es) (Bech32-encoded).
   --tx-in TX-IN            Filter by transaction input (TxId#TxIx).
   --output-cbor            Format utxo query output to BASE16 CBOR.
-  --output-json            Format utxo query output to JSON. Default format when
-                           writing to a file
-  --output-text            Format utxo query output to TEXT. Default format when
-                           writing to stdout
+  --output-json            Format utxo query output to JSON (default).
+  --output-text            Format utxo query output to TEXT.
   --out-file FILEPATH      Optional output file. Default is to write to stdout.
   -h,--help                Show this help text